summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ob-C.el150
-rw-r--r--lisp/ob-J.el25
-rw-r--r--lisp/ob-R.el76
-rw-r--r--lisp/ob-abc.el20
-rw-r--r--lisp/ob-asymptote.el42
-rw-r--r--lisp/ob-awk.el27
-rw-r--r--lisp/ob-calc.el20
-rw-r--r--lisp/ob-clojure.el35
-rw-r--r--lisp/ob-comint.el34
-rw-r--r--lisp/ob-coq.el9
-rw-r--r--lisp/ob-core.el2150
-rw-r--r--lisp/ob-css.el8
-rw-r--r--lisp/ob-ditaa.el20
-rw-r--r--lisp/ob-dot.el13
-rw-r--r--lisp/ob-ebnf.el8
-rw-r--r--lisp/ob-emacs-lisp.el53
-rw-r--r--lisp/ob-eval.el27
-rw-r--r--lisp/ob-exp.el501
-rw-r--r--lisp/ob-forth.el15
-rw-r--r--lisp/ob-fortran.el53
-rw-r--r--lisp/ob-gnuplot.el52
-rw-r--r--lisp/ob-groovy.el22
-rw-r--r--lisp/ob-haskell.el52
-rw-r--r--lisp/ob-io.el34
-rw-r--r--lisp/ob-java.el24
-rw-r--r--lisp/ob-js.el19
-rw-r--r--lisp/ob-keys.el6
-rw-r--r--lisp/ob-latex.el72
-rw-r--r--lisp/ob-ledger.el7
-rw-r--r--lisp/ob-lilypond.el37
-rw-r--r--lisp/ob-lisp.el88
-rw-r--r--lisp/ob-lob.el194
-rw-r--r--lisp/ob-lua.el403
-rw-r--r--lisp/ob-makefile.el8
-rw-r--r--lisp/ob-matlab.el2
-rw-r--r--lisp/ob-maxima.el10
-rw-r--r--lisp/ob-mscgen.el10
-rw-r--r--lisp/ob-ocaml.el58
-rw-r--r--lisp/ob-octave.el66
-rw-r--r--lisp/ob-org.el8
-rw-r--r--lisp/ob-perl.el27
-rw-r--r--lisp/ob-picolisp.el14
-rw-r--r--lisp/ob-plantuml.el27
-rw-r--r--lisp/ob-processing.el30
-rw-r--r--lisp/ob-python.el94
-rw-r--r--lisp/ob-ref.el162
-rw-r--r--lisp/ob-ruby.el66
-rw-r--r--lisp/ob-sass.el9
-rw-r--r--lisp/ob-scala.el28
-rw-r--r--lisp/ob-scheme.el31
-rw-r--r--lisp/ob-screen.el20
-rw-r--r--lisp/ob-sed.el2
-rw-r--r--lisp/ob-shell.el87
-rw-r--r--lisp/ob-shen.el9
-rw-r--r--lisp/ob-sql.el187
-rw-r--r--lisp/ob-sqlite.el23
-rw-r--r--lisp/ob-stan.el84
-rw-r--r--lisp/ob-table.el12
-rw-r--r--lisp/ob-tangle.el108
-rw-r--r--lisp/ob.el2
-rw-r--r--lisp/org-agenda.el1770
-rw-r--r--lisp/org-archive.el311
-rw-r--r--lisp/org-attach.el120
-rw-r--r--lisp/org-bbdb.el110
-rw-r--r--lisp/org-bibtex.el120
-rw-r--r--lisp/org-capture.el733
-rw-r--r--lisp/org-clock.el835
-rw-r--r--lisp/org-colview.el2162
-rw-r--r--lisp/org-compat.el684
-rw-r--r--lisp/org-crypt.el133
-rw-r--r--lisp/org-ctags.el101
-rw-r--r--lisp/org-datetree.el238
-rw-r--r--lisp/org-docview.el13
-rw-r--r--lisp/org-element.el1669
-rw-r--r--lisp/org-entities.el112
-rw-r--r--lisp/org-eshell.el9
-rw-r--r--lisp/org-eww.el172
-rw-r--r--lisp/org-faces.el484
-rw-r--r--lisp/org-feed.el149
-rw-r--r--lisp/org-footnote.el1141
-rw-r--r--lisp/org-gnus.el55
-rw-r--r--lisp/org-habit.el104
-rw-r--r--lisp/org-id.el27
-rw-r--r--lisp/org-indent.el61
-rw-r--r--lisp/org-info.el64
-rw-r--r--lisp/org-inlinetask.el32
-rw-r--r--lisp/org-irc.el26
-rw-r--r--lisp/org-lint.el159
-rw-r--r--lisp/org-list.el987
-rw-r--r--lisp/org-loaddefs.el1204
-rw-r--r--lisp/org-macro.el207
-rw-r--r--lisp/org-macs.el146
-rw-r--r--lisp/org-mhe.el39
-rw-r--r--lisp/org-mobile.el233
-rw-r--r--lisp/org-mouse.el139
-rw-r--r--lisp/org-pcomplete.el82
-rw-r--r--lisp/org-plot.el163
-rw-r--r--lisp/org-protocol.el345
-rw-r--r--lisp/org-rmail.el24
-rw-r--r--lisp/org-src.el291
-rw-r--r--lisp/org-table.el708
-rw-r--r--lisp/org-timer.el140
-rw-r--r--lisp/org-version.el10
-rw-r--r--lisp/org-w3m.el16
-rw-r--r--lisp/org.el9957
-rw-r--r--lisp/ox-ascii.el348
-rw-r--r--lisp/ox-beamer.el135
-rw-r--r--lisp/ox-html.el949
-rw-r--r--lisp/ox-icalendar.el93
-rw-r--r--lisp/ox-latex.el800
-rw-r--r--lisp/ox-man.el381
-rw-r--r--lisp/ox-md.el161
-rw-r--r--lisp/ox-odt.el1078
-rw-r--r--lisp/ox-org.el22
-rw-r--r--lisp/ox-publish.el480
-rw-r--r--lisp/ox-texinfo.el314
-rw-r--r--lisp/ox.el2135
117 files changed, 20109 insertions, 18552 deletions
diff --git a/lisp/ob-C.el b/lisp/ob-C.el
index a6d4d5e..0bd911e 100644
--- a/lisp/ob-C.el
+++ b/lisp/ob-C.el
@@ -1,4 +1,4 @@
-;;; ob-C.el --- org-babel functions for C and similar languages
+;;; ob-C.el --- Babel Functions for C and Similar Languages -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -31,12 +31,14 @@
;; - not much in the way of error feedback
;;; Code:
-(require 'ob)
+
(require 'cc-mode)
+(require 'ob)
+
-(declare-function org-entry-get "org"
- (pom property &optional inherit literal-nil))
+(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp"))
@@ -120,39 +122,47 @@ header arguments."
or `org-babel-execute:C++' or `org-babel-execute:D'."
(let* ((tmp-src-file (org-babel-temp-file
"C-src-"
- (case org-babel-c-variant
- (c ".c" )
- (cpp ".cpp")
- (d ".d" ))))
- (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) ;; not used for D
- (cmdline (cdr (assoc :cmdline params)))
+ (pcase org-babel-c-variant
+ (`c ".c") (`cpp ".cpp") (`d ".d"))))
+ (tmp-bin-file ;not used for D
+ (org-babel-temp-file "C-bin-" org-babel-exeext))
+ (cmdline (cdr (assq :cmdline params)))
(cmdline (if cmdline (concat " " cmdline) ""))
- (flags (cdr (assoc :flags params)))
+ (flags (cdr (assq :flags params)))
(flags (mapconcat 'identity
(if (listp flags) flags (list flags)) " "))
+ (libs (org-babel-read
+ (or (cdr (assq :libs params))
+ (org-entry-get nil "libs" t))
+ nil))
+ (libs (mapconcat #'identity
+ (if (listp libs) libs (list libs))
+ " "))
(full-body
- (case org-babel-c-variant
- (c (org-babel-C-expand-C body params))
- (cpp (org-babel-C-expand-C++ body params))
- (d (org-babel-C-expand-D body params)))))
+ (pcase org-babel-c-variant
+ (`c (org-babel-C-expand-C body params))
+ (`cpp (org-babel-C-expand-C++ body params))
+ (`d (org-babel-C-expand-D body params)))))
(with-temp-file tmp-src-file (insert full-body))
- (case org-babel-c-variant
- ((c cpp)
+ (pcase org-babel-c-variant
+ ((or `c `cpp)
(org-babel-eval
- (format "%s -o %s %s %s"
- (case org-babel-c-variant
- (c org-babel-C-compiler)
- (cpp org-babel-C++-compiler))
+ (format "%s -o %s %s %s %s"
+ (pcase org-babel-c-variant
+ (`c org-babel-C-compiler)
+ (`cpp org-babel-C++-compiler))
(org-babel-process-file-name tmp-bin-file)
flags
- (org-babel-process-file-name tmp-src-file)) ""))
- (d nil)) ;; no separate compilation for D
+ (org-babel-process-file-name tmp-src-file)
+ libs)
+ ""))
+ (`d nil)) ;; no separate compilation for D
(let ((results
(org-babel-eval
- (case org-babel-c-variant
- ((c cpp)
+ (pcase org-babel-c-variant
+ ((or `c `cpp)
(concat tmp-bin-file cmdline))
- (d
+ (`d
(format "%s %s %s %s"
org-babel-D-compiler
flags
@@ -160,17 +170,17 @@ or `org-babel-execute:C++' or `org-babel-execute:D'."
cmdline)))
"")))
(when results
- (setq results (org-babel-trim (org-remove-indentation results)))
+ (setq results (org-trim (org-remove-indentation results)))
(org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results t)
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))
)))
(defun org-babel-C-expand-C++ (body params)
@@ -181,15 +191,15 @@ its header arguments."
(defun org-babel-C-expand-C (body params)
"Expand a block of C or C++ code with org-babel according to
its header arguments."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (colnames (cdar (org-babel-get-header params :colname-names)))
- (main-p (not (string= (cdr (assoc :main params)) "no")))
+ (let ((vars (org-babel--get-vars params))
+ (colnames (cdr (assq :colname-names params)))
+ (main-p (not (string= (cdr (assq :main params)) "no")))
(includes (org-babel-read
- (or (cdr (assoc :includes params))
+ (or (cdr (assq :includes params))
(org-entry-get nil "includes" t))
nil))
(defines (org-babel-read
- (or (cdr (assoc :defines params))
+ (or (cdr (assq :defines params))
(org-entry-get nil "defines" t))
nil)))
(when (stringp includes)
@@ -230,10 +240,10 @@ its header arguments."
(defun org-babel-C-expand-D (body params)
"Expand a block of D code with org-babel according to
its header arguments."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (colnames (cdar (org-babel-get-header params :colname-names)))
- (main-p (not (string= (cdr (assoc :main params)) "no")))
- (imports (or (cdr (assoc :imports params))
+ (let ((vars (org-babel--get-vars params))
+ (colnames (cdr (assq :colname-names params)))
+ (main-p (not (string= (cdr (assq :main params)) "no")))
+ (imports (or (cdr (assq :imports params))
(org-babel-read (org-entry-get nil "imports" t)))))
(when (stringp imports)
(setq imports (split-string imports)))
@@ -265,12 +275,12 @@ its header arguments."
body
(format "int main() {\n%s\nreturn 0;\n}\n" body)))
-(defun org-babel-prep-session:C (session params)
+(defun org-babel-prep-session:C (_session _params)
"This function does nothing as C is a compiled language with no
support for sessions"
(error "C is a compiled languages -- no support for sessions"))
-(defun org-babel-load-session:C (session body params)
+(defun org-babel-load-session:C (_session _body _params)
"This function does nothing as C is a compiled language with no
support for sessions"
(error "C is a compiled languages -- no support for sessions"))
@@ -290,14 +300,14 @@ Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type.
FORMAT can be either a format string or a function which is called with VAL."
(let* ((basetype (org-babel-C-val-to-base-type val))
(type
- (case basetype
- (integerp '("int" "%d"))
- (floatp '("double" "%f"))
- (stringp
+ (pcase basetype
+ (`integerp '("int" "%d"))
+ (`floatp '("double" "%f"))
+ (`stringp
(list
- (if (equal org-babel-c-variant 'd) "string" "const char*")
+ (if (eq org-babel-c-variant 'd) "string" "const char*")
"\"%s\""))
- (t (error "unknown type %S" basetype)))))
+ (_ (error "unknown type %S" basetype)))))
(cond
((integerp val) type) ;; an integer declared in the #+begin_src line
((floatp val) type) ;; a numeric declared in the #+begin_src line
@@ -307,25 +317,25 @@ FORMAT can be either a format string or a function which is called with VAL."
(cons
(format "[%d][%d]" (length val) (length (car val)))
(concat
- (if (equal org-babel-c-variant 'd) "[\n" "{\n")
+ (if (eq org-babel-c-variant 'd) "[\n" "{\n")
(mapconcat
(lambda (v)
(concat
- (if (equal org-babel-c-variant 'd) " [" " {")
+ (if (eq org-babel-c-variant 'd) " [" " {")
(mapconcat (lambda (w) (format ,(cadr type) w)) v ",")
- (if (equal org-babel-c-variant 'd) "]" "}")))
+ (if (eq org-babel-c-variant 'd) "]" "}")))
val
",\n")
- (if (equal org-babel-c-variant 'd) "\n]" "\n}"))))))
+ (if (eq org-babel-c-variant 'd) "\n]" "\n}"))))))
((or (listp val) (vectorp val)) ;; a list declared in the #+begin_src line
`(,(car type)
(lambda (val)
(cons
(format "[%d]" (length val))
(concat
- (if (equal org-babel-c-variant 'd) "[" "{")
+ (if (eq org-babel-c-variant 'd) "[" "{")
(mapconcat (lambda (v) (format ,(cadr type) v)) val ",")
- (if (equal org-babel-c-variant 'd) "]" "}"))))))
+ (if (eq org-babel-c-variant 'd) "]" "}"))))))
(t ;; treat unknown types as string
type))))
@@ -340,12 +350,12 @@ FORMAT can be either a format string or a function which is called with VAL."
((or (listp val) (vectorp val))
(let ((type nil))
(mapc (lambda (v)
- (case (org-babel-C-val-to-base-type v)
- (stringp (setq type 'stringp))
- (floatp
+ (pcase (org-babel-C-val-to-base-type v)
+ (`stringp (setq type 'stringp))
+ (`floatp
(if (or (not type) (eq type 'integerp))
(setq type 'floatp)))
- (integerp
+ (`integerp
(unless type (setq type 'integerp)))))
val)
type))
@@ -387,8 +397,8 @@ of the same value."
(defun org-babel-C-utility-header-to-C ()
"Generate a utility function to convert a column name
into a column number."
- (case org-babel-c-variant
- ((c cpp)
+ (pcase org-babel-c-variant
+ ((or `c `cpp)
"int get_column_num (int nbcols, const char** header, const char* column)
{
int c;
@@ -397,9 +407,8 @@ into a column number."
return c;
return -1;
}
-"
- )
- (d
+")
+ (`d
"int get_column_num (string[] header, string column)
{
foreach (c, h; header)
@@ -407,8 +416,7 @@ into a column number."
return to!int(c);
return -1;
}
-"
- )))
+")))
(defun org-babel-C-header-to-C (head)
"Convert an elisp list of header table into a C or D vector
@@ -417,21 +425,21 @@ specifying a variable with the name of the table."
(headers (cdr head)))
(concat
(format
- (case org-babel-c-variant
- ((c cpp) "const char* %s_header[%d] = {%s};")
- (d "string %s_header[%d] = [%s];"))
+ (pcase org-babel-c-variant
+ ((or `c `cpp) "const char* %s_header[%d] = {%s};")
+ (`d "string %s_header[%d] = [%s];"))
table
(length headers)
(mapconcat (lambda (h) (format "%S" h)) headers ","))
"\n"
- (case org-babel-c-variant
- ((c cpp)
+ (pcase org-babel-c-variant
+ ((or `c `cpp)
(format
"const char* %s_h (int row, const char* col) { return %s[row][get_column_num(%d,%s_header,col)]; }"
table table (length headers) table))
- (d
+ (`d
(format
- "string %s_h (ulong row, string col) { return %s[row][get_column_num(%s_header,col)]; }"
+ "string %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }"
table table table))))))
(provide 'ob-C)
diff --git a/lisp/ob-J.el b/lisp/ob-J.el
index dcdad03..572149b 100644
--- a/lisp/ob-J.el
+++ b/lisp/ob-J.el
@@ -1,4 +1,4 @@
-;;; ob-J.el --- org-babel functions for J evaluation
+;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@@ -29,12 +29,20 @@
;; (available in MELPA).
;;; Code:
+
(require 'ob)
-(declare-function org-trim "org" (S))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function j-console-ensure-session "ext:j-console" ())
-(defun org-babel-expand-body:J (body params &optional processed-params)
+(defcustom org-babel-J-command "jconsole"
+ "Command to call J."
+ :group 'org-babel
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :type 'string)
+
+(defun org-babel-expand-body:J (body _params &optional _processed-params)
"Expand BODY according to PARAMS, return the expanded body.
PROCESSED-PARAMS isn't used yet."
(org-babel-J-interleave-echos-except-functions body))
@@ -59,26 +67,25 @@ PROCESSED-PARAMS isn't used yet."
(org-babel-J-interleave-echos-except-functions s3)))
(org-babel-J-interleave-echos body)))
+(defalias 'org-babel-execute:j 'org-babel-execute:J)
+
(defun org-babel-execute:J (body params)
"Execute a block of J code BODY.
PARAMS are given by org-babel.
This function is called by `org-babel-execute-src-block'"
(message "executing J source code block")
(let* ((processed-params (org-babel-process-params params))
- (sessionp (cdr (assoc :session params)))
- (session (org-babel-j-initiate-session sessionp))
- (vars (nth 2 processed-params))
- (result-params (nth 3 processed-params))
- (result-type (nth 4 processed-params))
+ (sessionp (cdr (assq :session params)))
(full-body (org-babel-expand-body:J
body params processed-params))
(tmp-script-file (org-babel-temp-file "J-src")))
+ (org-babel-j-initiate-session sessionp)
(org-babel-J-strip-whitespace
(if (string= sessionp "none")
(progn
(with-temp-file tmp-script-file
(insert full-body))
- (org-babel-eval (format "jconsole < %s" tmp-script-file) ""))
+ (org-babel-eval (format "%s < %s" org-babel-J-command tmp-script-file) ""))
(org-babel-J-eval-string full-body)))))
(defun org-babel-J-eval-string (str)
diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index 4b37c18..2993b09 100644
--- a/lisp/ob-R.el
+++ b/lisp/ob-R.el
@@ -1,4 +1,4 @@
-;;; ob-R.el --- org-babel functions for R code evaluation
+;;; ob-R.el --- Babel Functions for R -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -27,8 +27,9 @@
;; Org-Babel support for evaluating R code
;;; Code:
+
+(require 'cl-lib)
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function orgtbl-to-tsv "org-table" (table params))
(declare-function R "ext:essd-r" (&optional start-args))
@@ -36,10 +37,7 @@
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function ess-wait-for-process "ext:ess-inf"
- (proc &optional sec-prompt wait force-redisplay))
-(declare-function org-number-sequence "org-compat" (from &optional to inc))
-(declare-function org-remove-if-not "org" (predicate seq))
-(declare-function org-every "org" (pred seq))
+ (&optional proc sec-prompt wait force-redisplay))
(defconst org-babel-header-args:R
'((width . :any)
@@ -92,9 +90,11 @@ this variable.")
(defvar ess-current-process-name) ; dynamically scoped
(defvar ess-local-process-name) ; dynamically scoped
(defun org-babel-edit-prep:R (info)
- (let ((session (cdr (assoc :session (nth 2 info)))))
- (when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
- (save-match-data (org-babel-R-initiate-session session nil)))))
+ (let ((session (cdr (assq :session (nth 2 info)))))
+ (when (and session
+ (string-prefix-p "*" session)
+ (string-suffix-p "*" session))
+ (org-babel-R-initiate-session session nil))))
;; The usage of utils::read.table() ensures that the command
;; read.table() can be found even in circumstances when the utils
@@ -139,28 +139,28 @@ This function is used when the table contains a header.")
This function is used when the table does not contain a header.")
-(defun org-babel-expand-body:R (body params &optional graphics-file)
+(defun org-babel-expand-body:R (body params &optional _graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
(mapconcat 'identity
(append
- (when (cdr (assoc :prologue params))
- (list (cdr (assoc :prologue params))))
+ (when (cdr (assq :prologue params))
+ (list (cdr (assq :prologue params))))
(org-babel-variable-assignments:R params)
(list body)
- (when (cdr (assoc :epilogue params))
- (list (cdr (assoc :epilogue params)))))
+ (when (cdr (assq :epilogue params))
+ (list (cdr (assq :epilogue params)))))
"\n"))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
This function is called by `org-babel-execute-src-block'."
(save-excursion
- (let* ((result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
(session (org-babel-R-initiate-session
- (cdr (assoc :session params)) params))
- (colnames-p (cdr (assoc :colnames params)))
- (rownames-p (cdr (assoc :rownames params)))
+ (cdr (assq :session params)) params))
+ (colnames-p (cdr (assq :colnames params)))
+ (rownames-p (cdr (assq :rownames params)))
(graphics-file (and (member "graphics" (assq :result-params params))
(org-babel-graphical-output-file params)))
(full-body
@@ -180,10 +180,10 @@ This function is called by `org-babel-execute-src-block'."
session full-body result-type result-params
(or (equal "yes" colnames-p)
(org-babel-pick-name
- (cdr (assoc :colname-names params)) colnames-p))
+ (cdr (assq :colname-names params)) colnames-p))
(or (equal "yes" rownames-p)
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) rownames-p)))))
+ (cdr (assq :rowname-names params)) rownames-p)))))
(if graphics-file nil result))))
(defun org-babel-prep-session:R (session params)
@@ -209,21 +209,21 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-variable-assignments:R (params)
"Return list of R statements assigning the block's variables."
- (let ((vars (mapcar 'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapcar
(lambda (pair)
(org-babel-R-assign-elisp
(car pair) (cdr pair)
- (equal "yes" (cdr (assoc :colnames params)))
- (equal "yes" (cdr (assoc :rownames params)))))
+ (equal "yes" (cdr (assq :colnames params)))
+ (equal "yes" (cdr (assq :rownames params)))))
(mapcar
(lambda (i)
(cons (car (nth i vars))
(org-babel-reassemble-table
(cdr (nth i vars))
- (cdr (nth i (cdr (assoc :colname-names params))))
- (cdr (nth i (cdr (assoc :rowname-names params)))))))
- (org-number-sequence 0 (1- (length vars)))))))
+ (cdr (nth i (cdr (assq :colname-names params))))
+ (cdr (nth i (cdr (assq :rowname-names params)))))))
+ (number-sequence 0 (1- (length vars)))))))
(defun org-babel-R-quote-tsv-field (s)
"Quote field S for export to R."
@@ -234,7 +234,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-R-assign-elisp (name value colnames-p rownames-p)
"Construct R code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
- (let* ((lengths (mapcar 'length (org-remove-if-not 'sequencep value)))
+ (let* ((lengths (mapcar 'length (cl-remove-if-not 'sequencep value)))
(max (if lengths (apply 'max lengths) 0))
(min (if lengths (apply 'min lengths) 0)))
;; Ensure VALUE has an orgtbl structure (depth of at least 2).
@@ -262,7 +262,7 @@ This function is called by `org-babel-execute-src-block'."
(ess-ask-for-ess-directory
(and (boundp 'ess-ask-for-ess-directory)
ess-ask-for-ess-directory
- (not (cdr (assoc :dir params))))))
+ (not (cdr (assq :dir params))))))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
@@ -316,8 +316,7 @@ Each member of this list is a list with three members:
:type :family :title :fonts :version
:paper :encoding :pagecentre :colormodel
:useDingbats :horizontal))
- (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
- (match-string 1 out-file)))
+ (device (file-name-extension out-file))
(device-info (or (assq (intern (concat ":" device))
org-babel-R-graphics-devices)
(assq :png org-babel-R-graphics-devices)))
@@ -379,12 +378,12 @@ Has four %s escapes to be filled in:
body result-type result-params column-names-p row-names-p)))
(defun org-babel-R-evaluate-external-process
- (body result-type result-params column-names-p row-names-p)
+ (body result-type result-params column-names-p row-names-p)
"Evaluate BODY in external R process.
If RESULT-TYPE equals `output' then return standard output as a
string. If RESULT-TYPE equals `value' then return the value of the
last statement in BODY, as elisp."
- (case result-type
+ (cl-case result-type
(value
(let ((tmp-file (org-babel-temp-file "R-")))
(org-babel-eval org-babel-R-command
@@ -399,7 +398,7 @@ last statement in BODY, as elisp."
(org-babel-result-cond result-params
(with-temp-buffer
(insert-file-contents tmp-file)
- (buffer-string))
+ (org-babel-chomp (buffer-string) "\n"))
(org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p)))
(output (org-babel-eval org-babel-R-command body))))
@@ -407,12 +406,12 @@ last statement in BODY, as elisp."
(defvar ess-eval-visibly-p)
(defun org-babel-R-evaluate-session
- (session body result-type result-params column-names-p row-names-p)
+ (session body result-type result-params column-names-p row-names-p)
"Evaluate BODY in SESSION.
If RESULT-TYPE equals `output' then return standard output as a
string. If RESULT-TYPE equals `value' then return the value of the
last statement in BODY, as elisp."
- (case result-type
+ (cl-case result-type
(value
(with-temp-buffer
(insert (org-babel-chomp body))
@@ -433,7 +432,7 @@ last statement in BODY, as elisp."
(org-babel-result-cond result-params
(with-temp-buffer
(insert-file-contents tmp-file)
- (buffer-string))
+ (org-babel-chomp (buffer-string) "\n"))
(org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p)))
(output
@@ -446,7 +445,8 @@ last statement in BODY, as elisp."
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
- "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
+ "^\\([>+.]\\([ ][>.+]\\)*[ ]\\)"
+ (car (split-string line "\n")))
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
diff --git a/lisp/ob-abc.el b/lisp/ob-abc.el
index 36ad55d..6872b1c 100644
--- a/lisp/ob-abc.el
+++ b/lisp/ob-abc.el
@@ -1,4 +1,4 @@
-;;; ob-abc.el --- org-babel functions for template evaluation
+;;; ob-abc.el --- Org Babel Functions for ABC -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
@@ -42,7 +42,7 @@
(defun org-babel-expand-body:abc (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
@@ -59,12 +59,10 @@
"Execute a block of ABC code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Abc source code block")
- (let* ((result-params (split-string (or (cdr (assoc :results params)))))
- (cmdline (cdr (assoc :cmdline params)))
- (out-file ((lambda (el)
- (or el
- (error "abc code block requires :file header argument")))
- (replace-regexp-in-string "\.pdf$" ".ps" (cdr (assoc :file params)))))
+ (let* ((cmdline (cdr (assq :cmdline params)))
+ (out-file (let ((file (cdr (assq :file params))))
+ (if file (replace-regexp-in-string "\.pdf$" ".ps" file)
+ (error "abc code block requires :file header argument"))))
(in-file (org-babel-temp-file "abc-"))
(render (concat "abcm2ps" " " cmdline
" -O " (org-babel-process-file-name out-file)
@@ -79,14 +77,14 @@
(file-name-extension out-file))
out-file t))
;;; if we were asked for a pdf...
- (when (string= (file-name-extension (cdr (assoc :file params))) "pdf")
- (org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assoc :file params))) ""))
+ (when (string= (file-name-extension (cdr (assq :file params))) "pdf")
+ (org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assq :file params))) ""))
;;; indicate that the file has been written
nil))
;; This function should be used to assign any variables in params in
;; the context of the session environment.
-(defun org-babel-prep-session:abc (session params)
+(defun org-babel-prep-session:abc (_session _params)
"Return an error because abc does not support sessions."
(error "ABC does not support sessions"))
diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el
index f6492ae..e69afc4 100644
--- a/lisp/ob-asymptote.el
+++ b/lisp/ob-asymptote.el
@@ -1,4 +1,4 @@
-;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
+;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -43,7 +43,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
@@ -55,13 +54,10 @@
(defun org-babel-execute:asymptote (body params)
"Execute a block of Asymptote code.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (out-file (cdr (assoc :file params)))
- (format (or (and out-file
- (string-match ".+\\.\\(.+\\)" out-file)
- (match-string 1 out-file))
+ (let* ((out-file (cdr (assq :file params)))
+ (format (or (file-name-extension out-file)
"pdf"))
- (cmdline (cdr (assoc :cmdline params)))
+ (cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "asymptote-"))
(cmd
(concat "asy "
@@ -79,7 +75,7 @@ This function is called by `org-babel-execute-src-block'."
(message cmd) (shell-command cmd)
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:asymptote (session params)
+(defun org-babel-prep-session:asymptote (_session _params)
"Return an error if the :session header argument is set.
Asymptote does not support sessions"
(error "Asymptote does not support sessions"))
@@ -87,7 +83,7 @@ Asymptote does not support sessions"
(defun org-babel-variable-assignments:asymptote (params)
"Return list of asymptote statements assigning the block's variables."
(mapcar #'org-babel-asymptote-var-to-asymptote
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-asymptote-var-to-asymptote (pair)
"Convert an elisp value into an Asymptote variable.
@@ -124,21 +120,17 @@ a variable of the same value."
DATA is a list. Return type as a symbol.
-The type is `string' if any element in DATA is
-a string. Otherwise, it is either `real', if some elements are
-floats, or `int'."
- (let* ((type 'int)
- find-type ; for byte-compiler
- (find-type
- (function
- (lambda (row)
- (catch 'exit
- (mapc (lambda (el)
- (cond ((listp el) (funcall find-type el))
- ((stringp el) (throw 'exit (setq type 'string)))
- ((floatp el) (setq type 'real))))
- row))))))
- (funcall find-type data) type))
+The type is `string' if any element in DATA is a string.
+Otherwise, it is either `real', if some elements are floats, or
+`int'."
+ (letrec ((type 'int)
+ (find-type
+ (lambda (row)
+ (dolist (e row type)
+ (cond ((listp e) (setq type (funcall find-type e)))
+ ((stringp e) (throw 'exit 'string))
+ ((floatp e) (setq type 'real)))))))
+ (catch 'exit (funcall find-type data)) type))
(provide 'ob-asymptote)
diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el
index 021dd78..90cfe79 100644
--- a/lisp/ob-awk.el
+++ b/lisp/ob-awk.el
@@ -1,4 +1,4 @@
-;;; ob-awk.el --- org-babel functions for awk evaluation
+;;; ob-awk.el --- Babel Functions for Awk -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@@ -27,13 +27,12 @@
;;
;; - :in-file takes a path to a file of data to be processed by awk
;;
-;; - :stdin takes an Org-mode data or code block reference, the value
-;; of which will be passed to the awk process through STDIN
+;; - :stdin takes an Org data or code block reference, the value of
+;; which will be passed to the awk process through STDIN
;;; Code:
(require 'ob)
(require 'org-compat)
-(eval-when-compile (require 'cl))
(declare-function org-babel-ref-resolve "ob-ref" (ref))
(declare-function orgtbl-to-generic "org-table" (table params))
@@ -44,7 +43,7 @@
(defvar org-babel-awk-command "awk"
"Name of the awk executable command.")
-(defun org-babel-expand-body:awk (body params)
+(defun org-babel-expand-body:awk (body _params)
"Expand BODY according to PARAMS, return the expanded body."
body)
@@ -52,13 +51,13 @@
"Execute a block of Awk code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Awk source code block")
- (let* ((result-params (cdr (assoc :result-params params)))
- (cmd-line (cdr (assoc :cmd-line params)))
- (in-file (cdr (assoc :in-file params)))
+ (let* ((result-params (cdr (assq :result-params params)))
+ (cmd-line (cdr (assq :cmd-line params)))
+ (in-file (cdr (assq :in-file params)))
(full-body (org-babel-expand-body:awk body params))
(code-file (let ((file (org-babel-temp-file "awk-")))
(with-temp-file file (insert full-body)) file))
- (stdin (let ((stdin (cdr (assoc :stdin params))))
+ (stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin)))
@@ -71,10 +70,10 @@ called by `org-babel-execute-src-block'"
"-f" code-file cmd-line)
(mapcar (lambda (pair)
(format "-v %s='%s'"
- (cadr pair)
+ (car pair)
(org-babel-awk-var-to-awk
- (cddr pair))))
- (org-babel-get-header params :var))
+ (cdr pair))))
+ (org-babel--get-vars params))
(list in-file))
" ")))
(org-babel-reassemble-table
@@ -91,9 +90,9 @@ called by `org-babel-execute-src-block'"
(with-temp-file tmp (insert results))
(org-babel-import-elisp-from-file tmp)))))
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defun org-babel-awk-var-to-awk (var &optional sep)
"Return a printed value of VAR suitable for parsing with awk."
diff --git a/lisp/ob-calc.el b/lisp/ob-calc.el
index f5e70de..415cab1 100644
--- a/lisp/ob-calc.el
+++ b/lisp/ob-calc.el
@@ -1,4 +1,4 @@
-;;; ob-calc.el --- org-babel functions for calc code evaluation
+;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -28,18 +28,18 @@
;;; Code:
(require 'ob)
(require 'calc)
-(unless (featurep 'xemacs)
- (require 'calc-trail)
- (require 'calc-store))
+(require 'calc-trail)
+(require 'calc-store)
(declare-function calc-store-into "calc-store" (&optional var))
(declare-function calc-recall "calc-store" (&optional var))
(declare-function math-evaluate-expr "calc-ext" (x))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-default-header-args:calc nil
"Default arguments for evaluating an calc source block.")
-(defun org-babel-expand-body:calc (body params)
+(defun org-babel-expand-body:calc (body _params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc
@@ -48,7 +48,7 @@
"Execute a block of calc code with Babel."
(unless (get-buffer "*Calculator*")
(save-window-excursion (calc) (calc-quit)))
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (let* ((vars (org-babel--get-vars params))
(org--var-syms (mapcar #'car vars))
(var-names (mapcar #'symbol-name org--var-syms)))
(mapc
@@ -85,15 +85,17 @@
;; parse line into calc objects
(car (math-read-exprs line)))))))))
))))))
- (mapcar #'org-babel-trim
+ (mapcar #'org-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
(save-excursion
(with-current-buffer (get-buffer "*Calculator*")
- (calc-eval (calc-top 1)))))
+ (prog1
+ (calc-eval (calc-top 1))
+ (calc-pop 1)))))
(defun org-babel-calc-maybe-resolve-var (el)
(if (consp el)
- (if (and (equal 'var (car el)) (member (cadr el) org--var-syms))
+ (if (and (eq 'var (car el)) (member (cadr el) org--var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
index 5b023e6..72ea77d 100644
--- a/lisp/ob-clojure.el
+++ b/lisp/ob-clojure.el
@@ -1,4 +1,4 @@
-;;; ob-clojure.el --- org-babel functions for clojure evaluation
+;;; ob-clojure.el --- Babel Functions for Clojure -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -39,15 +39,15 @@
;; web page: http://technomancy.us/126
;;; Code:
+(require 'cl-lib)
(require 'ob)
-(eval-when-compile
- (require 'cl))
(declare-function cider-current-connection "ext:cider-client" (&optional type))
(declare-function cider-current-session "ext:cider-client" ())
(declare-function nrepl-dict-get "ext:nrepl-client" (dict key))
(declare-function nrepl-sync-request:eval "ext:nrepl-client"
(input connection session &optional ns))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(defvar org-babel-tangle-lang-exts)
@@ -67,18 +67,17 @@
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
+ (let* ((vars (org-babel--get-vars params))
+ (result-params (cdr (assq :result-params params)))
(print-level nil) (print-length nil)
- (body (org-babel-trim
- (if (> (length vars) 0)
- (concat "(let ["
- (mapconcat
- (lambda (var)
- (format "%S (quote %S)" (car var) (cdr var)))
- vars "\n ")
- "]\n" body ")")
- body))))
+ (body (org-trim
+ (if (null vars) (org-trim body)
+ (concat "(let ["
+ (mapconcat
+ (lambda (var)
+ (format "%S (quote %S)" (car var) (cdr var)))
+ vars "\n ")
+ "]\n" body ")")))))
(if (or (member "code" result-params)
(member "pp" result-params))
(format "(clojure.pprint/pprint (do %s))" body)
@@ -88,10 +87,10 @@
"Execute a block of Clojure code with Babel."
(let ((expanded (org-babel-expand-body:clojure body params))
result)
- (case org-babel-clojure-backend
+ (cl-case org-babel-clojure-backend
(cider
(require 'cider)
- (let ((result-params (cdr (assoc :result-params params))))
+ (let ((result-params (cdr (assq :result-params params))))
(setq result
(nrepl-dict-get
(nrepl-sync-request:eval
@@ -108,8 +107,8 @@
(slime-eval
`(swank:eval-and-grab-output
,(buffer-substring-no-properties (point-min) (point-max)))
- (cdr (assoc :package params)))))))
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (cdr (assq :package params)))))))
+ (org-babel-result-cond (cdr (assq :result-params params))
result
(condition-case nil (org-babel-script-escape result)
(error result)))))
diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el
index 8145d2c..dd696c2 100644
--- a/lisp/ob-comint.el
+++ b/lisp/ob-comint.el
@@ -1,4 +1,4 @@
-;;; ob-comint.el --- org-babel functions for interaction with comint buffers
+;;; ob-comint.el --- Babel Functions for Interaction with Comint Buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -33,9 +33,7 @@
(require 'ob-core)
(require 'org-compat)
(require 'comint)
-(eval-when-compile (require 'cl))
-(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
-(declare-function tramp-flush-directory-property "tramp" (vec directory))
+(require 'tramp)
(defun org-babel-comint-buffer-livep (buffer)
"Check if BUFFER is a comint buffer with a live process."
@@ -53,8 +51,9 @@ executed inside the protection of `save-excursion' and
(error "Buffer %s does not exist or has no process" ,buffer))
(save-match-data
(with-current-buffer ,buffer
- (let ((comint-input-filter (lambda (input) nil)))
- ,@body)))))
+ (save-excursion
+ (let ((comint-input-filter (lambda (_input) nil)))
+ ,@body))))))
(def-edebug-spec org-babel-comint-in-buffer (form body))
(defmacro org-babel-comint-with-output (meta &rest body)
@@ -79,7 +78,7 @@ or user `keyboard-quit' during execution of body."
(comint-output-filter-functions
(cons (lambda (text) (setq string-buffer (concat string-buffer text)))
comint-output-filter-functions))
- dangling-text raw)
+ dangling-text)
;; got located, and save dangling text
(goto-char (process-mark (get-buffer-process (current-buffer))))
(let ((start (point))
@@ -107,12 +106,12 @@ or user `keyboard-quit' during execution of body."
(insert dangling-text)
;; remove echo'd FULL-BODY from input
- (if (and ,remove-echo ,full-body
- (string-match
- (replace-regexp-in-string
- "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
- string-buffer))
- (setq raw (substring string-buffer (match-end 0))))
+ (when (and ,remove-echo ,full-body
+ (string-match
+ (replace-regexp-in-string
+ "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
+ string-buffer))
+ (setq string-buffer (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
(def-edebug-spec org-babel-comint-with-output (sexp body))
@@ -145,15 +144,14 @@ Don't return until FILE exists. Code in STRING must ensure that
FILE exists at end of evaluation."
(unless (org-babel-comint-buffer-livep buffer)
(error "Buffer %s does not exist or has no process" buffer))
- (if (file-exists-p file) (delete-file file))
+ (when (file-exists-p file) (delete-file file))
(process-send-string
(get-buffer-process buffer)
(if (= (aref string (1- (length string))) ?\n) string (concat string "\n")))
;; From Tramp 2.1.19 the following cache flush is not necessary
- (if (file-remote-p default-directory)
- (let (v)
- (with-parsed-tramp-file-name default-directory nil
- (tramp-flush-directory-property v ""))))
+ (when (file-remote-p default-directory)
+ (with-parsed-tramp-file-name default-directory nil
+ (tramp-flush-directory-property v "")))
(while (not (file-exists-p file)) (sit-for (or period 0.25))))
(provide 'ob-comint)
diff --git a/lisp/ob-coq.el b/lisp/ob-coq.el
index 210f1a2..7aea5a6 100644
--- a/lisp/ob-coq.el
+++ b/lisp/ob-coq.el
@@ -1,4 +1,4 @@
-;;; ob-coq.el --- org-babel functions for Coq
+;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -35,11 +35,12 @@
(declare-function run-coq "ext:coq-inferior.el" (cmd))
(declare-function coq-proc "ext:coq-inferior.el" ())
+(defvar coq-program-name "coqtop"
+ "Name of the coq toplevel to run.")
+
(defvar org-babel-coq-buffer "*coq*"
"Buffer in which to evaluate coq code blocks.")
-(defvar org-babel-coq-eoe "org-babel-coq-eoe")
-
(defun org-babel-coq-clean-prompt (string)
(if (string-match "^[^[:space:]]+ < " string)
(substring string 0 (match-beginning 0))
@@ -70,7 +71,7 @@ If there is not a current inferior-process-buffer in SESSION then
create one. Return the initialized session."
(unless (fboundp 'run-coq)
(error "`run-coq' not defined, load coq-inferior.el"))
- (save-window-excursion (run-coq "coqtop"))
+ (save-window-excursion (run-coq coq-program-name))
(sit-for 0.1)
(get-buffer org-babel-coq-buffer))
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index fcd15c4..3cfe726 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1,4 +1,4 @@
-;;; ob-core.el --- working with code blocks in org-mode
+;;; ob-core.el --- Working with Code Blocks -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -23,8 +23,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'ob-eval)
(require 'org-macs)
(require 'org-compat)
@@ -34,79 +33,69 @@
".exe"
nil))
-;; dynamically scoped for tramp
-(defvar org-babel-call-process-region-original nil)
(defvar org-babel-library-of-babel)
(defvar org-edit-src-content-indentation)
(defvar org-src-lang-modes)
+(defvar org-src-preserve-indentation)
-(declare-function outline-show-all "outline" ())
-(declare-function org-every "org" (pred seq))
-(declare-function org-get-indentation "org" (&optional line))
-(declare-function org-remove-indentation "org" (code &optional n))
-(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
-(declare-function org-mark-ring-push "org" (&optional pos buffer))
-(declare-function tramp-compat-make-temp-file "tramp-compat"
- (filename &optional dir-flag))
-(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
-(declare-function tramp-file-name-user "tramp" (vec))
-(declare-function tramp-file-name-host "tramp" (vec))
-(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
-(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-at-item-p "org-list" ())
+(declare-function org-at-table-p "org" (&optional table-type))
+(declare-function org-babel-lob-execute-maybe "ob-lob" ())
+(declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
+(declare-function org-babel-ref-headline-body "ob-ref" ())
+(declare-function org-babel-ref-parse "ob-ref" (assignment))
+(declare-function org-babel-ref-resolve "ob-ref" (ref))
+(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
+(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
+(declare-function org-completing-read "org" (&rest args))
+(declare-function org-current-level "org" ())
+(declare-function org-cycle "org" (&optional arg))
+(declare-function org-do-remove-indentation "org" (&optional n))
(declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name))
(declare-function org-edit-src-exit "org-src" ())
-(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
-(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body))
-(declare-function org-outline-overlay-data "org" (&optional use-markers))
-(declare-function org-set-outline-overlay-data "org" (data))
-(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-split-string "org" (string &optional separators))
-(declare-function org-entry-get "org"
- (pom property &optional inherit literal-nil))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-normalize-string "org-element" (s))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
+(declare-function org-escape-code-in-region "org-src" (beg end))
+(declare-function org-get-indentation "org" (&optional line))
+(declare-function org-get-indentation "org" (&optional line))
+(declare-function org-in-regexp "org" (regexp &optional nlines visually))
+(declare-function org-indent-line "org" ())
+(declare-function org-list-get-list-end "org-list" (item struct prevs))
+(declare-function org-list-prevs-alist "org-list" (struct))
+(declare-function org-list-struct "org-list" ())
+(declare-function org-list-to-generic "org-list" (LIST PARAMS))
+(declare-function org-list-to-lisp "org-list" (&optional delete))
+(declare-function org-macro-escape-arguments "org-macro" (&rest args))
(declare-function org-make-options-regexp "org" (kwds &optional extra))
-(declare-function org-do-remove-indentation "org" (&optional n))
+(declare-function org-mark-ring-push "org" (&optional pos buffer))
+(declare-function org-narrow-to-subtree "org" ())
(declare-function org-next-block "org" (arg &optional backward block-regexp))
+(declare-function org-number-sequence "org-compat" (from &optional to inc))
+(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
+(declare-function org-outline-overlay-data "org" (&optional use-markers))
(declare-function org-previous-block "org" (arg &optional block-regexp))
+(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-reverse-string "org" (string))
+(declare-function org-set-outline-overlay-data "org" (data))
(declare-function org-show-context "org" (&optional key))
-(declare-function org-at-table-p "org" (&optional table-type))
-(declare-function org-cycle "org" (&optional arg))
-(declare-function org-uniquify "org" (list))
-(declare-function org-current-level "org" ())
-(declare-function org-table-import "org-table" (file arg))
-(declare-function org-add-hook "org-compat"
- (hook function &optional append local))
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-src-coderef-format "org-src" (element))
+(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-table-align "org-table" ())
(declare-function org-table-end "org-table" (&optional table-type))
+(declare-function org-table-import "org-table" (file arg))
+(declare-function org-table-to-lisp "org-table" (&optional txt))
+(declare-function org-trim "org" (s &optional keep-lead))
+(declare-function org-unescape-code-in-string "org-src" (s))
+(declare-function org-uniquify "org" (list))
(declare-function orgtbl-to-generic "org-table" (table params))
(declare-function orgtbl-to-orgtbl "org-table" (table params))
-(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
-(declare-function org-babel-lob-get-info "ob-lob" nil)
-(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
-(declare-function org-babel-ref-parse "ob-ref" (assignment))
-(declare-function org-babel-ref-resolve "ob-ref" (ref))
-(declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
-(declare-function org-babel-ref-headline-body "ob-ref" ())
-(declare-function org-babel-lob-execute-maybe "ob-lob" ())
-(declare-function org-number-sequence "org-compat" (from &optional to inc))
-(declare-function org-at-item-p "org-list" ())
-(declare-function org-list-parse-list "org-list" (&optional delete))
-(declare-function org-list-to-generic "org-list" (LIST PARAMS))
-(declare-function org-list-struct "org-list" ())
-(declare-function org-list-prevs-alist "org-list" (struct))
-(declare-function org-list-get-list-end "org-list" (item struct prevs))
-(declare-function org-remove-if "org" (predicate seq))
-(declare-function org-completing-read "org" (&rest args))
-(declare-function org-escape-code-in-region "org-src" (beg end))
-(declare-function org-unescape-code-in-string "org-src" (s))
-(declare-function org-table-to-lisp "org-table" (&optional txt))
-(declare-function org-reverse-string "org" (string))
-(declare-function org-element-context "org-element" (&optional element))
-(declare-function org-element-type "org-element" (element))
-(declare-function org-element-at-point "org-element" ())
-(declare-function org-element-normalize-string "org-element" (s))
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-every "org" (pred seq))
-(declare-function org-macro-escape-arguments "org-macro" (&rest args))
+(declare-function outline-show-all "outline" ())
+(declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
@@ -117,10 +106,10 @@
"Confirm before evaluation.
\\<org-mode-map>\
Require confirmation before interactively evaluating code
-blocks in Org-mode buffers. The default value of this variable
-is t, meaning confirmation is required for any code block
-evaluation. This variable can be set to nil to inhibit any
-future confirmation requests. This variable can also be set to a
+blocks in Org buffers. The default value of this variable is t,
+meaning confirmation is required for any code block evaluation.
+This variable can be set to nil to inhibit any future
+confirmation requests. This variable can also be set to a
function which takes two arguments the language of the code block
and the body of the code block. Such a function should then
return a non-nil value if the user should be prompted for
@@ -128,11 +117,11 @@ execution or nil if no prompt is required.
Warning: Disabling confirmation may result in accidental
evaluation of potentially harmful code. It may be advisable
-remove code block execution from \\[org-ctrl-c-ctrl-c] \
+remove code block execution from `\\[org-ctrl-c-ctrl-c]' \
as further protection
against accidental code block evaluation. The
`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
-remove code block execution from the \\[org-ctrl-c-ctrl-c] keybinding."
+remove code block execution from the `\\[org-ctrl-c-ctrl-c]' keybinding."
:group 'org-babel
:version "24.1"
:type '(choice boolean function))
@@ -141,7 +130,7 @@ remove code block execution from the \\[org-ctrl-c-ctrl-c] keybinding."
(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
"\\<org-mode-map>\
-Remove code block evaluation from the \\[org-ctrl-c-ctrl-c] key binding."
+Remove code block evaluation from the `\\[org-ctrl-c-ctrl-c]' key binding."
:group 'org-babel
:version "24.1"
:type 'boolean)
@@ -182,6 +171,14 @@ This string must include a \"%s\" which will be replaced by the results."
(and (stringp value)
(string-match-p "%s" value))))
+(defcustom org-babel-hash-show-time nil
+ "Non-nil means show the time the code block was evaluated in the result hash."
+ :group 'org-babel
+ :type 'boolean
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :safe #'booleanp)
+
(defun org-babel-noweb-wrap (&optional regexp)
(concat org-babel-noweb-wrap-start
(or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
@@ -207,167 +204,100 @@ This string must include a \"%s\" which will be replaced by the results."
"\\([^\000]*?\n\\)??[ \t]*#\\+end_src")
"Regexp used to identify code blocks.")
-(defvar org-babel-inline-src-block-regexp
- (concat
- ;; (1) replacement target (2) lang
- "\\(?:^\\|[^-[:alnum:]]?\\)\\(src_\\([^ \f\t\n\r\v[]+\\)"
- ;; (3,4) (unused, headers)
- "\\(\\|\\[[ \t]*\\(.*?\\)\\]\\)"
- ;; (5) body
- "{\\([^\f\n\r\v]+?\\)}\\)")
- "Regexp used to identify inline src-blocks.")
-
-(defun org-babel-get-header (params key &optional others)
- "Select only header argument of type KEY from a list.
-Optional argument OTHERS indicates that only the header that do
-not match KEY should be returned."
- (delq nil
- (mapcar
- (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
- params)))
-
-(defun org-babel-get-inline-src-block-matches ()
- "Set match data if within body of an inline source block.
-Returns non-nil if match-data set"
- (save-excursion
- (let ((datum (org-element-context)))
- (when (eq (org-element-type datum) 'inline-src-block)
- (goto-char (org-element-property :begin datum))
- (when (looking-at org-babel-inline-src-block-regexp)
- t )))))
-
-(defvar org-babel-inline-lob-one-liner-regexp)
-(defun org-babel-get-lob-one-liner-matches ()
- "Set match data if on line of an lob one liner.
-Returns non-nil if match-data set"
- (save-excursion
- (let ((datum (org-element-context)))
- (when (eq (org-element-type datum) 'inline-babel-call)
- (goto-char (org-element-property :begin datum))))
- (if (looking-at org-babel-inline-lob-one-liner-regexp)
- t
- nil)))
+(defun org-babel--get-vars (params)
+ "Return the babel variable assignments in PARAMS.
-(defun org-babel-get-src-block-info (&optional light)
- "Get information on the current source block.
-
-Optional argument LIGHT does not resolve remote variable
-references; a process which could likely result in the execution
-of other code blocks.
-
-Returns a list
- (language body header-arguments-alist switches name indent block-head)."
- (let ((case-fold-search t) head info name indent)
- ;; full code block
- (if (setq head (org-babel-where-is-src-block-head))
- (save-excursion
- (goto-char head)
- (setq info (org-babel-parse-src-block-match))
- (setq indent (car (last info)))
- (setq info (butlast info))
- (while (and (= 0 (forward-line -1))
- (looking-at org-babel-multi-line-header-regexp))
- (setf (nth 2 info)
- (org-babel-merge-params
- (nth 2 info)
- (org-babel-parse-header-arguments (match-string 1)))))
- (when (looking-at (org-babel-named-src-block-regexp-for-name))
- (setq name (org-match-string-no-properties 9))))
- ;; inline source block
- (when (org-babel-get-inline-src-block-matches)
- (setq head (match-beginning 0))
- (setq info (org-babel-parse-inline-src-block-match))))
- ;; resolve variable references and add summary parameters
- (when (and info (not light))
- (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
- (when info
- (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info))))
- (when info (append info (list name indent head)))))
+PARAMS is a quasi-alist of header args, whcih may contain
+multiple entries for the key `:var'. This function returns a
+list of the cdr of all the `:var' entries."
+ (mapcar #'cdr
+ (cl-remove-if-not (lambda (x) (eq (car x) :var)) params)))
(defvar org-babel-exp-reference-buffer nil
"Buffer containing original contents of the exported buffer.
This is used by Babel to resolve references in source blocks.
Its value is dynamically bound during export.")
-(defmacro org-babel-check-confirm-evaluate (info &rest body)
- "Evaluate BODY with special execution confirmation variables set.
-
-Specifically; NOEVAL will indicate if evaluation is allowed,
-QUERY will indicate if a user query is required, CODE-BLOCK will
-hold the language of the code block, and BLOCK-NAME will hold the
-name of the code block."
- (declare (indent defun))
- (org-with-gensyms
- (lang block-body headers name head eval eval-no export eval-no-export)
- `(let* ((,lang (nth 0 ,info))
- (,block-body (nth 1 ,info))
- (,headers (nth 2 ,info))
- (,name (nth 4 ,info))
- (,head (nth 6 ,info))
- (,eval (or (cdr (assoc :eval ,headers))
- (when (assoc :noeval ,headers) "no")))
- (,eval-no (or (equal ,eval "no")
- (equal ,eval "never")))
- (,export org-babel-exp-reference-buffer)
- (,eval-no-export (and ,export (or (equal ,eval "no-export")
- (equal ,eval "never-export"))))
- (noeval (or ,eval-no ,eval-no-export))
- (query (or (equal ,eval "query")
- (and ,export (equal ,eval "query-export"))
- (if (functionp org-confirm-babel-evaluate)
- (save-excursion
- (goto-char ,head)
- (funcall org-confirm-babel-evaluate
- ,lang ,block-body))
- org-confirm-babel-evaluate)))
- (code-block (if ,info (format " %s " ,lang) " "))
- (block-name (if ,name (format " (%s) " ,name) " ")))
- ;; Silence byte-compiler if `body' doesn't use those vars.
- (ignore noeval query)
- ,@body)))
-
-(defsubst org-babel-check-evaluate (info)
+(defun org-babel-check-confirm-evaluate (info)
+ "Check whether INFO allows code block evaluation.
+
+Returns nil if evaluation is disallowed, t if it is
+unconditionally allowed, and the symbol `query' if the user
+should be asked whether to allow evaluation."
+ (let* ((headers (nth 2 info))
+ (eval (or (cdr (assq :eval headers))
+ (when (assq :noeval headers) "no")))
+ (eval-no (member eval '("no" "never")))
+ (export org-babel-exp-reference-buffer)
+ (eval-no-export (and export (member eval '("no-export" "never-export"))))
+ (noeval (or eval-no eval-no-export))
+ (query (or (equal eval "query")
+ (and export (equal eval "query-export"))
+ (if (functionp org-confirm-babel-evaluate)
+ (save-excursion
+ (goto-char (nth 5 info))
+ (funcall org-confirm-babel-evaluate
+ ;; language, code block body
+ (nth 0 info) (nth 1 info)))
+ org-confirm-babel-evaluate))))
+ (cond
+ (noeval nil)
+ (query 'query)
+ (t t))))
+
+(defun org-babel-check-evaluate (info)
"Check if code block INFO should be evaluated.
-Do not query the user."
- (org-babel-check-confirm-evaluate info
- (not (when noeval
- (message "Evaluation of this%scode-block%sis disabled."
- code-block block-name)))))
- ;; dynamically scoped for asynchronous export
+Do not query the user, but do display an informative message if
+evaluation is blocked. Returns non-nil if evaluation is not blocked."
+ (let ((evalp (org-babel-check-confirm-evaluate info)))
+ (when (null evalp)
+ (message "Evaluation of this %s code-block%sis disabled."
+ (nth 0 info)
+ (let ((name (nth 4 info))) (if name (format " (%s) " name) ""))))
+ evalp))
+
+;; Dynamically scoped for asynchronous export.
(defvar org-babel-confirm-evaluate-answer-no)
-(defsubst org-babel-confirm-evaluate (info)
+(defun org-babel-confirm-evaluate (info)
"Confirm evaluation of the code block INFO.
-If the variable `org-babel-confirm-evaluate-answer-no' is bound
-to a non-nil value, auto-answer with \"no\".
-
This query can also be suppressed by setting the value of
`org-confirm-babel-evaluate' to nil, in which case all future
interactive code block evaluations will proceed without any
confirmation from the user.
Note disabling confirmation may result in accidental evaluation
-of potentially harmful code."
- (org-babel-check-confirm-evaluate info
- (not (when query
- (unless
- (and (not (org-bound-and-true-p
+of potentially harmful code.
+
+The variable `org-babel-confirm-evaluate-answer-no' is used by
+the async export process, which requires a non-interactive
+environment, to override this check."
+ (let* ((evalp (org-babel-check-confirm-evaluate info))
+ (lang (nth 0 info))
+ (name (nth 4 info))
+ (name-string (if name (format " (%s) " name) " ")))
+ (pcase evalp
+ (`nil nil)
+ (`t t)
+ (`query (or
+ (and (not (bound-and-true-p
org-babel-confirm-evaluate-answer-no))
(yes-or-no-p
- (format "Evaluate this%scode block%son your system? "
- code-block block-name)))
- (message "Evaluation of this%scode-block%sis aborted."
- code-block block-name))))))
+ (format "Evaluate this %s code block%son your system? "
+ lang name-string)))
+ (progn
+ (message "Evaluation of this %s code-block%sis aborted."
+ lang name-string)
+ nil)))
+ (x (error "Unexpected value `%s' from `org-babel-check-confirm-evaluate'" x)))))
;;;###autoload
(defun org-babel-execute-safely-maybe ()
(unless org-babel-no-eval-on-ctrl-c-ctrl-c
(org-babel-execute-maybe)))
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe)
-
;;;###autoload
(defun org-babel-execute-maybe ()
(interactive)
@@ -378,8 +308,8 @@ of potentially harmful code."
"Execute BODY if point is in a source block and return t.
Otherwise do nothing and return nil."
- `(if (or (org-babel-where-is-src-block-head)
- (org-babel-get-inline-src-block-matches))
+ `(if (memq (org-element-type (org-element-context))
+ '(inline-src-block src-block))
(progn
,@body
t)
@@ -530,7 +460,7 @@ their `org-babel-default-header-args:foo' variable.
For the format of SAFE-LIST, see `org-babel-safe-header-args'."
`(lambda (value)
(and (listp value)
- (org-every
+ (cl-every
(lambda (pair)
(and (consp pair)
(org-babel-one-header-arg-safe-p pair ,safe-list)))
@@ -550,22 +480,26 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'."
(put 'org-babel-default-inline-header-args 'safe-local-variable
(org-babel-header-args-safe-fn org-babel-safe-header-args))
-(defvar org-babel-data-names '("tblname" "results" "name"))
-
-(defvar org-babel-result-regexp
- (concat "^[ \t]*#\\+"
- (regexp-opt org-babel-data-names t)
- "\\(\\[\\("
- ;; FIXME The string below is `org-ts-regexp'
- "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
- " \\)?\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*")
+(defconst org-babel-name-regexp
+ (format "^[ \t]*#\\+%s:[ \t]*"
+ ;; FIXME: TBLNAME is for backward compatibility.
+ (regexp-opt '("NAME" "TBLNAME")))
+ "Regexp matching a NAME keyword.")
+
+(defconst org-babel-result-regexp
+ (format "^[ \t]*#\\+%s\\(?:\\[\\(?:%s \\)?\\([[:alnum:]]+\\)\\]\\)?:[ \t]*"
+ org-babel-results-keyword
+ ;; <%Y-%m-%d %H:%M:%S>
+ "<\\(?:[0-9]\\{4\\}-[0-1][0-9]-[0-3][0-9] \
+[0-2][0-9]\\(?::[0-5][0-9]\\)\\{2\\}\\)>")
"Regular expression used to match result lines.
If the results are associated with a hash key then the hash will
-be saved in the second match data.")
+be saved in match group 1.")
-(defvar org-babel-result-w-name-regexp
- (concat org-babel-result-regexp
- "\\([^ ()\f\t\n\r\v]+\\)\\((\\(.*\\))\\|\\)"))
+(defconst org-babel-result-w-name-regexp
+ (concat org-babel-result-regexp "\\(?9:[^ \t\n\r\v\f]+\\)")
+ "Regexp matching a RESULTS keyword with a name.
+Name is saved in match group 9.")
(defvar org-babel-min-lines-for-block-output 10
"The minimum number of lines for block output.
@@ -590,9 +524,6 @@ to raise errors for all languages.")
(defvar org-babel-hash-show 4
"Number of initial characters to show of a hidden results hash.")
-(defvar org-babel-hash-show-time nil
- "Non-nil means show the time the code block was evaluated in the result hash.")
-
(defvar org-babel-after-execute-hook nil
"Hook for functions to be called after `org-babel-execute-src-block'")
@@ -609,10 +540,27 @@ match group 9. Other match groups are defined in
(defun org-babel-named-data-regexp-for-name (name)
"This generates a regexp used to match data named NAME."
- (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)"))
+ (concat org-babel-name-regexp (regexp-quote name) "[ \t]*$"))
+
+(defun org-babel--normalize-body (datum)
+ "Normalize body for element or object DATUM.
+DATUM is a source block element or an inline source block object.
+Remove final newline character and spurious indentation."
+ (let* ((value (org-element-property :value datum))
+ (body (if (string-suffix-p "\n" value)
+ (substring value 0 -1)
+ value)))
+ (cond ((eq (org-element-type datum) 'inline-src-block)
+ ;; Newline characters and indentation in an inline
+ ;; src-block are not meaningful, since they could come from
+ ;; some paragraph filling. Treat them as a white space.
+ (replace-regexp-in-string "\n[ \t]*" " " body))
+ ((or org-src-preserve-indentation
+ (org-element-property :preserve-indent datum))
+ body)
+ (t (org-remove-indentation body)))))
;;; functions
-(defvar call-process-region)
(defvar org-babel-current-src-block-location nil
"Marker pointing to the src block currently being executed.
This may also point to a call line or an inline code block. If
@@ -622,6 +570,56 @@ the outer-most code block.")
(defvar *this*)
+(defun org-babel-get-src-block-info (&optional light datum)
+ "Extract information from a source block or inline source block.
+
+Optional argument LIGHT does not resolve remote variable
+references; a process which could likely result in the execution
+of other code blocks.
+
+By default, consider the block at point. However, when optional
+argument DATUM is provided, extract information from that parsed
+object instead.
+
+Return nil if point is not on a source block. Otherwise, return
+a list with the following pattern:
+
+ (language body arguments switches name start coderef)"
+ (let* ((datum (or datum (org-element-context)))
+ (type (org-element-type datum))
+ (inline (eq type 'inline-src-block)))
+ (when (memq type '(inline-src-block src-block))
+ (let* ((lang (org-element-property :language datum))
+ (lang-headers (intern
+ (concat "org-babel-default-header-args:" lang)))
+ (name (org-element-property :name datum))
+ (info
+ (list
+ lang
+ (org-babel--normalize-body datum)
+ (apply #'org-babel-merge-params
+ (if inline org-babel-default-inline-header-args
+ org-babel-default-header-args)
+ (and (boundp lang-headers) (eval lang-headers t))
+ (append
+ ;; If DATUM is provided, make sure we get node
+ ;; properties applicable to its location within
+ ;; the document.
+ (org-with-point-at (org-element-property :begin datum)
+ (org-babel-params-from-properties lang))
+ (mapcar #'org-babel-parse-header-arguments
+ (cons (org-element-property :parameters datum)
+ (org-element-property :header datum)))))
+ (or (org-element-property :switches datum) "")
+ name
+ (org-element-property (if inline :begin :post-affiliated)
+ datum)
+ (and (not inline) (org-src-coderef-format datum)))))
+ (unless light
+ (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
+ (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))
+ info))))
+
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params)
"Execute the current source code block.
@@ -641,114 +639,91 @@ block."
(interactive)
(let* ((org-babel-current-src-block-location
(or org-babel-current-src-block-location
- (nth 6 info)
- (org-babel-where-is-src-block-head)
- ;; inline src block
- (and (org-babel-get-inline-src-block-matches)
- (match-beginning 0))))
- (info (if info
- (copy-tree info)
- (org-babel-get-src-block-info)))
- (merged-params (org-babel-merge-params (nth 2 info) params)))
- (when (org-babel-check-evaluate
- (let ((i info)) (setf (nth 2 i) merged-params) i))
- (let* ((params (if params
- (org-babel-process-params merged-params)
- (nth 2 info)))
- (cachep (and (not arg) (cdr (assoc :cache params))
- (string= "yes" (cdr (assoc :cache params)))))
- (new-hash (when cachep (org-babel-sha1-hash info)))
- (old-hash (when cachep (org-babel-current-result-hash)))
- (cache-current-p (and (not arg) new-hash
- (equal new-hash old-hash))))
+ (nth 5 info)
+ (org-babel-where-is-src-block-head)))
+ (info (if info (copy-tree info) (org-babel-get-src-block-info))))
+ ;; Merge PARAMS with INFO before considering source block
+ ;; evaluation since both could disagree.
+ (cl-callf org-babel-merge-params (nth 2 info) params)
+ (when (org-babel-check-evaluate info)
+ (cl-callf org-babel-process-params (nth 2 info))
+ (let* ((params (nth 2 info))
+ (cache (let ((c (cdr (assq :cache params))))
+ (and (not arg) c (string= "yes" c))))
+ (new-hash (and cache (org-babel-sha1-hash info)))
+ (old-hash (and cache (org-babel-current-result-hash)))
+ (current-cache (and new-hash (equal new-hash old-hash))))
(cond
- (cache-current-p
- (save-excursion ;; return cached result
+ (current-cache
+ (save-excursion ;Return cached result.
(goto-char (org-babel-where-is-src-block-result nil info))
(forward-line)
(skip-chars-forward " \t")
(let ((result (org-babel-read-result)))
- (message (replace-regexp-in-string
- "%" "%%" (format "%S" result)))
+ (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
result)))
- ((org-babel-confirm-evaluate
- (let ((i info)) (setf (nth 2 i) merged-params) i))
+ ((org-babel-confirm-evaluate info)
(let* ((lang (nth 0 info))
- (result-params (cdr (assoc :result-params params)))
- (body (setf (nth 1 info)
- (if (org-babel-noweb-p params :eval)
- (org-babel-expand-noweb-references info)
- (nth 1 info))))
- (dir (cdr (assoc :dir params)))
+ (result-params (cdr (assq :result-params params)))
+ ;; Expand noweb references in BODY and remove any
+ ;; coderef.
+ (body
+ (let ((coderef (nth 6 info))
+ (expand
+ (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
+ (if (not coderef) expand
+ (replace-regexp-in-string
+ (org-src-coderef-regexp coderef) "" expand nil nil 1))))
+ (dir (cdr (assq :dir params)))
(default-directory
(or (and dir (file-name-as-directory (expand-file-name dir)))
default-directory))
- (org-babel-call-process-region-original ;; for tramp handler
- (or (org-bound-and-true-p
- org-babel-call-process-region-original)
- (symbol-function 'call-process-region)))
- (indent (nth 5 info))
- result cmd)
- (unwind-protect
- (let ((call-process-region
- (lambda (&rest args)
- (apply 'org-babel-tramp-handle-call-process-region
- args))))
- (let ((lang-check
- (lambda (f)
- (let ((f (intern (concat "org-babel-execute:" f))))
- (when (fboundp f) f)))))
- (setq cmd
- (or (funcall lang-check lang)
- (funcall lang-check
- (symbol-name
- (cdr (assoc lang org-src-lang-modes))))
- (error "No org-babel-execute function for %s!"
- lang))))
- (message "executing %s code block%s..."
- (capitalize lang)
- (if (nth 4 info) (format " (%s)" (nth 4 info)) ""))
- (if (member "none" result-params)
- (progn
- (funcall cmd body params)
- (message "result silenced")
- (setq result nil))
- (setq result
- (let ((result (funcall cmd body params)))
- (if (and (eq (cdr (assoc :result-type params))
- 'value)
- (or (member "vector" result-params)
- (member "table" result-params))
- (not (listp result)))
- (list (list result)) result)))
- ;; If non-empty result and :file then write to :file.
- (when (cdr (assoc :file params))
- (when result
- (with-temp-file (cdr (assoc :file params))
- (insert
- (org-babel-format-result
- result (cdr (assoc :sep (nth 2 info)))))))
- (setq result (cdr (assoc :file params))))
- ;; Possibly perform post process provided its appropriate.
- (when (cdr (assoc :post params))
- (let ((*this* (if (cdr (assoc :file params))
- (org-babel-result-to-file
- (cdr (assoc :file params))
- (when (assoc :file-desc params)
- (or (cdr (assoc :file-desc params))
- result)))
- result)))
- (setq result (org-babel-ref-resolve
- (cdr (assoc :post params))))
- (when (cdr (assoc :file params))
- (setq result-params
- (remove "file" result-params)))))
- (org-babel-insert-result
- result result-params info new-hash indent lang))
- (run-hooks 'org-babel-after-execute-hook)
- result)
- (setq call-process-region
- 'org-babel-call-process-region-original)))))))))
+ (cmd (intern (concat "org-babel-execute:" lang)))
+ result)
+ (unless (fboundp cmd)
+ (error "No org-babel-execute function for %s!" lang))
+ (message "executing %s code block%s..."
+ (capitalize lang)
+ (let ((name (nth 4 info)))
+ (if name (format " (%s)" name) "")))
+ (if (member "none" result-params)
+ (progn (funcall cmd body params)
+ (message "result silenced"))
+ (setq result
+ (let ((r (funcall cmd body params)))
+ (if (and (eq (cdr (assq :result-type params)) 'value)
+ (or (member "vector" result-params)
+ (member "table" result-params))
+ (not (listp r)))
+ (list (list r))
+ r)))
+ (let ((file (cdr (assq :file params))))
+ ;; If non-empty result and :file then write to :file.
+ (when file
+ (when result
+ (with-temp-file file
+ (insert (org-babel-format-result
+ result (cdr (assq :sep params))))))
+ (setq result file))
+ ;; Possibly perform post process provided its
+ ;; appropriate. Dynamically bind "*this*" to the
+ ;; actual results of the block.
+ (let ((post (cdr (assq :post params))))
+ (when post
+ (let ((*this* (if (not file) result
+ (org-babel-result-to-file
+ file
+ (let ((desc (assq :file-desc params)))
+ (and desc (or (cdr desc) result)))))))
+ (setq result (org-babel-ref-resolve post))
+ (when file
+ (setq result-params (remove "file" result-params))))))
+ (org-babel-insert-result
+ result result-params info new-hash lang)))
+ (run-hooks 'org-babel-after-execute-hook)
+ result)))))))
(defun org-babel-expand-body:generic (body params &optional var-lines)
"Expand BODY with PARAMS.
@@ -756,8 +731,8 @@ Expand a block of code with org-babel according to its header
arguments. This generic implementation of body expansion is
called for languages which have not defined their own specific
org-babel-expand-body:lang function."
- (let ((pro (cdr (assoc :prologue params)))
- (epi (cdr (assoc :epilogue params))))
+ (let ((pro (cdr (assq :prologue params)))
+ (epi (cdr (assq :epilogue params))))
(mapconcat #'identity
(append (when pro (list pro))
var-lines
@@ -788,7 +763,7 @@ arguments and pop open the results in a preview buffer."
(org-babel-expand-body:generic
body params (and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
- (if (org-called-interactively-p 'any)
+ (if (called-interactively-p 'any)
(org-edit-src-code
expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
expanded)))
@@ -821,7 +796,7 @@ arguments and pop open the results in a preview buffer."
(dolist (arg-pair new-list)
(let ((header (car arg-pair)))
(setq results
- (cons arg-pair (org-remove-if
+ (cons arg-pair (cl-remove-if
(lambda (pair) (equal header (car pair)))
results))))))
results))
@@ -854,13 +829,13 @@ arguments and pop open the results in a preview buffer."
(interactive)
(let* ((info (org-babel-get-src-block-info 'light))
(lang (car info))
- (begin (nth 6 info))
+ (begin (nth 5 info))
(lang-headers (intern (concat "org-babel-header-args:" lang)))
(headers (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values
- (when (boundp lang-headers) (eval lang-headers))))
+ (when (boundp lang-headers) (eval lang-headers t))))
(header-arg (or header-arg
- (org-icompleting-read
+ (completing-read
"Header Arg: "
(mapcar
(lambda (header-spec) (symbol-name (car header-spec)))
@@ -873,7 +848,7 @@ arguments and pop open the results in a preview buffer."
((listp vals)
(mapconcat
(lambda (group)
- (let ((arg (org-icompleting-read
+ (let ((arg (completing-read
"Value: "
(cons "default"
(mapcar #'symbol-name group)))))
@@ -896,7 +871,7 @@ arguments and pop open the results in a preview buffer."
(defun org-babel-enter-header-arg-w-completion (&optional lang)
"Insert header argument appropriate for LANG with completion."
(let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang)))
- (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var)))
+ (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var t)))
(headers-w-values (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values lang-headers))
(headers (mapcar #'symbol-name (mapcar #'car headers-w-values)))
@@ -927,8 +902,8 @@ session."
(if (org-babel-noweb-p params :eval)
(org-babel-expand-noweb-references info)
(nth 1 info)))))
- (session (cdr (assoc :session params)))
- (dir (cdr (assoc :dir params)))
+ (session (cdr (assq :session params)))
+ (dir (cdr (assq :dir params)))
(default-directory
(or (and dir (file-name-as-directory dir)) default-directory))
(cmd (intern (concat "org-babel-load-session:" lang))))
@@ -948,17 +923,17 @@ the session. Copy the body of the code block to the kill ring."
(lang (nth 0 info))
(body (nth 1 info))
(params (nth 2 info))
- (session (cdr (assoc :session params)))
- (dir (cdr (assoc :dir params)))
+ (session (cdr (assq :session params)))
+ (dir (cdr (assq :dir params)))
(default-directory
(or (and dir (file-name-as-directory dir)) default-directory))
(init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
(prep-cmd (intern (concat "org-babel-prep-session:" lang))))
- (if (and (stringp session) (string= session "none"))
- (error "This block is not using a session!"))
+ (when (and (stringp session) (string= session "none"))
+ (error "This block is not using a session!"))
(unless (fboundp init-cmd)
(error "No org-babel-initiate-session function for %s!" lang))
- (with-temp-buffer (insert (org-babel-trim body))
+ (with-temp-buffer (insert (org-trim body))
(copy-region-as-kill (point-min) (point-max)))
(when arg
(unless (fboundp prep-cmd)
@@ -1013,10 +988,10 @@ Return t if a code block was found at point, nil otherwise."
"Read key sequence and execute the command in edit buffer.
Enter a key sequence to be executed in the language major-mode
edit buffer. For example, TAB will alter the contents of the
-Org-mode code block according to the effect of TAB in the
-language major-mode buffer. For languages that support
-interactive sessions, this can be used to send code from the Org
-buffer to the session for evaluation using the native major-mode
+Org code block according to the effect of TAB in the language
+major mode buffer. For languages that support interactive
+sessions, this can be used to send code from the Org buffer
+to the session for evaluation using the native major mode
evaluation mechanisms."
(interactive "kEnter key-sequence to execute in edit buffer: ")
(org-babel-do-in-edit-buffer
@@ -1050,7 +1025,7 @@ results already exist."
;; file results
(org-open-at-point)
(let ((r (org-babel-format-result
- (org-babel-read-result) (cdr (assoc :sep (nth 2 info))))))
+ (org-babel-read-result) (cdr (assq :sep (nth 2 info))))))
(pop-to-buffer (get-buffer-create "*Org-Babel Results*"))
(delete-region (point-min) (point-max))
(insert r)))
@@ -1121,81 +1096,91 @@ end-body --------- point at the end of the body"
;;;###autoload
(defmacro org-babel-map-inline-src-blocks (file &rest body)
- "Evaluate BODY forms on each inline source-block in FILE.
+ "Evaluate BODY forms on each inline source block in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer."
- (declare (indent 1))
- (let ((tempvar (make-symbol "file")))
+ (declare (indent 1) (debug (form body)))
+ (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
`(let* ((case-fold-search t)
(,tempvar ,file)
- (visited-p (or (null ,tempvar)
+ (,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
+ (,point (point))
+ ,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
+ (setq ,to-be-removed (current-buffer))
(goto-char (point-min))
- (while (re-search-forward org-babel-inline-src-block-regexp nil t)
- (when (org-babel-active-location-p)
- (goto-char (match-beginning 1))
- (save-match-data ,@body))
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-inline-src-blocks (form body))
-
-(defvar org-babel-lob-one-liner-regexp)
+ (while (re-search-forward "src_\\S-" nil t)
+ (let ((,datum (save-match-data (org-element-context))))
+ (when (eq (org-element-type ,datum) 'inline-src-block)
+ (goto-char (match-beginning 0))
+ (let ((,end (copy-marker (org-element-property :end ,datum))))
+ ,@body
+ (goto-char ,end)
+ (set-marker ,end nil))))))
+ (unless ,visitedp (kill-buffer ,to-be-removed))
+ (goto-char ,point))))
;;;###autoload
(defmacro org-babel-map-call-lines (file &rest body)
"Evaluate BODY forms on each call line in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer."
- (declare (indent 1))
- (let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
- (visited-p (or (null ,tempvar)
+ (declare (indent 1) (debug (form body)))
+ (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
+ `(let* ((case-fold-search t)
+ (,tempvar ,file)
+ (,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
+ (,point (point))
+ ,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
+ (setq ,to-be-removed (current-buffer))
(goto-char (point-min))
- (while (re-search-forward org-babel-lob-one-liner-regexp nil t)
- (when (org-babel-active-location-p)
- (goto-char (match-beginning 1))
- (save-match-data ,@body))
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-call-lines (form body))
+ (while (re-search-forward "call_\\S-\\|^[ \t]*#\\+CALL:" nil t)
+ (let ((,datum (save-match-data (org-element-context))))
+ (when (memq (org-element-type ,datum)
+ '(babel-call inline-babel-call))
+ (goto-char (match-beginning 0))
+ (let ((,end (copy-marker (org-element-property :end ,datum))))
+ ,@body
+ (goto-char ,end)
+ (set-marker ,end nil))))))
+ (unless ,visitedp (kill-buffer ,to-be-removed))
+ (goto-char ,point))))
;;;###autoload
(defmacro org-babel-map-executables (file &rest body)
- (declare (indent 1))
- (let ((tempvar (make-symbol "file"))
- (rx (make-symbol "rx")))
- `(let* ((,tempvar ,file)
- (,rx (concat "\\(" org-babel-src-block-regexp
- "\\|" org-babel-inline-src-block-regexp
- "\\|" org-babel-lob-one-liner-regexp "\\)"))
- (visited-p (or (null ,tempvar)
+ "Evaluate BODY forms on each active Babel code in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer."
+ (declare (indent 1) (debug (form body)))
+ (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
+ `(let* ((case-fold-search t)
+ (,tempvar ,file)
+ (,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
+ (,point (point))
+ ,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
+ (setq ,to-be-removed (current-buffer))
(goto-char (point-min))
- (while (re-search-forward ,rx nil t)
- (when (org-babel-active-location-p)
- (goto-char (match-beginning 1))
- (when (looking-at org-babel-inline-src-block-regexp)
- (forward-char 1))
- (save-match-data ,@body))
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-executables (form body))
+ (while (re-search-forward
+ "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)" nil t)
+ (let ((,datum (save-match-data (org-element-context))))
+ (when (memq (org-element-type ,datum)
+ '(babel-call inline-babel-call inline-src-block
+ src-block))
+ (goto-char (match-beginning 0))
+ (let ((,end (copy-marker (org-element-property :end ,datum))))
+ ,@body
+ (goto-char ,end)
+ (set-marker ,end nil))))))
+ (unless ,visitedp (kill-buffer ,to-be-removed))
+ (goto-char ,point))))
;;;###autoload
(defun org-babel-execute-buffer (&optional arg)
@@ -1206,7 +1191,8 @@ the current buffer."
(org-babel-eval-wipe-error-buffer)
(org-save-outline-visibility t
(org-babel-map-executables nil
- (if (looking-at org-babel-lob-one-liner-regexp)
+ (if (memq (org-element-type (org-element-context))
+ '(babel-call inline-babel-call))
(org-babel-lob-execute-maybe)
(org-babel-execute-src-block arg)))))
@@ -1275,24 +1261,30 @@ the current subtree."
(nth 2 info))) ":")
expanded))
(hash (sha1 it)))
- (when (org-called-interactively-p 'interactive) (message hash))
+ (when (called-interactively-p 'interactive) (message hash))
hash))))
(defun org-babel-current-result-hash (&optional info)
"Return the current in-buffer hash."
- (org-babel-where-is-src-block-result nil info)
- (org-no-properties (match-string 5)))
+ (let ((result (org-babel-where-is-src-block-result nil info)))
+ (when result
+ (org-with-wide-buffer
+ (goto-char result)
+ (looking-at org-babel-result-regexp)
+ (match-string-no-properties 1)))))
(defun org-babel-set-current-result-hash (hash info)
"Set the current in-buffer hash to HASH."
- (org-babel-where-is-src-block-result nil info)
- (save-excursion (goto-char (match-beginning 5))
- (mapc #'delete-overlay (overlays-at (point)))
- (forward-char org-babel-hash-show)
- (mapc #'delete-overlay (overlays-at (point)))
- (replace-match hash nil nil nil 5)
- (goto-char (point-at-bol))
- (org-babel-hide-hash)))
+ (org-with-wide-buffer
+ (goto-char (org-babel-where-is-src-block-result nil info))
+ (looking-at org-babel-result-regexp)
+ (goto-char (match-beginning 1))
+ (mapc #'delete-overlay (overlays-at (point)))
+ (forward-char org-babel-hash-show)
+ (mapc #'delete-overlay (overlays-at (point)))
+ (replace-match hash nil nil nil 1)
+ (beginning-of-line)
+ (org-babel-hide-hash)))
(defun org-babel-hide-hash ()
"Hide the hash in the current results line.
@@ -1301,11 +1293,11 @@ will remain visible."
(add-to-invisibility-spec '(org-babel-hide-hash . t))
(save-excursion
(when (and (re-search-forward org-babel-result-regexp nil t)
- (match-string 5))
- (let* ((start (match-beginning 5))
+ (match-string 1))
+ (let* ((start (match-beginning 1))
(hide-start (+ org-babel-hash-show start))
- (end (match-end 5))
- (hash (match-string 5))
+ (end (match-end 1))
+ (hash (match-string 1))
ov1 ov2)
(setq ov1 (make-overlay start hide-start))
(setq ov2 (make-overlay hide-start end))
@@ -1329,13 +1321,12 @@ the `org-mode-hook'."
"Return the value of the hash at POINT.
\\<org-mode-map>\
The hash is also added as the last element of the kill ring.
-This can be called with \\[org-ctrl-c-ctrl-c]."
+This can be called with `\\[org-ctrl-c-ctrl-c]'."
(interactive)
(let ((hash (car (delq nil (mapcar
(lambda (ol) (overlay-get ol 'babel-hash))
(overlays-at (or point (point))))))))
(when hash (kill-new hash) (message hash))))
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point)
(defun org-babel-result-hide-spec ()
"Hide portions of results lines.
@@ -1389,15 +1380,15 @@ portions of results lines."
(eq (overlay-get overlay 'invisible)
'org-babel-hide-result))
(overlays-at start)))
- (if (or (not force) (eq force 'off))
- (mapc (lambda (ov)
- (when (member ov org-babel-hide-result-overlays)
- (setq org-babel-hide-result-overlays
- (delq ov org-babel-hide-result-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-babel-hide-result)
- (delete-overlay ov)))
- (overlays-at start)))
+ (when (or (not force) (eq force 'off))
+ (mapc (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov)))
+ (overlays-at start)))
(setq ov (make-overlay start end))
(overlay-put ov 'invisible 'org-babel-hide-result)
;; make the block accessible to isearch
@@ -1417,8 +1408,8 @@ portions of results lines."
(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
- (lambda () (org-add-hook 'change-major-mode-hook
- 'org-babel-show-result-all 'append 'local)))
+ (lambda () (add-hook 'change-major-mode-hook
+ 'org-babel-show-result-all 'append 'local)))
(defvar org-file-properties)
(defun org-babel-params-from-properties (&optional lang)
@@ -1427,21 +1418,6 @@ Return a list of association lists of source block params
specified in the properties of the current outline entry."
(save-match-data
(list
- ;; DEPRECATED header arguments specified as separate property at
- ;; point of definition.
- (org-babel-parse-multiple-vars
- (delq nil
- (mapcar
- (lambda (header)
- (let* ((arg (symbol-name (car header)))
- (val (org-entry-get (point) arg t)))
- (and val
- (cons (intern (concat ":" arg))
- (org-babel-read val)))))
- (org-babel-combine-header-arg-lists
- org-babel-common-header-args-w-values
- (let ((sym (intern (concat "org-babel-header-args:" lang))))
- (and (boundp sym) (symbol-value sym)))))))
;; header arguments specified with the header-args property at
;; point of call.
(org-babel-parse-header-arguments
@@ -1454,54 +1430,6 @@ specified in the properties of the current outline entry."
(concat "header-args:" lang)
'inherit))))))
-(defvar org-src-preserve-indentation) ;; declare defcustom from org-src
-(defun org-babel-parse-src-block-match ()
- "Parse the results from a match of the `org-babel-src-block-regexp'."
- (let* ((block-indentation (string-width (match-string 1)))
- (lang (org-match-string-no-properties 2))
- (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
- (switches (match-string 3))
- (body (let* ((body (org-match-string-no-properties 5))
- (sub-length (- (length body) 1)))
- (if (and (> sub-length 0)
- (string= "\n" (substring body sub-length)))
- (substring body 0 sub-length)
- (or body ""))))
- (preserve-indentation (or org-src-preserve-indentation
- (save-match-data
- (string-match "-i\\>" switches)))))
- (list lang
- ;; get block body less properties, protective commas, and indentation
- (with-temp-buffer
- (save-match-data
- (insert (org-unescape-code-in-string body))
- (unless preserve-indentation (org-do-remove-indentation))
- (buffer-string)))
- (apply #'org-babel-merge-params
- org-babel-default-header-args
- (when (boundp lang-headers) (eval lang-headers))
- (append
- (org-babel-params-from-properties lang)
- (list (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) ""))))))
- switches
- block-indentation)))
-
-(defun org-babel-parse-inline-src-block-match ()
- "Parse the results from a match of the `org-babel-inline-src-block-regexp'."
- (let* ((lang (org-no-properties (match-string 2)))
- (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
- (list lang
- (org-unescape-code-in-string (org-no-properties (match-string 5)))
- (apply #'org-babel-merge-params
- org-babel-default-inline-header-args
- (if (boundp lang-headers) (eval lang-headers) nil)
- (append
- (org-babel-params-from-properties lang)
- (list (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) ""))))))
- nil)))
-
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
ALTS is a cons of two character options where each option may be
@@ -1540,7 +1468,7 @@ instances of \"[ \t]:\" set ALTS to ((32 9) . 58)."
(let ((last= (lambda (str) (= ch (aref str (1- (length str))))))
(first= (lambda (str) (= ch (aref str 0)))))
(reverse
- (org-reduce (lambda (acc el)
+ (cl-reduce (lambda (acc el)
(let ((head (car acc)))
(if (and head (or (funcall last= head) (funcall first= el)))
(cons (concat head el) (cdr acc))
@@ -1573,7 +1501,7 @@ shown below.
(let (results)
(mapc (lambda (pair)
(if (eq (car pair) :var)
- (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results))
+ (mapcar (lambda (v) (push (cons :var (org-trim v)) results))
(org-babel-join-splits-near-ch
61 (org-babel-balanced-split (cdr pair) 32)))
(push pair results)))
@@ -1583,38 +1511,39 @@ shown below.
(defun org-babel-process-params (params)
"Expand variables in PARAMS and add summary parameters."
(let* ((processed-vars (mapcar (lambda (el)
- (if (consp (cdr el))
- (cdr el)
- (org-babel-ref-parse (cdr el))))
- (org-babel-get-header params :var)))
- (vars-and-names (if (and (assoc :colname-names params)
- (assoc :rowname-names params))
+ (if (consp el)
+ el
+ (org-babel-ref-parse el)))
+ (org-babel--get-vars params)))
+ (vars-and-names (if (and (assq :colname-names params)
+ (assq :rowname-names params))
(list processed-vars)
(org-babel-disassemble-tables
processed-vars
- (cdr (assoc :hlines params))
- (cdr (assoc :colnames params))
- (cdr (assoc :rownames params)))))
- (raw-result (or (cdr (assoc :results params)) ""))
- (result-params (append
- (split-string (if (stringp raw-result)
- raw-result
- (eval raw-result)))
- (cdr (assoc :result-params params)))))
+ (cdr (assq :hlines params))
+ (cdr (assq :colnames params))
+ (cdr (assq :rownames params)))))
+ (raw-result (or (cdr (assq :results params)) ""))
+ (result-params (delete-dups
+ (append
+ (split-string (if (stringp raw-result)
+ raw-result
+ (eval raw-result t)))
+ (cdr (assq :result-params params))))))
(append
(mapcar (lambda (var) (cons :var var)) (car vars-and-names))
(list
- (cons :colname-names (or (cdr (assoc :colname-names params))
+ (cons :colname-names (or (cdr (assq :colname-names params))
(cadr vars-and-names)))
- (cons :rowname-names (or (cdr (assoc :rowname-names params))
- (caddr vars-and-names)))
+ (cons :rowname-names (or (cdr (assq :rowname-names params))
+ (cl-caddr vars-and-names)))
(cons :result-params result-params)
(cons :result-type (cond ((member "output" result-params) 'output)
((member "value" result-params) 'value)
(t 'value))))
- (org-remove-if
+ (cl-remove-if
(lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params
- :result-type :var)))
+ :result-type :var)))
params))))
;; row and column names
@@ -1627,7 +1556,7 @@ shown below.
Return a cons cell, the `car' of which contains the TABLE less
colnames, and the `cdr' of which contains a list of the column
names."
- (if (equal 'hline (nth 1 table))
+ (if (eq 'hline (nth 1 table))
(cons (cddr table) (car table))
(cons (cdr table) (car table))))
@@ -1685,7 +1614,7 @@ of the vars, cnames and rnames."
(lambda (var)
(when (listp (cdr var))
(when (and (not (equal colnames "no"))
- (or colnames (and (equal (nth 1 (cdr var)) 'hline)
+ (or colnames (and (eq (nth 1 (cdr var)) 'hline)
(not (member 'hline (cddr (cdr var)))))))
(let ((both (org-babel-get-colnames (cdr var))))
(setq cnames (cons (cons (car var) (cdr both))
@@ -1748,33 +1677,30 @@ If the point is not on a source block then return nil."
(interactive
(let ((completion-ignore-case t)
(case-fold-search t)
- (under-point (thing-at-point 'line)))
- (list (org-icompleting-read
- "source-block name: " (org-babel-src-block-names) nil t
- (cond
- ;; noweb
- ((string-match (org-babel-noweb-wrap) under-point)
- (let ((block-name (match-string 1 under-point)))
- (string-match "[^(]*" block-name)
- (match-string 0 block-name)))
- ;; #+call:
- ((string-match org-babel-lob-one-liner-regexp under-point)
- (let ((source-info (car (org-babel-lob-get-info))))
- (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info)
- (let ((source-name (match-string 1 source-info)))
- source-name))))
- ;; #+results:
- ((string-match (concat "#\\+" org-babel-results-keyword
- "\\:\s+\\([^\\(]*\\)") under-point)
- (match-string 1 under-point))
- ;; symbol-at-point
- ((and (thing-at-point 'symbol))
- (org-babel-find-named-block (thing-at-point 'symbol))
- (thing-at-point 'symbol))
- (""))))))
+ (all-block-names (org-babel-src-block-names)))
+ (list (completing-read
+ "source-block name: " all-block-names nil t
+ (let* ((context (org-element-context))
+ (type (org-element-type context))
+ (noweb-ref
+ (and (memq type '(inline-src-block src-block))
+ (org-in-regexp (org-babel-noweb-wrap)))))
+ (cond
+ (noweb-ref
+ (buffer-substring
+ (+ (car noweb-ref) (length org-babel-noweb-wrap-start))
+ (- (cdr noweb-ref) (length org-babel-noweb-wrap-end))))
+ ((memq type '(babel-call inline-babel-call)) ;#+CALL:
+ (org-element-property :call context))
+ ((car (org-element-property :results context))) ;#+RESULTS:
+ ((let ((symbol (thing-at-point 'symbol))) ;Symbol.
+ (and symbol
+ (member-ignore-case symbol all-block-names)
+ symbol)))
+ (t "")))))))
(let ((point (org-babel-find-named-block name)))
(if point
- ;; taken from `org-open-at-point'
+ ;; Taken from `org-open-at-point'.
(progn (org-mark-ring-push) (goto-char point) (org-show-context))
(message "source-code block `%s' not found in this buffer" name))))
@@ -1796,7 +1722,7 @@ to `org-babel-named-src-block-regexp'."
(let ((re (org-babel-named-src-block-regexp-for-name))
names)
(while (ignore-errors (org-next-block 1 nil re))
- (push (org-match-string-no-properties 9) names))
+ (push (match-string-no-properties 9) names))
names)))
;;;###autoload
@@ -1804,33 +1730,31 @@ to `org-babel-named-src-block-regexp'."
"Go to a named result."
(interactive
(let ((completion-ignore-case t))
- (list (org-icompleting-read "source-block name: "
- (org-babel-result-names) nil t))))
+ (list (completing-read "Source-block name: "
+ (org-babel-result-names) nil t))))
(let ((point (org-babel-find-named-result name)))
(if point
;; taken from `org-open-at-point'
(progn (goto-char point) (org-show-context))
(message "result `%s' not found in this buffer" name))))
-(defun org-babel-find-named-result (name &optional point)
+(defun org-babel-find-named-result (name)
"Find a named result.
Return the location of the result named NAME in the current
buffer or nil if no such result exists."
(save-excursion
- (let ((case-fold-search t))
- (goto-char (or point (point-min)))
- (catch 'is-a-code-block
- (when (re-search-forward
- (concat org-babel-result-regexp
- "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]")
- nil t)
- (when (and (string= "name" (downcase (match-string 1)))
- (or (beginning-of-line 1)
- (looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp)
- (looking-at org-babel-lob-one-liner-regexp)))
- (throw 'is-a-code-block (org-babel-find-named-result name (point))))
- (beginning-of-line 0) (point))))))
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (re (format "^[ \t]*#\\+%s.*?:[ \t]*%s[ \t]*$"
+ org-babel-results-keyword
+ (regexp-quote name))))
+ (catch :found
+ (while (re-search-forward re nil t)
+ (let ((element (org-element-at-point)))
+ (when (or (eq (org-element-type element) 'keyword)
+ (< (point)
+ (org-element-property :post-affiliated element)))
+ (throw :found (line-beginning-position)))))))))
(defun org-babel-result-names (&optional file)
"Returns the names of results in FILE or the current buffer."
@@ -1838,7 +1762,7 @@ buffer or nil if no such result exists."
(when file (find-file file)) (goto-char (point-min))
(let ((case-fold-search t) names)
(while (re-search-forward org-babel-result-w-name-regexp nil t)
- (setq names (cons (match-string 4) names)))
+ (setq names (cons (match-string-no-properties 9) names)))
names)))
;;;###autoload
@@ -1883,14 +1807,14 @@ region is not active then the point is demarcated."
(stars (concat (make-string (or (org-current-level) 1) ?*) " "))
(lower-case-p (and block
(let (case-fold-search)
- (org-string-match-p "#\\+begin_src" block)))))
+ (string-match-p "#\\+begin_src" block)))))
(if info
(mapc
(lambda (place)
(save-excursion
(goto-char place)
(let ((lang (nth 0 info))
- (indent (make-string (nth 5 info) ? )))
+ (indent (make-string (org-get-indentation) ?\s)))
(when (string-match "^[[:space:]]*$"
(buffer-substring (point-at-bol)
(point-at-eol)))
@@ -1909,7 +1833,7 @@ region is not active then the point is demarcated."
(move-end-of-line 2))
(sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
(let ((start (point))
- (lang (org-icompleting-read
+ (lang (completing-read
"Lang: "
(mapcar #'symbol-name
(delete-dups
@@ -1924,135 +1848,218 @@ region is not active then the point is demarcated."
lang "\n"
body
(if (or (= (length body) 0)
- (string-match "[\r\n]$" body)) "" "\n")
+ (string-suffix-p "\r" body)
+ (string-suffix-p "\n" body)) "" "\n")
(funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n")))
(goto-char start) (move-end-of-line 1)))))
-(defvar org-babel-lob-one-liner-regexp)
-(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
+(defun org-babel--insert-results-keyword (name hash)
+ "Insert RESULTS keyword with NAME value at point.
+If NAME is nil, results are anonymous. HASH is a string used as
+the results hash, or nil. Leave point before the keyword."
+ (save-excursion (insert "\n")) ;open line to indent.
+ (org-indent-line)
+ (delete-char 1)
+ (insert (concat "#+" org-babel-results-keyword
+ (cond ((not hash) nil)
+ (org-babel-hash-show-time
+ (format "[%s %s]"
+ (format-time-string "<%F %T>")
+ hash))
+ (t (format "[%s]" hash)))
+ ":"
+ (when name (concat " " name))
+ "\n"))
+ ;; Make sure results are going to be followed by at least one blank
+ ;; line so they do not get merged with the next element, e.g.,
+ ;;
+ ;; #+results:
+ ;; : 1
+ ;;
+ ;; : fixed-width area, unrelated to the above.
+ (unless (looking-at "^[ \t]*$") (save-excursion (insert "\n")))
+ (beginning-of-line 0)
+ (when hash (org-babel-hide-hash)))
+
+(defun org-babel--clear-results-maybe (hash)
+ "Clear results when hash doesn't match HASH.
+
+When results hash does not match HASH, remove RESULTS keyword at
+point, along with related contents. Do nothing if HASH is nil.
+
+Return a non-nil value if results were cleared. In this case,
+leave point where new results should be inserted."
+ (when hash
+ (looking-at org-babel-result-regexp)
+ (unless (string= (match-string 1) hash)
+ (let* ((e (org-element-at-point))
+ (post (copy-marker (org-element-property :post-affiliated e))))
+ ;; Delete contents.
+ (delete-region post
+ (save-excursion
+ (goto-char (org-element-property :end e))
+ (skip-chars-backward " \t\n")
+ (line-beginning-position 2)))
+ ;; Delete RESULT keyword. However, if RESULTS keyword is
+ ;; orphaned, ignore this part. The deletion above already
+ ;; took care of it.
+ (unless (= (point) post)
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2)))
+ (goto-char post)
+ (set-marker post nil)
+ t))))
+
+(defun org-babel-where-is-src-block-result (&optional insert _info hash)
"Find where the current source block results begin.
+
Return the point at the beginning of the result of the current
-source block. Specifically at the beginning of the results line.
-If no result exists for this block then create a results line
-following the source block."
- (save-excursion
- (let* ((case-fold-search t)
- (on-lob-line (save-excursion
- (beginning-of-line 1)
- (looking-at org-babel-lob-one-liner-regexp)))
- (inlinep (when (org-babel-get-inline-src-block-matches)
- (match-end 0)))
- (name (nth 4 (or info (org-babel-get-src-block-info 'light))))
- (head (unless on-lob-line (org-babel-where-is-src-block-head)))
- found beg end)
- (when head (goto-char head))
+source block, specifically at the beginning of the results line.
+
+If no result exists for this block return nil, unless optional
+argument INSERT is non-nil. In this case, create a results line
+following the source block and return the position at its
+beginning. In the case of inline code, remove the results part
+instead.
+
+If optional argument HASH is a string, remove contents related to
+RESULTS keyword if its hash is different. Then update the latter
+to HASH."
+ (let ((context (org-element-context)))
+ (catch :found
(org-with-wide-buffer
- (setq
- found ;; was there a result (before we potentially insert one)
- (or
- inlinep
- (and
- ;; named results:
- ;; - return t if it is found, else return nil
- ;; - if it does not need to be rebuilt, then don't set end
- ;; - if it does need to be rebuilt then do set end
- name (setq beg (org-babel-find-named-result name))
- (prog1 beg
- (when (and hash (not (string= hash (match-string 5))))
- (goto-char beg) (setq end beg) ;; beginning of result
- (forward-line 1)
- (delete-region end (org-babel-result-end)) nil)))
- (and
- ;; unnamed results:
- ;; - return t if it is found, else return nil
- ;; - if it is found, and the hash doesn't match, delete and set end
- (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
- (progn (end-of-line 1)
- (if (eobp) (insert "\n") (forward-char 1))
- (setq end (point))
- (and
- (not name)
- (progn ;; unnamed results line already exists
- (catch 'non-comment
- (while (re-search-forward "[^ \f\t\n\r\v]" nil t)
- (beginning-of-line 1)
- (cond
- ((looking-at (concat org-babel-result-regexp "\n"))
- (throw 'non-comment t))
- ((and (looking-at "^[ \t]*#")
- (not (looking-at
- org-babel-lob-one-liner-regexp)))
- (end-of-line 1))
- (t (throw 'non-comment nil))))))
- (let ((this-hash (match-string 5)))
- (prog1 (point)
- ;; must remove and rebuild if hash!=old-hash
- (if (and hash (not (string= hash this-hash)))
- (progn
- (setq end (point-at-bol))
- (forward-line 1)
- (delete-region end (org-babel-result-end))
- (setq beg end))
- (setq end nil))))))))))
- (if (not (and insert end)) found
- (goto-char end)
- (unless beg
- (if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
- (when (wholenump indent) (indent-to indent))
- (insert (concat
- "#+" org-babel-results-keyword
- (when hash
- (if org-babel-hash-show-time
- (concat
- "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]")
- (concat "["hash"]")))
- ":"
- (when name (concat " " name)) "\n"))
- (unless beg (insert "\n") (backward-char))
- (beginning-of-line 0)
- (when hash (org-babel-hide-hash))
- (point)))))
-
-(defvar org-block-regexp)
+ (pcase (org-element-type context)
+ ((or `inline-babel-call `inline-src-block)
+ ;; Results for inline objects are located right after them.
+ ;; There is no RESULTS line to insert either.
+ (let ((limit (org-element-property
+ :contents-end (org-element-property :parent context))))
+ (goto-char (org-element-property :end context))
+ (skip-chars-forward " \t\n" limit)
+ (throw :found
+ (and
+ (< (point) limit)
+ (let ((result (org-element-context)))
+ (and (eq (org-element-type result) 'macro)
+ (string= (org-element-property :key result)
+ "results")
+ (if (not insert) (point)
+ (delete-region
+ (point)
+ (progn
+ (goto-char (org-element-property :end result))
+ (skip-chars-backward " \t")
+ (point)))
+ (point))))))))
+ ((or `babel-call `src-block)
+ (let* ((name (org-element-property :name context))
+ (named-results (and name (org-babel-find-named-result name))))
+ (goto-char (or named-results (org-element-property :end context)))
+ (cond
+ ;; Existing results named after the current source.
+ (named-results
+ (when (org-babel--clear-results-maybe hash)
+ (org-babel--insert-results-keyword name hash))
+ (throw :found (point)))
+ ;; Named results expect but none to be found.
+ (name)
+ ;; No possible anonymous results at the very end of
+ ;; buffer or outside CONTEXT parent.
+ ((eq (point)
+ (or (org-element-property
+ :contents-end (org-element-property :parent context))
+ (point-max))))
+ ;; Check if next element is an anonymous result below
+ ;; the current block.
+ ((let* ((next (org-element-at-point))
+ (end (save-excursion
+ (goto-char
+ (org-element-property :post-affiliated next))
+ (line-end-position)))
+ (empty-result-re (concat org-babel-result-regexp "$"))
+ (case-fold-search t))
+ (re-search-forward empty-result-re end t))
+ (beginning-of-line)
+ (when (org-babel--clear-results-maybe hash)
+ (org-babel--insert-results-keyword nil hash))
+ (throw :found (point))))))
+ ;; Ignore other elements.
+ (_ (throw :found nil))))
+ ;; No result found. Insert a RESULTS keyword below element, if
+ ;; appropriate. In this case, ensure there is an empty line
+ ;; after the previous element.
+ (when insert
+ (save-excursion
+ (goto-char (min (org-element-property :end context) (point-max)))
+ (skip-chars-backward " \t\n")
+ (forward-line)
+ (unless (bolp) (insert "\n"))
+ (insert "\n")
+ (org-babel--insert-results-keyword
+ (org-element-property :name context) hash)
+ (point))))))
+
+(defun org-babel-read-element (element)
+ "Read ELEMENT into emacs-lisp.
+Return nil if ELEMENT cannot be read."
+ (org-with-wide-buffer
+ (goto-char (org-element-property :post-affiliated element))
+ (pcase (org-element-type element)
+ (`fixed-width
+ (let ((v (org-trim (org-element-property :value element))))
+ (or (org-babel--string-to-number v) v)))
+ (`table (org-babel-read-table))
+ (`plain-list (org-babel-read-list))
+ (`example-block
+ (let ((v (org-element-property :value element)))
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent element))
+ v
+ (org-remove-indentation v))))
+ (`export-block
+ (org-remove-indentation (org-element-property :value element)))
+ (`paragraph
+ ;; Treat paragraphs containing a single link specially.
+ (skip-chars-forward " \t")
+ (if (and (looking-at org-bracket-link-regexp)
+ (save-excursion
+ (goto-char (match-end 0))
+ (skip-chars-forward " \r\t\n")
+ (<= (org-element-property :end element)
+ (point))))
+ (org-babel-read-link)
+ (buffer-substring-no-properties
+ (org-element-property :contents-begin element)
+ (org-element-property :contents-end element))))
+ ((or `center-block `quote-block `verse-block `special-block)
+ (org-remove-indentation
+ (buffer-substring-no-properties
+ (org-element-property :contents-begin element)
+ (org-element-property :contents-end element))))
+ (_ nil))))
+
(defun org-babel-read-result ()
- "Read the result at `point' into emacs-lisp."
- (let ((case-fold-search t) result-string)
- (cond
- ((org-at-table-p) (org-babel-read-table))
- ((org-at-item-p) (org-babel-read-list))
- ((looking-at org-bracket-link-regexp) (org-babel-read-link))
- ((looking-at org-block-regexp) (org-remove-indentation (match-string 4)))
- ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$"))
- (setq result-string
- (org-babel-trim
- (mapconcat (lambda (line)
- (or (and (> (length line) 1)
- (string-match "^[ \t]*: ?\\(.+\\)" line)
- (match-string 1 line))
- ""))
- (split-string
- (buffer-substring
- (point) (org-babel-result-end)) "[\r\n]+")
- "\n")))
- (or (org-babel-number-p result-string) result-string))
- ((looking-at org-babel-result-regexp)
- (save-excursion (forward-line 1) (org-babel-read-result))))))
+ "Read the result at point into emacs-lisp."
+ (and (not (save-excursion
+ (beginning-of-line)
+ (looking-at-p "[ \t]*$")))
+ (org-babel-read-element (org-element-at-point))))
(defun org-babel-read-table ()
- "Read the table at `point' into emacs-lisp."
+ "Read the table at point into emacs-lisp."
(mapcar (lambda (row)
(if (and (symbolp row) (equal row 'hline)) row
(mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row)))
(org-table-to-lisp)))
(defun org-babel-read-list ()
- "Read the list at `point' into emacs-lisp."
+ "Read the list at point into emacs-lisp."
(mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval))
- (mapcar #'cadr (cdr (org-list-parse-list)))))
+ (cdr (org-list-to-lisp))))
(defvar org-link-types-re)
(defun org-babel-read-link ()
- "Read the link at `point' into emacs-lisp.
+ "Read the link at point into emacs-lisp.
If the path of the link is a file path it is expanded using
`expand-file-name'."
(let* ((case-fold-search t)
@@ -2077,8 +2084,7 @@ If the path of the link is a file path it is expanded using
;; scalar result
(funcall echo-res result))))
-(defun org-babel-insert-result
- (result &optional result-params info hash indent lang)
+(defun org-babel-insert-result (result &optional result-params info hash lang)
"Insert RESULT into the current buffer.
By default RESULT is inserted after the end of the current source
@@ -2094,21 +2100,21 @@ replace - (default option) insert results after the source block
or inline source block replacing any previously
inserted results.
-silent -- no results are inserted into the Org-mode buffer but
+silent -- no results are inserted into the Org buffer but
the results are echoed to the minibuffer and are
ingested by Emacs (a potentially time consuming
process).
file ---- the results are interpreted as a file path, and are
- inserted into the buffer using the Org-mode file syntax.
+ inserted into the buffer using the Org file syntax.
-list ---- the results are interpreted as an Org-mode list.
+list ---- the results are interpreted as an Org list.
-raw ----- results are added directly to the Org-mode file. This
- is a good option if you code block will output org-mode
+raw ----- results are added directly to the Org file. This is
+ a good option if you code block will output Org
formatted text.
-drawer -- results are added directly to the Org-mode file as with
+drawer -- results are added directly to the Org file as with
\"raw\", but are wrapped in a RESULTS drawer or results
macro, allowing them to later be replaced or removed
automatically.
@@ -2119,15 +2125,16 @@ org ----- results are added inside of a \"src_org{}\" or \"#+BEGIN_SRC
but Org syntax here will be discarded when exporting the
file.
-html ---- results are added inside of a #+BEGIN_HTML block or
- html export snippet depending on whether the current
+html ---- results are added inside of a #+BEGIN_EXPORT HTML block
+ or html export snippet depending on whether the current
source block is inline or not. This is a good option
if your code block will output html formatted text.
-latex --- results are added inside of a #+BEGIN_LATEX block or
- latex export snippet depending on whether the current
- source block is inline or not. This is a good option
- if your code block will output latex formatted text.
+latex --- results are added inside of a #+BEGIN_EXPORT LATEX
+ block or latex export snippet depending on whether the
+ current source block is inline or not. This is a good
+ option if your code block will output latex formatted
+ text.
code ---- the results are extracted in the syntax of the source
code of the language being evaluated and are added
@@ -2151,203 +2158,201 @@ INFO may provide the values of these header arguments (in the
:wrap --- the effect is similar to `latex' in RESULT-PARAMS but
using the argument supplied to specify the export block
or snippet type."
-
- (if (stringp result)
- (progn
- (setq result (org-no-properties result))
- (when (member "file" result-params)
- (setq result (org-babel-result-to-file
- result (when (assoc :file-desc (nth 2 info))
- (or (cdr (assoc :file-desc (nth 2 info)))
- result))))))
- (unless (listp result) (setq result (format "%S" result))))
+ (cond ((stringp result)
+ (setq result (org-no-properties result))
+ (when (member "file" result-params)
+ (setq result (org-babel-result-to-file
+ result (when (assq :file-desc (nth 2 info))
+ (or (cdr (assq :file-desc (nth 2 info)))
+ result))))))
+ ((listp result))
+ (t (setq result (format "%S" result))))
(if (and result-params (member "silent" result-params))
- (progn
- (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
- result)
- (save-excursion
- (let* ((inlinep
- (save-excursion
- (when (or (org-babel-get-inline-src-block-matches)
- (org-babel-get-lob-one-liner-matches))
- (goto-char (match-end 0))
- (org-babel-remove-inline-result)
- (insert " ")
- (point))))
- (existing-result
- (unless inlinep
- (org-babel-where-is-src-block-result t info hash indent)))
- (bad-inline-p
- (when inlinep
- (or
- (and (member "table" result-params) "`:results table'")
- (and (listp result) "list result")
- (and (org-string-match-p "\n." result) "multiline result")
- (and (member "list" result-params) "`:results list'"))))
- (results-switches
- (cdr (assoc :results_switches (nth 2 info))))
- (visible-beg (point-min-marker))
- (visible-end (point-max-marker))
- ;; When results exist outside of the current visible
- ;; region of the buffer, be sure to widen buffer to
- ;; update them.
- (outside-scope-p (and existing-result
+ (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
+ result)
+ (let ((inline (let ((context (org-element-context)))
+ (and (memq (org-element-type context)
+ '(inline-babel-call inline-src-block))
+ context))))
+ (when inline
+ (let ((warning
+ (or (and (member "table" result-params) "`:results table'")
+ (and (listp result) "list result")
+ (and (string-match-p "\n." result) "multiline result")
+ (and (member "list" result-params) "`:results list'"))))
+ (when warning
+ (user-error "Inline error: %s cannot be used" warning))))
+ (save-excursion
+ (let* ((visible-beg (point-min-marker))
+ (visible-end (copy-marker (point-max) t))
+ (inline (let ((context (org-element-context)))
+ (and (memq (org-element-type context)
+ '(inline-babel-call inline-src-block))
+ context)))
+ (existing-result (org-babel-where-is-src-block-result t nil hash))
+ (results-switches (cdr (assq :results_switches (nth 2 info))))
+ ;; When results exist outside of the current visible
+ ;; region of the buffer, be sure to widen buffer to
+ ;; update them.
+ (outside-scope (and existing-result
+ (buffer-narrowed-p)
(or (> visible-beg existing-result)
(<= visible-end existing-result))))
- beg end)
- (when (and (stringp result) ; ensure results end in a newline
- (not inlinep)
- (> (length result) 0)
- (not (or (string-equal (substring result -1) "\n")
- (string-equal (substring result -1) "\r"))))
- (setq result (concat result "\n")))
- (unwind-protect
- (progn
- (when outside-scope-p (widen))
- (if (not existing-result)
- (setq beg (or inlinep (point)))
- (goto-char existing-result)
- (save-excursion
- (re-search-forward "#" nil t)
- (setq indent (- (current-column) 1)))
- (forward-line 1)
+ beg end indent)
+ ;; Ensure non-inline results end in a newline.
+ (when (and (org-string-nw-p result)
+ (not inline)
+ (not (string-equal (substring result -1) "\n")))
+ (setq result (concat result "\n")))
+ (unwind-protect
+ (progn
+ (when outside-scope (widen))
+ (if existing-result (goto-char existing-result)
+ (goto-char (org-element-property :end inline))
+ (skip-chars-backward " \t"))
+ (unless inline
+ (setq indent (org-get-indentation))
+ (forward-line 1))
(setq beg (point))
(cond
+ (inline
+ ;; Make sure new results are separated from the
+ ;; source code by one space.
+ (unless existing-result
+ (insert " ")
+ (setq beg (point))))
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point-marker)))
- ((member "prepend" result-params)))) ; already there
- (setq results-switches
- (if results-switches (concat " " results-switches) ""))
- (let ((wrap (lambda (start finish &optional no-escape no-newlines
- inline-start inline-finish)
- (when inlinep
- (setq start inline-start)
- (setq finish inline-finish)
- (setq no-newlines t))
- (goto-char end)
- (insert (concat finish (unless no-newlines "\n")))
- (goto-char beg)
- (insert (concat start (unless no-newlines "\n")))
- (unless no-escape
- (org-escape-code-in-region (min (point) end) end))
- (goto-char end)
- (unless no-newlines (goto-char (point-at-eol)))
- (setq end (point-marker))))
- (tabulablep
- (lambda (r)
- ;; Non-nil when result R can be turned into
- ;; a table.
- (and (listp r)
- (null (cdr (last r)))
- (org-every
- (lambda (e) (or (atom e) (null (cdr (last e)))))
- result)))))
- ;; insert results based on type
- (cond
- ;; Do nothing for an empty result.
- ((null result))
- ;; Illegal inline result or params.
- (bad-inline-p
- (error "Inline error: %s cannot be used" bad-inline-p))
- ;; insert a list if preferred
- ((member "list" result-params)
- (insert
- (org-babel-trim
- (org-list-to-generic
- (cons 'unordered
- (mapcar
- (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
- (if (listp result) result (split-string result "\n" t))))
- '(:splicep nil :istart "- " :iend "\n")))
- "\n"))
- ;; Try hard to print RESULT as a table. Give up if
- ;; it contains an improper list.
- ((funcall tabulablep result)
- (goto-char beg)
- (insert (concat (orgtbl-to-orgtbl
- (if (org-every
- (lambda (e)
- (or (eq e 'hline) (listp e)))
- result)
- result
- (list result))
- nil)
- "\n"))
- (goto-char beg)
- (when (org-at-table-p) (org-table-align))
- (goto-char (org-table-end)))
- ;; Print verbatim a list that cannot be turned into
- ;; a table.
- ((listp result) (insert (format "%s\n" result)))
- ((member "file" result-params)
- (when inlinep
- (goto-char inlinep)
- (setq result (org-macro-escape-arguments result)))
- (insert result))
- ((and inlinep
- (not (member "raw" result-params)))
- (goto-char inlinep)
- (insert (org-macro-escape-arguments
- (org-babel-chomp result "\n"))))
- (t (goto-char beg) (insert result)))
- (setq end (point-marker))
- ;; possibly wrap result
- (cond
- (bad-inline-p) ; Do nothing.
- ((assoc :wrap (nth 2 info))
- (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
- (funcall wrap (concat "#+BEGIN_" name)
- (concat "#+END_" (car (org-split-string name)))
- nil nil (concat "{{{results(@@" name ":") "@@)}}}")))
- ((member "html" result-params)
- (funcall wrap "#+BEGIN_HTML" "#+END_HTML" nil nil
- "{{{results(@@html:" "@@)}}}"))
- ((member "latex" result-params)
- (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX" nil nil
- "{{{results(@@latex:" "@@)}}}"))
- ((member "org" result-params)
- (goto-char beg) (if (org-at-table-p) (org-cycle))
- (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil
- "{{{results(src_org{" "})}}}"))
- ((member "code" result-params)
- (let ((lang (or lang "none")))
- (funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches)
- "#+END_SRC" nil nil
- (format "{{{results(src_%s[%s]{" lang results-switches)
- "})}}}")))
- ((member "raw" result-params)
- (goto-char beg) (if (org-at-table-p) (org-cycle)))
- ((or (member "drawer" result-params)
- ;; Stay backward compatible with <7.9.2
- (member "wrap" result-params))
- (goto-char beg) (if (org-at-table-p) (org-cycle))
- (funcall wrap ":RESULTS:" ":END:" 'no-escape nil
- "{{{results(" ")}}}"))
- ((and inlinep (member "file" result-params))
- (funcall wrap nil nil nil nil "{{{results(" ")}}}"))
- ((and (not (funcall tabulablep result))
- (not (member "file" result-params)))
- (let ((org-babel-inline-result-wrap
- ;; Hard code {{{results(...)}}} on top of customization.
- (format "{{{results(%s)}}}" org-babel-inline-result-wrap)))
- (org-babel-examplify-region beg end results-switches)
- (setq end (point))))))
- ;; possibly indent the results to match the #+results line
- (when (and (not inlinep) (numberp indent) indent (> indent 0)
- ;; in this case `table-align' does the work for us
- (not (and (listp result)
- (member "append" result-params))))
- (indent-rigidly beg end indent))
- (if (null result)
- (if (member "value" result-params)
- (message "Code block returned no value.")
- (message "Code block produced no output."))
- (message "Code block evaluation complete.")))
- (when outside-scope-p (narrow-to-region visible-beg visible-end))
- (set-marker visible-beg nil)
- (set-marker visible-end nil))))))
+ ((member "prepend" result-params))) ; already there
+ (setq results-switches
+ (if results-switches (concat " " results-switches) ""))
+ (let ((wrap (lambda (start finish &optional no-escape no-newlines
+ inline-start inline-finish)
+ (when inline
+ (setq start inline-start)
+ (setq finish inline-finish)
+ (setq no-newlines t))
+ (goto-char end)
+ (insert (concat finish (unless no-newlines "\n")))
+ (goto-char beg)
+ (insert (concat start (unless no-newlines "\n")))
+ (unless no-escape
+ (org-escape-code-in-region (min (point) end) end))
+ (goto-char end)
+ (unless no-newlines (goto-char (point-at-eol)))
+ (setq end (point-marker))))
+ (tabulablep
+ (lambda (r)
+ ;; Non-nil when result R can be turned into
+ ;; a table.
+ (and (listp r)
+ (null (cdr (last r)))
+ (cl-every
+ (lambda (e) (or (atom e) (null (cdr (last e)))))
+ result)))))
+ ;; insert results based on type
+ (cond
+ ;; Do nothing for an empty result.
+ ((null result))
+ ;; Insert a list if preferred.
+ ((member "list" result-params)
+ (insert
+ (org-trim
+ (org-list-to-generic
+ (cons 'unordered
+ (mapcar
+ (lambda (e)
+ (list (if (stringp e) e (format "%S" e))))
+ (if (listp result) result
+ (split-string result "\n" t))))
+ '(:splicep nil :istart "- " :iend "\n")))
+ "\n"))
+ ;; Try hard to print RESULT as a table. Give up if
+ ;; it contains an improper list.
+ ((funcall tabulablep result)
+ (goto-char beg)
+ (insert (concat (orgtbl-to-orgtbl
+ (if (cl-every
+ (lambda (e)
+ (or (eq e 'hline) (listp e)))
+ result)
+ result
+ (list result))
+ nil)
+ "\n"))
+ (goto-char beg)
+ (when (org-at-table-p) (org-table-align))
+ (goto-char (org-table-end)))
+ ;; Print verbatim a list that cannot be turned into
+ ;; a table.
+ ((listp result) (insert (format "%s\n" result)))
+ ((member "file" result-params)
+ (when inline
+ (setq result (org-macro-escape-arguments result)))
+ (insert result))
+ ((and inline (not (member "raw" result-params)))
+ (insert (org-macro-escape-arguments
+ (org-babel-chomp result "\n"))))
+ (t (goto-char beg) (insert result)))
+ (setq end (point-marker))
+ ;; possibly wrap result
+ (cond
+ ((assq :wrap (nth 2 info))
+ (let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS")))
+ (funcall wrap (concat "#+BEGIN_" name)
+ (concat "#+END_" (car (org-split-string name)))
+ nil nil (concat "{{{results(@@" name ":") "@@)}}}")))
+ ((member "html" result-params)
+ (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil
+ "{{{results(@@html:" "@@)}}}"))
+ ((member "latex" result-params)
+ (funcall wrap "#+BEGIN_EXPORT latex" "#+END_EXPORT" nil nil
+ "{{{results(@@latex:" "@@)}}}"))
+ ((member "org" result-params)
+ (goto-char beg) (when (org-at-table-p) (org-cycle))
+ (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil
+ "{{{results(src_org{" "})}}}"))
+ ((member "code" result-params)
+ (let ((lang (or lang "none")))
+ (funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches)
+ "#+END_SRC" nil nil
+ (format "{{{results(src_%s[%s]{" lang results-switches)
+ "})}}}")))
+ ((member "raw" result-params)
+ (goto-char beg) (when (org-at-table-p) (org-cycle)))
+ ((or (member "drawer" result-params)
+ ;; Stay backward compatible with <7.9.2
+ (member "wrap" result-params))
+ (goto-char beg) (when (org-at-table-p) (org-cycle))
+ (funcall wrap ":RESULTS:" ":END:" 'no-escape nil
+ "{{{results(" ")}}}"))
+ ((and inline (member "file" result-params))
+ (funcall wrap nil nil nil nil "{{{results(" ")}}}"))
+ ((and (not (funcall tabulablep result))
+ (not (member "file" result-params)))
+ (let ((org-babel-inline-result-wrap
+ ;; Hard code {{{results(...)}}} on top of customization.
+ (format "{{{results(%s)}}}"
+ org-babel-inline-result-wrap)))
+ (org-babel-examplify-region beg end results-switches inline)
+ (setq end (point))))))
+ ;; Possibly indent results in par with #+results line.
+ (when (and (not inline) (numberp indent) (> indent 0)
+ ;; In this case `table-align' does the work
+ ;; for us.
+ (not (and (listp result)
+ (member "append" result-params))))
+ (indent-rigidly beg end indent))
+ (if (null result)
+ (if (member "value" result-params)
+ (message "Code block returned no value.")
+ (message "Code block produced no output."))
+ (message "Code block evaluation complete.")))
+ (when outside-scope (narrow-to-region visible-beg visible-end))
+ (set-marker visible-beg nil)
+ (set-marker visible-end nil)))))))
(defun org-babel-remove-result (&optional info keep-keyword)
"Remove the result of the current source block."
@@ -2361,23 +2366,29 @@ INFO may provide the values of these header arguments (in the
(if keep-keyword (1+ (match-end 0)) (1- (match-beginning 0)))
(progn (forward-line 1) (org-babel-result-end))))))))
-(defun org-babel-remove-inline-result ()
+(defun org-babel-remove-inline-result (&optional datum)
"Remove the result of the current inline-src-block or babel call.
The result must be wrapped in a `results' macro to be removed.
-Leading whitespace is trimmed."
+Leading white space is trimmed."
(interactive)
- (let* ((el (org-element-context))
- (post-blank (org-element-property :post-blank el)))
+ (let* ((el (or datum (org-element-context))))
(when (memq (org-element-type el) '(inline-src-block inline-babel-call))
(org-with-wide-buffer
- (goto-char (org-element-property :end el))
- (let ((el (org-element-context)))
- (when (and (eq (org-element-type el) 'macro)
- (string= (org-element-property :key el) "results"))
- (delete-region ; And leading whitespace.
- (- (org-element-property :begin el) post-blank)
- (- (org-element-property :end el)
- (org-element-property :post-blank el)))))))))
+ (goto-char (org-element-property :end el))
+ (skip-chars-backward " \t")
+ (let ((result (save-excursion
+ (skip-chars-forward
+ " \t\n"
+ (org-element-property
+ :contents-end (org-element-property :parent el)))
+ (org-element-context))))
+ (when (and (eq (org-element-type result) 'macro)
+ (string= (org-element-property :key result) "results"))
+ (delete-region ; And leading whitespace.
+ (point)
+ (progn (goto-char (org-element-property :end result))
+ (skip-chars-backward " \t\n")
+ (point)))))))))
(defun org-babel-remove-result-one-or-many (x)
"Remove the result of the current source block.
@@ -2427,35 +2438,23 @@ file's directory then expand relative links."
(defvar org-babel-capitalize-example-region-markers nil
"Make true to capitalize begin/end example markers inserted by code blocks.")
-(define-obsolete-function-alias
- 'org-babel-examplize-region
- 'org-babel-examplify-region "25.1")
-
-(defun org-babel-examplify-region (beg end &optional results-switches)
+(defun org-babel-examplify-region (beg end &optional results-switches inline)
"Comment out region using the inline `==' or `: ' org example quote."
(interactive "*r")
- (let ((chars-between (lambda (b e)
- (not (string-match "^[\\s]*$"
- (buffer-substring b e)))))
- (maybe-cap (lambda (str) (if org-babel-capitalize-example-region-markers
- (upcase str) str)))
- (beg-bol (save-excursion (goto-char beg) (point-at-bol)))
- (end-bol (save-excursion (goto-char end) (point-at-bol)))
- (end-eol (save-excursion (goto-char end) (point-at-eol))))
- (if (and (not (= end end-bol))
- (or (funcall chars-between beg-bol beg)
- (funcall chars-between end end-eol)))
+ (let ((maybe-cap
+ (lambda (str)
+ (if org-babel-capitalize-example-region-markers (upcase str) str))))
+ (if inline
(save-excursion
(goto-char beg)
(insert (format org-babel-inline-result-wrap
- (prog1 (buffer-substring beg end)
- (delete-region beg end)))))
+ (delete-and-extract-region beg end))))
(let ((size (count-lines beg end)))
(save-excursion
(cond ((= size 0)) ; do nothing for an empty result
((< size org-babel-min-lines-for-block-output)
(goto-char beg)
- (dotimes (n size)
+ (dotimes (_ size)
(beginning-of-line 1) (insert ": ") (forward-line 1)))
(t
(goto-char beg)
@@ -2501,144 +2500,103 @@ This takes into account some special considerations for certain
parameters when merging lists."
(let* ((results-exclusive-groups
(mapcar (lambda (group) (mapcar #'symbol-name group))
- (cdr (assoc 'results org-babel-common-header-args-w-values))))
+ (cdr (assq 'results org-babel-common-header-args-w-values))))
(exports-exclusive-groups
(mapcar (lambda (group) (mapcar #'symbol-name group))
- (cdr (assoc 'exports org-babel-common-header-args-w-values))))
- (variable-index 0)
- (e-merge (lambda (exclusive-groups &rest result-params)
- ;; maintain exclusivity of mutually exclusive parameters
- (let (output)
- (mapc (lambda (new-params)
- (mapc (lambda (new-param)
- (mapc (lambda (exclusive-group)
- (when (member new-param exclusive-group)
- (mapcar (lambda (excluded-param)
- (setq output
- (delete
- excluded-param
- output)))
- exclusive-group)))
- exclusive-groups)
- (setq output (org-uniquify
- (cons new-param output))))
- new-params))
- result-params)
- output)))
- params results exports tangle noweb cache vars shebang comments padline
- clearnames)
-
- (mapc
- (lambda (plist)
- (mapc
- (lambda (pair)
- (case (car pair)
- (:var
- (let ((name (if (listp (cdr pair))
- (cadr pair)
- (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
- (cdr pair))
- (intern (match-string 1 (cdr pair)))))))
- (if name
- (setq vars
- (append
- (if (member name (mapcar #'car vars))
- (progn
- (push name clearnames)
- (delq nil
- (mapcar
- (lambda (p)
- (unless (equal (car p) name) p))
- vars)))
- vars)
- (list (cons name pair))))
- ;; if no name is given and we already have named variables
- ;; then assign to named variables in order
- (if (and vars (nth variable-index vars))
- (let ((name (car (nth variable-index vars))))
- (push name clearnames) ; clear out colnames
- ; and rownames
- ; for replace vars
- (prog1 (setf (cddr (nth variable-index vars))
- (concat (symbol-name name) "=" (cdr pair)))
- (incf variable-index)))
- (error "Variable \"%s\" must be assigned a default value"
- (cdr pair))))))
- (:results
- (setq results (funcall e-merge results-exclusive-groups
- results
- (split-string
- (let ((r (cdr pair)))
- (if (stringp r) r (eval r)))))))
- (:file
- (when (cdr pair)
- (setq results (funcall e-merge results-exclusive-groups
- results '("file")))
- (unless (or (member "both" exports)
- (member "none" exports)
- (member "code" exports))
- (setq exports (funcall e-merge exports-exclusive-groups
- exports '("results"))))
- (setq params (cons pair (assq-delete-all (car pair) params)))))
- (:file-ext
- (when (cdr pair)
- (setq results (funcall e-merge results-exclusive-groups
- results '("file")))
- (unless (or (member "both" exports)
- (member "none" exports)
- (member "code" exports))
- (setq exports (funcall e-merge exports-exclusive-groups
- exports '("results"))))
- (setq params (cons pair (assq-delete-all (car pair) params)))))
- (:exports
- (setq exports (funcall e-merge exports-exclusive-groups
- exports
- (split-string (or (cdr pair) "")))))
- (:tangle ;; take the latest -- always overwrite
- (setq tangle (or (list (cdr pair)) tangle)))
- (:noweb
- (setq noweb (funcall e-merge
- '(("yes" "no" "tangle" "no-export"
- "strip-export" "eval"))
- noweb
- (split-string (or (cdr pair) "")))))
- (:cache
- (setq cache (funcall e-merge '(("yes" "no")) cache
- (split-string (or (cdr pair) "")))))
- (:padline
- (setq padline (funcall e-merge '(("yes" "no")) padline
- (split-string (or (cdr pair) "")))))
- (:shebang ;; take the latest -- always overwrite
- (setq shebang (or (list (cdr pair)) shebang)))
- (:comments
- (setq comments (funcall e-merge '(("yes" "no")) comments
- (split-string (or (cdr pair) "")))))
- (t ;; replace: this covers e.g. :session
- (setq params (cons pair (assq-delete-all (car pair) params))))))
- plist))
- plists)
- (setq vars (reverse vars))
- (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
- ;; clear out col-names and row-names for replaced variables
- (mapc
- (lambda (name)
- (mapc
- (lambda (param)
- (when (assoc param params)
- (setf (cdr (assoc param params))
- (org-remove-if (lambda (pair) (equal (car pair) name))
- (cdr (assoc param params))))
- (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param)
- (null (cdr pair))))
- params))))
- (list :colname-names :rowname-names)))
- clearnames)
- (mapc
- (lambda (hd)
- (let ((key (intern (concat ":" (symbol-name hd))))
- (val (eval hd)))
- (setf params (cons (cons key (mapconcat 'identity val " ")) params))))
- '(results exports tangle noweb padline cache shebang comments))
+ (cdr (assq 'exports org-babel-common-header-args-w-values))))
+ (merge
+ (lambda (exclusive-groups &rest result-params)
+ ;; Maintain exclusivity of mutually exclusive parameters,
+ ;; as defined in EXCLUSIVE-GROUPS while merging lists in
+ ;; RESULT-PARAMS.
+ (let (output)
+ (dolist (new-params result-params (delete-dups output))
+ (dolist (new-param new-params)
+ (dolist (exclusive-group exclusive-groups)
+ (when (member new-param exclusive-group)
+ (setq output (cl-remove-if
+ (lambda (o) (member o exclusive-group))
+ output))))
+ (push new-param output))))))
+ (variable-index 0) ;Handle positional arguments.
+ clearnames
+ params ;Final parameters list.
+ ;; Some keywords accept multiple values. We need to treat
+ ;; them specially.
+ vars results exports)
+ (dolist (plist plists)
+ (dolist (pair plist)
+ (pcase pair
+ (`(:var . ,value)
+ (let ((name (cond
+ ((listp value) (car value))
+ ((string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" value)
+ (intern (match-string 1 value)))
+ (t nil))))
+ (cond
+ (name
+ (setq vars
+ (append (if (not (assoc name vars)) vars
+ (push name clearnames)
+ (cl-remove-if (lambda (p) (equal name (car p)))
+ vars))
+ (list (cons name pair)))))
+ ((and vars (nth variable-index vars))
+ ;; If no name is given and we already have named
+ ;; variables then assign to named variables in order.
+ (let ((name (car (nth variable-index vars))))
+ ;; Clear out colnames and rownames for replace vars.
+ (push name clearnames)
+ (setf (cddr (nth variable-index vars))
+ (concat (symbol-name name) "=" value))
+ (cl-incf variable-index)))
+ (t (error "Variable \"%s\" must be assigned a default value"
+ (cdr pair))))))
+ (`(:results . ,value)
+ (setq results (funcall merge
+ results-exclusive-groups
+ results
+ (split-string
+ (if (stringp value) value (eval value t))))))
+ (`(,(or :file :file-ext) . ,value)
+ ;; `:file' and `:file-ext' are regular keywords but they
+ ;; imply a "file" `:results' and a "results" `:exports'.
+ (when value
+ (setq results
+ (funcall merge results-exclusive-groups results '("file")))
+ (unless (or (member "both" exports)
+ (member "none" exports)
+ (member "code" exports))
+ (setq exports
+ (funcall merge
+ exports-exclusive-groups exports '("results"))))
+ (push pair params)))
+ (`(:exports . ,value)
+ (setq exports (funcall merge
+ exports-exclusive-groups
+ exports
+ (split-string (or value "")))))
+ ;; Regular keywords: any value overwrites the previous one.
+ (_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
+ ;; Handle `:var' and clear out colnames and rownames for replaced
+ ;; variables.
+ (setq params (nconc (mapcar (lambda (v) (cons :var (cddr v))) vars)
+ params))
+ (dolist (name clearnames)
+ (dolist (param '(:colname-names :rowname-names))
+ (when (assq param params)
+ (setf (cdr (assq param params))
+ (cl-remove-if (lambda (pair) (equal name (car pair)))
+ (cdr (assq param params))))
+ (setq params
+ (cl-remove-if (lambda (pair) (and (equal (car pair) param)
+ (null (cdr pair))))
+ params)))))
+ ;; Handle other special keywords, which accept multiple values.
+ (setq params (nconc (list (cons :results (mapconcat #'identity results " "))
+ (cons :exports (mapconcat #'identity exports " ")))
+ params))
+ ;; Return merged params.
params))
(defvar org-babel-use-quick-and-dirty-noweb-expansion nil
@@ -2650,17 +2608,12 @@ header argument from buffer or subtree wide properties.")
(defun org-babel-noweb-p (params context)
"Check if PARAMS require expansion in CONTEXT.
CONTEXT may be one of :tangle, :export or :eval."
- (let* (intersect
- (intersect (lambda (as bs)
- (when as
- (if (member (car as) bs)
- (car as)
- (funcall intersect (cdr as) bs))))))
- (funcall intersect (case context
- (:tangle '("yes" "tangle" "no-export" "strip-export"))
- (:eval '("yes" "no-export" "strip-export" "eval"))
- (:export '("yes")))
- (split-string (or (cdr (assoc :noweb params)) "")))))
+ (let ((allowed-values (cl-case context
+ (:tangle '("yes" "tangle" "no-export" "strip-export"))
+ (:eval '("yes" "no-export" "strip-export" "eval"))
+ (:export '("yes")))))
+ (cl-some (lambda (v) (member v allowed-values))
+ (split-string (or (cdr (assq :noweb params)) "")))))
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
"Expand Noweb references in the body of the current source code block.
@@ -2698,7 +2651,7 @@ block but are passed literally to the \"example-block\"."
(body (nth 1 info))
(ob-nww-start org-babel-noweb-wrap-start)
(ob-nww-end org-babel-noweb-wrap-end)
- (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
+ (comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
(rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
":noweb-ref[ \t]+" "\\)"))
(new-body "")
@@ -2707,11 +2660,11 @@ block but are passed literally to the \"example-block\"."
(with-temp-buffer
(funcall (intern (concat lang "-mode")))
(comment-region (point) (progn (insert text) (point)))
- (org-babel-trim (buffer-string)))))
+ (org-trim (buffer-string)))))
index source-name evaluate prefix)
(with-temp-buffer
- (org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
- (org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
+ (setq-local org-babel-noweb-wrap-start ob-nww-start)
+ (setq-local org-babel-noweb-wrap-end ob-nww-end)
(insert body) (goto-char (point-min))
(setq index (point))
(while (and (re-search-forward (org-babel-noweb-wrap) nil t))
@@ -2755,7 +2708,7 @@ block but are passed literally to the \"example-block\"."
(while (re-search-forward rx nil t)
(let* ((i (org-babel-get-src-block-info 'light))
(body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ (sep (or (cdr (assq :noweb-sep (nth 2 i)))
"\n"))
(full (if comment
(let ((cs (org-babel-tangle-comment-links i)))
@@ -2766,11 +2719,11 @@ block but are passed literally to the \"example-block\"."
(setq expansion (cons sep (cons full expansion)))))
(org-babel-map-src-blocks nil
(let ((i (org-babel-get-src-block-info 'light)))
- (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
+ (when (equal (or (cdr (assq :noweb-ref (nth 2 i)))
(nth 4 i))
source-name)
(let* ((body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ (sep (or (cdr (assq :noweb-sep (nth 2 i)))
"\n"))
(full (if comment
(let ((cs (org-babel-tangle-comment-links i)))
@@ -2827,7 +2780,7 @@ block but are passed literally to the \"example-block\"."
;; the character was (because one layer of quoting will
;; be stripped by `org-babel-read').
(t (append (list ch ?\\ ?\\) out))))
- (case ch
+ (cl-case ch
(?\[ (if (or in-double in-single)
(cons ?\[ out)
(cons ?\( out)))
@@ -2895,24 +2848,23 @@ lisp, otherwise return it unmodified as a string. Optional
argument INHIBIT-LISP-EVAL inhibits lisp evaluation for
situations in which is it not appropriate."
(if (and (stringp cell) (not (equal cell "")))
- (or (org-babel-number-p cell)
+ (or (org-babel--string-to-number cell)
(if (and (not inhibit-lisp-eval)
(or (member (substring cell 0 1) '("(" "'" "`" "["))
(string= cell "*this*")))
- (eval (read cell))
+ (eval (read cell) t)
(if (string= (substring cell 0 1) "\"")
(read cell)
(progn (set-text-properties 0 (length cell) nil cell) cell))))
cell))
-(defun org-babel-number-p (string)
- "If STRING represents a number return its value."
- (if (and (string-match "[0-9]+" string)
- (string-match "^-?[0-9]*\\.?[0-9]*$" string)
- (= (length (substring string (match-beginning 0)
- (match-end 0)))
- (length string)))
- (string-to-number string)))
+(defun org-babel--string-to-number (string)
+ "If STRING represents a number return its value.
+
+Otherwise return nil."
+ (when (string-match "\\`-?[0-9]*\\.?[0-9]*\\'" string)
+ (string-to-number string)))
+(define-obsolete-function-alias 'org-babel-number-p 'org-babel--string-to-number "Org 9.0")
(defun org-babel-import-elisp-from-file (file-name &optional separator)
"Read the results located at FILE-NAME into an elisp table.
@@ -2953,33 +2905,6 @@ can be specified as the REGEXP argument."
(setq string (substring string 0 -1)))
string))
-(defun org-babel-trim (string &optional regexp)
- "Strip a leading and trailing space or carriage return from STRING.
-Like `org-babel-chomp', but run on both the first and last
-character of the string."
- (org-babel-chomp
- (org-reverse-string
- (org-babel-chomp (org-reverse-string string) regexp)) regexp))
-
-(defun org-babel-tramp-handle-call-process-region
- (start end program &optional delete buffer display &rest args)
- "Use Tramp to handle `call-process-region'.
-Fixes a bug in `tramp-handle-call-process-region'."
- (if (and (featurep 'tramp) (file-remote-p default-directory))
- (let ((tmpfile (tramp-compat-make-temp-file "")))
- (write-region start end tmpfile)
- (when delete (delete-region start end))
- (unwind-protect
- ;; (apply 'call-process program tmpfile buffer display args)
- ;; bug in tramp
- (apply 'process-file program tmpfile buffer display args)
- (delete-file tmpfile)))
- ;; org-babel-call-process-region-original is the original emacs
- ;; definition. It is in scope from the let binding in
- ;; org-babel-execute-src-block
- (apply org-babel-call-process-region-original
- start end program delete buffer display args)))
-
(defun org-babel-local-file-name (file)
"Return the local name component of FILE."
(or (file-remote-p file 'localname) file))
@@ -3129,15 +3054,42 @@ plus the parameter value."
(setq params (cons (cons :file fname) params))))
params))
-;;; Used by backends: R, Maxima, Octave.
(defun org-babel-graphical-output-file (params)
- "File where a babel block should send graphical output, per PARAMS."
- (unless (assq :file params)
- (if (assq :file-ext params)
- (user-error ":file-ext given but no :file generated; did you forget to give a block a #+NAME?")
- (user-error "No :file header argument given; cannot create graphical result.")))
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
+ "File where a babel block should send graphical output, per PARAMS.
+Return nil if no graphical output is expected. Raise an error if
+the output file is ill-defined."
+ (let ((file (cdr (assq :file params))))
+ (cond (file (and (member "graphics" (cdr (assq :result-params params)))
+ file))
+ ((assq :file-ext params)
+ (user-error ":file-ext given but no :file generated; did you forget \
+to name a block?"))
+ (t (user-error "No :file header argument given; cannot create \
+graphical result")))))
+
+(defun org-babel-make-language-alias (new old)
+ "Make source blocks of type NEW aliases for those of type OLD.
+
+NEW and OLD should be strings. This function should be called
+after the babel API for OLD-type source blocks is fully defined.
+
+Callers of this function will probably want to add an entry to
+`org-src-lang-modes' as well."
+ (dolist (fn '("execute" "expand-body" "prep-session"
+ "variable-assignments" "load-session"))
+ (let ((sym (intern-soft (concat "org-babel-" fn ":" old))))
+ (when (and sym (fboundp sym))
+ (defalias (intern (concat "org-babel-" fn ":" new)) sym))))
+ ;; Technically we don't need a `dolist' for just one variable, but
+ ;; we keep it for symmetry/ease of future expansion.
+ (dolist (var '("default-header-args"))
+ (let ((sym (intern-soft (concat "org-babel-" var ":" old))))
+ (when (and sym (boundp sym))
+ (defvaralias (intern (concat "org-babel-" var ":" new)) sym)))))
+
+(defun org-babel-strip-quotes (string)
+ "Strip \\\"s from around a string, if applicable."
+ (org-unbracket-string "\"" "\"" string))
(provide 'ob-core)
diff --git a/lisp/ob-css.el b/lisp/ob-css.el
index 7f3d81a..5734373 100644
--- a/lisp/ob-css.el
+++ b/lisp/ob-css.el
@@ -1,4 +1,4 @@
-;;; ob-css.el --- org-babel functions for css evaluation
+;;; ob-css.el --- Babel Functions for CSS -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -24,19 +24,19 @@
;;; Commentary:
;; Since CSS can't be executed, this file exists solely for tangling
-;; CSS from org-mode files.
+;; CSS from Org files.
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:css '())
-(defun org-babel-execute:css (body params)
+(defun org-babel-execute:css (body _params)
"Execute a block of CSS code.
This function is called by `org-babel-execute-src-block'."
body)
-(defun org-babel-prep-session:css (session params)
+(defun org-babel-prep-session:css (_session _params)
"Return an error if the :session header argument is set.
CSS does not support sessions."
(error "CSS sessions are nonsensical"))
diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el
index 54238f3..1fa96aa 100644
--- a/lisp/ob-ditaa.el
+++ b/lisp/ob-ditaa.el
@@ -1,4 +1,4 @@
-;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
+;;; ob-ditaa.el --- Babel Functions for ditaa -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -81,19 +81,17 @@ Do not leave leading or trailing spaces in this string."
(defun org-babel-execute:ditaa (body params)
"Execute a block of Ditaa code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (out-file (let ((el (cdr (assoc :file params))))
- (or el
- (error
- "ditaa code block requires :file header argument"))))
- (cmdline (cdr (assoc :cmdline params)))
- (java (cdr (assoc :java params)))
+ (let* ((out-file (or (cdr (assq :file params))
+ (error
+ "ditaa code block requires :file header argument")))
+ (cmdline (cdr (assq :cmdline params)))
+ (java (cdr (assq :java params)))
(in-file (org-babel-temp-file "ditaa-"))
- (eps (cdr (assoc :eps params)))
+ (eps (cdr (assq :eps params)))
(eps-file (when eps
(org-babel-process-file-name (concat in-file ".eps"))))
(pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf")
- (cdr (assoc :pdf params))))
+ (cdr (assq :pdf params))))
(concat
"epstopdf"
" " eps-file
@@ -115,7 +113,7 @@ This function is called by `org-babel-execute-src-block'."
(when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd))
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:ditaa (session params)
+(defun org-babel-prep-session:ditaa (_session _params)
"Return an error because ditaa does not support sessions."
(error "Ditaa does not support sessions"))
diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el
index e2e8857..8cc1c74 100644
--- a/lisp/ob-dot.el
+++ b/lisp/ob-dot.el
@@ -1,4 +1,4 @@
-;;; ob-dot.el --- org-babel functions for dot evaluation
+;;; ob-dot.el --- Babel Functions for dot -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -46,7 +46,7 @@
(defun org-babel-expand-body:dot (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
@@ -64,12 +64,11 @@
(defun org-babel-execute:dot (body params)
"Execute a block of Dot code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (cdr (assoc :result-params params)))
- (out-file (cdr (or (assoc :file params)
+ (let* ((out-file (cdr (or (assq :file params)
(error "You need to specify a :file parameter"))))
- (cmdline (or (cdr (assoc :cmdline params))
+ (cmdline (or (cdr (assq :cmdline params))
(format "-T%s" (file-name-extension out-file))))
- (cmd (or (cdr (assoc :cmd params)) "dot"))
+ (cmd (or (cdr (assq :cmd params)) "dot"))
(in-file (org-babel-temp-file "dot-")))
(with-temp-file in-file
(insert (org-babel-expand-body:dot body params)))
@@ -80,7 +79,7 @@ This function is called by `org-babel-execute-src-block'."
" -o " (org-babel-process-file-name out-file)) "")
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:dot (session params)
+(defun org-babel-prep-session:dot (_session _params)
"Return an error because Dot does not support sessions."
(error "Dot does not support sessions"))
diff --git a/lisp/ob-ebnf.el b/lisp/ob-ebnf.el
index 9a78f6a..36f2c38 100644
--- a/lisp/ob-ebnf.el
+++ b/lisp/ob-ebnf.el
@@ -1,4 +1,4 @@
-;;; ob-ebnf.el --- org-babel functions for ebnf evaluation
+;;; ob-ebnf.el --- Babel Functions for EBNF -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
@@ -54,13 +54,11 @@
"Execute a block of Ebnf code with org-babel. This function is
called by `org-babel-execute-src-block'"
(save-excursion
- (let* ((dest-file (cdr (assoc :file params)))
+ (let* ((dest-file (cdr (assq :file params)))
(dest-dir (file-name-directory dest-file))
(dest-root (file-name-sans-extension
(file-name-nondirectory dest-file)))
- (dest-ext (file-name-extension dest-file))
- (style (cdr (assoc :style params)))
- (current-dir default-directory)
+ (style (cdr (assq :style params)))
(result nil))
(with-temp-buffer
(when style (ebnf-push-style style))
diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el
index eaa1124..c42034d 100644
--- a/lisp/ob-emacs-lisp.el
+++ b/lisp/ob-emacs-lisp.el
@@ -1,4 +1,4 @@
-;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
+;;; ob-emacs-lisp.el --- Babel Functions for Emacs-lisp Code -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -28,13 +28,21 @@
;;; Code:
(require 'ob)
-(defvar org-babel-default-header-args:emacs-lisp nil
- "Default arguments for evaluating an emacs-lisp source block.")
+(defconst org-babel-header-args:emacs-lisp '((lexical . :any))
+ "Emacs-lisp specific header arguments.")
+
+(defvar org-babel-default-header-args:emacs-lisp '((:lexical . "no"))
+ "Default arguments for evaluating an emacs-lisp source block.
+
+A value of \"yes\" or t causes src blocks to be eval'd using
+lexical scoping. It can also be an alist mapping symbols to
+their value. It is used as the optional LEXICAL argument to
+`eval', which see.")
(defun org-babel-expand-body:emacs-lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
+ (let* ((vars (org-babel--get-vars params))
+ (result-params (cdr (assq :result-params params)))
(print-level nil) (print-length nil)
(body (if (> (length vars) 0)
(concat "(let ("
@@ -51,26 +59,33 @@
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel."
(save-window-excursion
- (let ((result
- (eval (read (format (if (member "output"
- (cdr (assoc :result-params params)))
- "(with-output-to-string %s)"
- "(progn %s)")
- (org-babel-expand-body:emacs-lisp
- body params))))))
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (let* ((lexical (cdr (assq :lexical params)))
+ (result
+ (eval (read (format (if (member "output"
+ (cdr (assq :result-params params)))
+ "(with-output-to-string %s)"
+ "(progn %s)")
+ (org-babel-expand-body:emacs-lisp
+ body params)))
+
+ (if (listp lexical)
+ lexical
+ (member lexical '("yes" "t"))))))
+ (org-babel-result-cond (cdr (assq :result-params params))
(let ((print-level nil)
(print-length nil))
- (if (or (member "scalar" (cdr (assoc :result-params params)))
- (member "verbatim" (cdr (assoc :result-params params))))
+ (if (or (member "scalar" (cdr (assq :result-params params)))
+ (member "verbatim" (cdr (assq :result-params params))))
(format "%S" result)
(format "%s" result)))
(org-babel-reassemble-table
result
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params))))))))
+
+(org-babel-make-language-alias "elisp" "emacs-lisp")
(provide 'ob-emacs-lisp)
diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el
index e3ac383..4a368b7 100644
--- a/lisp/ob-eval.el
+++ b/lisp/ob-eval.el
@@ -1,4 +1,4 @@
-;;; ob-eval.el --- org-babel functions for external code evaluation
+;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -28,7 +28,6 @@
;;; Code:
(require 'org-macs)
-(eval-when-compile (require 'cl))
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
(declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
@@ -121,18 +120,18 @@ function in various versions of Emacs.
(delete-file input-file))
(when (and error-file (file-exists-p error-file))
- (if (< 0 (nth 7 (file-attributes error-file)))
- (with-current-buffer (get-buffer-create error-buffer)
- (let ((pos-from-end (- (point-max) (point))))
- (or (bobp)
- (insert "\f\n"))
- ;; Do no formatting while reading error file,
- ;; because that can run a shell command, and we
- ;; don't want that to cause an infinite recursion.
- (format-insert-file error-file nil)
- ;; Put point after the inserted errors.
- (goto-char (- (point-max) pos-from-end)))
- (current-buffer)))
+ (when (< 0 (nth 7 (file-attributes error-file)))
+ (with-current-buffer (get-buffer-create error-buffer)
+ (let ((pos-from-end (- (point-max) (point))))
+ (or (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
+ ;; Put point after the inserted errors.
+ (goto-char (- (point-max) pos-from-end)))
+ (current-buffer)))
(delete-file error-file))
exit-status))
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 983d53c..6aebcd5 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -1,4 +1,4 @@
-;;; ob-exp.el --- Exportation of org-babel source blocks
+;;; ob-exp.el --- Exportation of Babel Source Blocks -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -24,82 +24,49 @@
;;; Code:
(require 'ob-core)
-(require 'org-src)
-(eval-when-compile
- (require 'cl))
-
-(defvar org-babel-lob-one-liner-regexp)
-(defvar org-babel-ref-split-regexp)
-(defvar org-list-forbidden-blocks)
-
-(declare-function org-babel-lob-get-info "ob-lob" ())
-(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
-(declare-function org-between-regexps-p "org"
- (start-re end-re &optional lim-up lim-down))
-(declare-function org-get-indentation "org" (&optional line))
-(declare-function org-heading-components "org" ())
-(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
-(declare-function org-in-block-p "org" (names))
-(declare-function org-in-verbatim-emphasis "org" ())
-(declare-function org-link-search "org" (s &optional avoid-pos stealth))
-(declare-function org-fill-template "org" (template alist))
-(declare-function org-split-string "org" (string &optional separators))
+
+(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
(declare-function org-element-at-point "org-element" ())
-(declare-function org-element-context "org-element" ())
+(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
-(declare-function org-id-get "org-id" (&optional pom create prefix))
(declare-function org-escape-code-in-string "org-src" (s))
+(declare-function org-export-copy-buffer "ox" ())
+(declare-function org-fill-template "org" (template alist))
+(declare-function org-get-indentation "org" (&optional line))
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+
+(defvar org-src-preserve-indentation)
(defcustom org-export-babel-evaluate t
"Switch controlling code evaluation during export.
When set to nil no code will be evaluated as part of the export
-process. When set to `inline-only', only inline code blocks will
-be executed."
+process and no header argumentss will be obeyed. When set to
+`inline-only', only inline code blocks will be executed. Users
+who wish to avoid evaluating code on export should use the header
+argument `:eval never-export'."
:group 'org-babel
:version "24.1"
:type '(choice (const :tag "Never" nil)
(const :tag "Only inline code" inline-only)
(const :tag "Always" t)))
-(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
-
-(defvar org-link-search-inhibit-query)
-(defmacro org-babel-exp-in-export-file (lang &rest body)
- (declare (indent 1))
- `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
- (heading-query (or (org-id-get)
- ;; CUSTOM_IDs don't work, maybe they are
- ;; stripped, or maybe they resolve too
- ;; late in `org-link-search'.
- ;; (org-entry-get nil "CUSTOM_ID")
- (nth 4 (ignore-errors (org-heading-components)))))
- (export-buffer (current-buffer))
- results)
- (when org-babel-exp-reference-buffer
- ;; Resolve parameters in the original file so that headline and
- ;; file-wide parameters are included, attempt to go to the same
- ;; heading in the original file
- (set-buffer org-babel-exp-reference-buffer)
- (save-restriction
- (when heading-query
- (condition-case nil
- (let ((org-link-search-inhibit-query t))
- ;; TODO: When multiple headings have the same title,
- ;; this returns the first, which is not always
- ;; the right heading. Consider a better way to
- ;; find the proper heading.
- (org-link-search heading-query))
- (error (when heading-query
- (goto-char (point-min))
- (re-search-forward (regexp-quote heading-query) nil t)))))
- (setq results ,@body))
- (set-buffer export-buffer)
- results)))
-(def-edebug-spec org-babel-exp-in-export-file (form body))
-
-(defun org-babel-exp-src-block (&rest headers)
+(put 'org-export-babel-evaluate 'safe-local-variable #'null)
+
+(defmacro org-babel-exp--at-source (&rest body)
+ "Evaluate BODY at the source of the Babel block at point.
+Source is located in `org-babel-exp-reference-buffer'. The value
+returned is the value of the last form in BODY. Assume that
+point is at the beginning of the Babel block."
+ (declare (indent 1) (debug body))
+ `(let ((source (get-text-property (point) 'org-reference)))
+ (with-current-buffer org-babel-exp-reference-buffer
+ (org-with-wide-buffer
+ (goto-char source)
+ ,@body))))
+
+(defun org-babel-exp-src-block ()
"Process source block for export.
-Depending on the `export' headers argument, replace the source
+Depending on the \":export\" header argument, replace the source
code block like this:
both ---- display the code and the results
@@ -108,31 +75,36 @@ code ---- the default, display the code inside the block but do
not process
results - just like none only the block is run on export ensuring
- that its results are present in the org-mode buffer
+ that its results are present in the Org mode buffer
none ---- do not display either code or results upon export
-Assume point is at the beginning of block's starting line."
+Assume point is at block opening line."
(interactive)
(save-excursion
(let* ((info (org-babel-get-src-block-info 'light))
- (line (org-current-line))
(lang (nth 0 info))
- (raw-params (nth 2 info)) hash)
+ (raw-params (nth 2 info))
+ hash)
;; bail if we couldn't get any info from the block
(unless noninteractive
- (message "org-babel-exp process %s at line %d..." lang line))
+ (message "org-babel-exp process %s at position %d..."
+ lang
+ (line-beginning-position)))
(when info
;; if we're actually going to need the parameters
- (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results"))
- (org-babel-exp-in-export-file lang
- (setf (nth 2 info)
- (org-babel-process-params
- (apply #'org-babel-merge-params
- org-babel-default-header-args
- (if (boundp lang-headers) (eval lang-headers) nil)
- (append (org-babel-params-from-properties lang)
- (list raw-params))))))
+ (when (member (cdr (assq :exports (nth 2 info))) '("both" "results"))
+ (let ((lang-headers (intern (concat "org-babel-default-header-args:"
+ lang))))
+ (org-babel-exp--at-source
+ (setf (nth 2 info)
+ (org-babel-process-params
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (and (boundp lang-headers)
+ (symbol-value lang-headers))
+ (append (org-babel-params-from-properties lang)
+ (list raw-params)))))))
(setf hash (org-babel-sha1-hash info)))
(org-babel-exp-do-export info 'block hash)))))
@@ -153,182 +125,164 @@ this template."
:group 'org-babel
:type 'string)
-(defvar org-babel-default-lob-header-args)
-(defun org-babel-exp-process-buffer (reference-buffer)
- "Execute all Babel blocks in current buffer.
-REFERENCE-BUFFER is the buffer containing a pristine copy of the
-buffer being processed. It is used to properly resolve
-references in source blocks, as modifications in current buffer
-may make them unreachable."
+(defun org-babel-exp-process-buffer ()
+ "Execute all Babel blocks in current buffer."
(interactive)
- (save-window-excursion
- (save-excursion
+ (when org-export-babel-evaluate
+ (save-window-excursion
(let ((case-fold-search t)
- (org-babel-exp-reference-buffer reference-buffer)
- (regexp (concat org-babel-inline-src-block-regexp "\\|"
- org-babel-lob-one-liner-regexp "\\|"
- "^[ \t]*#\\+BEGIN_SRC")))
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (unless (save-match-data (org-in-commented-heading-p))
- (let* ((element (save-excursion
- ;; If match is inline, point is at its
- ;; end. Move backward so
- ;; `org-element-context' can get the
- ;; object, not the following one.
- (backward-char)
- (save-match-data (org-element-context))))
- (type (org-element-type element))
- (begin (copy-marker (org-element-property :begin element)))
- (end (copy-marker
- (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (point)))))
- (case type
- (inline-src-block
- (let* ((head (match-beginning 0))
- (info (append (org-babel-parse-inline-src-block-match)
- (list nil nil head)))
- (params (nth 2 info)))
- (setf (nth 1 info)
- (if (and (cdr (assoc :noweb params))
- (string= "yes" (cdr (assoc :noweb params))))
- (org-babel-expand-noweb-references
- info org-babel-exp-reference-buffer)
- (nth 1 info)))
- (goto-char begin)
- (let ((replacement (org-babel-exp-do-export info 'inline)))
- (if (equal replacement "")
- ;; Replacement code is empty: remove inline
- ;; source block, including extra white space
- ;; that might have been created when
- ;; inserting results.
- (delete-region begin
- (progn (goto-char end)
- (skip-chars-forward " \t")
- (point)))
- ;; Otherwise: remove inline src block but
- ;; preserve following white spaces. Then
- ;; insert value.
- (delete-region begin end)
- (insert replacement)))))
- ((babel-call inline-babel-call)
- (let* ((lob-info (org-babel-lob-get-info))
- (results
- (org-babel-exp-do-export
- (list "emacs-lisp" "results"
- (apply #'org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-lob-header-args
- (append
- (org-babel-params-from-properties)
- (list
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat
- ":var results="
- (mapconcat 'identity
- (butlast lob-info 2)
- " ")))))))
- "" (nth 3 lob-info) (nth 2 lob-info))
- 'lob))
- (rep (org-fill-template
- org-babel-exp-call-line-template
- `(("line" . ,(nth 0 lob-info))))))
- ;; If replacement is empty, completely remove the
- ;; object/element, including any extra white space
- ;; that might have been created when including
- ;; results.
- (if (equal rep "")
- (delete-region
- begin
- (progn (goto-char end)
- (if (not (eq type 'babel-call))
- (progn (skip-chars-forward " \t") (point))
- (skip-chars-forward " \r\t\n")
- (line-beginning-position))))
- ;; Otherwise, preserve following white
- ;; spaces/newlines and then, insert replacement
- ;; string.
- (goto-char begin)
- (delete-region begin end)
- (insert rep))))
- (src-block
- (let* ((match-start (copy-marker (match-beginning 0)))
- (ind (org-get-indentation))
- (lang (or (org-element-property :language element)
- (user-error
- "No language for src block: %s"
- (or (org-element-property :name element)
- "(unnamed)"))))
- (headers
- (cons lang
- (let ((params
- (org-element-property
- :parameters element)))
- (and params (org-split-string params))))))
- ;; Take care of matched block: compute replacement
- ;; string. In particular, a nil REPLACEMENT means
- ;; the block should be left as-is while an empty
- ;; string should remove the block.
- (let ((replacement
- (progn (goto-char match-start)
- (org-babel-exp-src-block headers))))
- (cond ((not replacement) (goto-char end))
- ((equal replacement "")
- (goto-char end)
- (skip-chars-forward " \r\t\n")
- (beginning-of-line)
- (delete-region begin (point)))
- (t
- (goto-char match-start)
- (delete-region (point)
- (save-excursion (goto-char end)
- (line-end-position)))
- (insert replacement)
- (if (or org-src-preserve-indentation
- (org-element-property :preserve-indent
- element))
- ;; Indent only the code block markers.
- (save-excursion (skip-chars-backward " \r\t\n")
- (indent-line-to ind)
- (goto-char match-start)
- (indent-line-to ind))
- ;; Indent everything.
- (indent-rigidly match-start (point) ind)))))
- (set-marker match-start nil))))
- (set-marker begin nil)
- (set-marker end nil))))))))
-
-(defun org-babel-in-example-or-verbatim ()
- "Return true if point is in example or verbatim code.
-Example and verbatim code include escaped portions of
-an org-mode buffer code that should be treated as normal
-org-mode text."
- (or (save-match-data
- (save-excursion
- (goto-char (point-at-bol))
- (looking-at "[ \t]*:[ \t]")))
- (org-in-verbatim-emphasis)
- (org-in-block-p org-list-forbidden-blocks)
- (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
+ (regexp (if (eq org-export-babel-evaluate 'inline-only)
+ "\\(call\\|src\\)_"
+ "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)"))
+ ;; Get a pristine copy of current buffer so Babel
+ ;; references are properly resolved and source block
+ ;; context is preserved.
+ (org-babel-exp-reference-buffer (org-export-copy-buffer)))
+ (unwind-protect
+ (save-excursion
+ ;; First attach to every source block their original
+ ;; position, so that they can be retrieved within
+ ;; `org-babel-exp-reference-buffer', even after heavy
+ ;; modifications on current buffer.
+ ;;
+ ;; False positives are harmless, so we don't check if
+ ;; we're really at some Babel object. Moreover,
+ ;; `line-end-position' ensures that we propertize
+ ;; a noticeable part of the object, without affecting
+ ;; multiple objects on the same line.
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (let ((s (match-beginning 0)))
+ (put-text-property s (line-end-position) 'org-reference s)))
+ ;; Evaluate from top to bottom every Babel block
+ ;; encountered.
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (unless (save-match-data (org-in-commented-heading-p))
+ (let* ((element (save-match-data (org-element-context)))
+ (type (org-element-type element))
+ (begin
+ (copy-marker (org-element-property :begin element)))
+ (end
+ (copy-marker
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (point)))))
+ (pcase type
+ (`inline-src-block
+ (let* ((info
+ (org-babel-get-src-block-info nil element))
+ (params (nth 2 info)))
+ (setf (nth 1 info)
+ (if (and (cdr (assq :noweb params))
+ (string= "yes"
+ (cdr (assq :noweb params))))
+ (org-babel-expand-noweb-references
+ info org-babel-exp-reference-buffer)
+ (nth 1 info)))
+ (goto-char begin)
+ (let ((replacement
+ (org-babel-exp-do-export info 'inline)))
+ (if (equal replacement "")
+ ;; Replacement code is empty: remove
+ ;; inline source block, including extra
+ ;; white space that might have been
+ ;; created when inserting results.
+ (delete-region begin
+ (progn (goto-char end)
+ (skip-chars-forward " \t")
+ (point)))
+ ;; Otherwise: remove inline src block but
+ ;; preserve following white spaces. Then
+ ;; insert value.
+ (delete-region begin end)
+ (insert replacement)))))
+ ((or `babel-call `inline-babel-call)
+ (org-babel-exp-do-export (org-babel-lob-get-info element)
+ 'lob)
+ (let ((rep
+ (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" .
+ ,(org-element-property :value element))))))
+ ;; If replacement is empty, completely remove
+ ;; the object/element, including any extra
+ ;; white space that might have been created
+ ;; when including results.
+ (if (equal rep "")
+ (delete-region
+ begin
+ (progn (goto-char end)
+ (if (not (eq type 'babel-call))
+ (progn (skip-chars-forward " \t")
+ (point))
+ (skip-chars-forward " \r\t\n")
+ (line-beginning-position))))
+ ;; Otherwise, preserve trailing
+ ;; spaces/newlines and then, insert
+ ;; replacement string.
+ (goto-char begin)
+ (delete-region begin end)
+ (insert rep))))
+ (`src-block
+ (let ((match-start (copy-marker (match-beginning 0)))
+ (ind (org-get-indentation)))
+ ;; Take care of matched block: compute
+ ;; replacement string. In particular, a nil
+ ;; REPLACEMENT means the block is left as-is
+ ;; while an empty string removes the block.
+ (let ((replacement
+ (progn (goto-char match-start)
+ (org-babel-exp-src-block))))
+ (cond ((not replacement) (goto-char end))
+ ((equal replacement "")
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (delete-region begin (point)))
+ (t
+ (goto-char match-start)
+ (delete-region (point)
+ (save-excursion
+ (goto-char end)
+ (line-end-position)))
+ (insert replacement)
+ (if (or org-src-preserve-indentation
+ (org-element-property
+ :preserve-indent element))
+ ;; Indent only code block
+ ;; markers.
+ (save-excursion
+ (skip-chars-backward " \r\t\n")
+ (indent-line-to ind)
+ (goto-char match-start)
+ (indent-line-to ind))
+ ;; Indent everything.
+ (indent-rigidly
+ match-start (point) ind)))))
+ (set-marker match-start nil))))
+ (set-marker begin nil)
+ (set-marker end nil)))))
+ (kill-buffer org-babel-exp-reference-buffer)
+ (remove-text-properties (point-min) (point-max) '(org-reference)))))))
(defun org-babel-exp-do-export (info type &optional hash)
"Return a string with the exported content of a code block.
The function respects the value of the :exports header argument."
- (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info)))))
- (when (not (and session (equal "none" session)))
- (org-babel-exp-results info type 'silent)))))
+ (let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info)))))
+ (unless (equal "none" session)
+ (org-babel-exp-results info type 'silent)))))
(clean (lambda () (if (eq type 'inline)
- (org-babel-remove-inline-result)
- (org-babel-remove-result info)))))
- (case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
- ('none (funcall silently) (funcall clean) "")
- ('code (funcall silently) (funcall clean) (org-babel-exp-code info type))
- ('results (org-babel-exp-results info type nil hash) "")
- ('both (org-babel-exp-results info type nil hash)
- (org-babel-exp-code info type)))))
+ (org-babel-remove-inline-result)
+ (org-babel-remove-result info)))))
+ (pcase (or (cdr (assq :exports (nth 2 info))) "code")
+ ("none" (funcall silently) (funcall clean) "")
+ ("code" (funcall silently) (funcall clean) (org-babel-exp-code info type))
+ ("results" (org-babel-exp-results info type nil hash) "")
+ ("both"
+ (org-babel-exp-results info type nil hash)
+ (org-babel-exp-code info type)))))
(defcustom org-babel-exp-code-template
"#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
@@ -369,13 +323,13 @@ defined for the code block may be used as a key and will be
replaced with its value."
:group 'org-babel
:type 'string
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3"))
(defun org-babel-exp-code (info type)
"Return the original code block formatted for export."
(setf (nth 1 info)
- (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info))))
+ (if (string= "strip-export" (cdr (assq :noweb (nth 2 info))))
(replace-regexp-in-string
(org-babel-noweb-wrap) "" (nth 1 info))
(if (org-babel-noweb-p (nth 2 info) :export)
@@ -400,14 +354,11 @@ replaced with its value."
(defun org-babel-exp-results (info type &optional silent hash)
"Evaluate and return the results of the current code block for export.
-Results are prepared in a manner suitable for export by org-mode.
+Results are prepared in a manner suitable for export by Org mode.
This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to
inhibit insertion of results into the buffer."
- (when (and (or (eq org-export-babel-evaluate t)
- (and (eq type 'inline)
- (eq org-export-babel-evaluate 'inline-only)))
- (not (and hash (equal hash (org-babel-current-result-hash)))))
+ (unless (and hash (equal hash (org-babel-current-result-hash)))
(let ((lang (nth 0 info))
(body (if (org-babel-noweb-p (nth 2 info) :eval)
(org-babel-expand-noweb-references
@@ -415,33 +366,29 @@ inhibit insertion of results into the buffer."
(nth 1 info)))
(info (copy-sequence info))
(org-babel-current-src-block-location (point-marker)))
- ;; skip code blocks which we can't evaluate
+ ;; Skip code blocks which we can't evaluate.
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
- (prog1 nil
- (setf (nth 1 info) body)
- (setf (nth 2 info)
- (org-babel-exp-in-export-file lang
- (org-babel-process-params
- (org-babel-merge-params
- (nth 2 info)
- `((:results . ,(if silent "silent" "replace")))))))
- (cond
- ((equal type 'block)
+ (setf (nth 1 info) body)
+ (setf (nth 2 info)
+ (org-babel-exp--at-source
+ (org-babel-process-params
+ (org-babel-merge-params
+ (nth 2 info)
+ `((:results . ,(if silent "silent" "replace")))))))
+ (pcase type
+ (`block (org-babel-execute-src-block nil info))
+ (`inline
+ ;; Position the point on the inline source block
+ ;; allowing `org-babel-insert-result' to check that the
+ ;; block is inline.
+ (goto-char (nth 5 info))
(org-babel-execute-src-block nil info))
- ((equal type 'inline)
- ;; position the point on the inline source block allowing
- ;; `org-babel-insert-result' to check that the block is
- ;; inline
- (re-search-backward "[ \f\t\n\r\v]" nil t)
- (re-search-forward org-babel-inline-src-block-regexp nil t)
- (re-search-backward "src_" nil t)
- (org-babel-execute-src-block nil info))
- ((equal type 'lob)
- (save-excursion
- (re-search-backward org-babel-lob-one-liner-regexp nil t)
- (let (org-confirm-babel-evaluate)
- (org-babel-execute-src-block nil info))))))))))
+ (`lob
+ (save-excursion
+ (goto-char (nth 5 info))
+ (let (org-confirm-babel-evaluate)
+ (org-babel-execute-src-block nil info)))))))))
(provide 'ob-exp)
diff --git a/lisp/ob-forth.el b/lisp/ob-forth.el
index 5a46d36..e487931 100644
--- a/lisp/ob-forth.el
+++ b/lisp/ob-forth.el
@@ -1,4 +1,4 @@
-;;; ob-forth.el --- org-babel functions for Forth
+;;; ob-forth.el --- Babel Functions for Forth -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
@@ -35,6 +35,7 @@
(require 'ob)
(declare-function forth-proc "ext:gforth" ())
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-default-header-args:forth '((:session . "yes"))
"Default header arguments for forth code blocks.")
@@ -42,10 +43,10 @@
(defun org-babel-execute:forth (body params)
"Execute a block of Forth code with org-babel.
This function is called by `org-babel-execute-src-block'"
- (if (string= "none" (cdr (assoc :session params)))
+ (if (string= "none" (cdr (assq :session params)))
(error "Non-session evaluation not supported for Forth code blocks")
(let ((all-results (org-babel-forth-session-execute body params)))
- (if (member "output" (cdr (assoc :result-params params)))
+ (if (member "output" (cdr (assq :result-params params)))
(mapconcat #'identity all-results "\n")
(car (last all-results))))))
@@ -76,10 +77,10 @@ This function is called by `org-babel-execute-src-block'"
(org-babel-eval-error-notify 1
(buffer-substring
(+ (match-beginning 0) 1) (point-max))) nil))))
- (split-string (org-babel-trim
- (org-babel-expand-body:generic
- body params))
- "\n" 'omit-nulls)))))
+ (split-string (org-trim
+ (org-babel-expand-body:generic body params))
+ "\n"
+ 'omit-nulls)))))
(provide 'ob-forth)
diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el
index ed5d2dc..6241c65 100644
--- a/lisp/ob-fortran.el
+++ b/lisp/ob-fortran.el
@@ -1,4 +1,4 @@
-;;; ob-fortran.el --- org-babel functions for fortran
+;;; ob-fortran.el --- Babel Functions for Fortran -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@@ -29,11 +29,12 @@
;;; Code:
(require 'ob)
(require 'cc-mode)
+(require 'cl-lib)
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
-(declare-function org-every "org" (pred seq))
(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
@@ -48,44 +49,42 @@
"This function should only be called by `org-babel-execute:fortran'"
(let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90"))
(tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext))
- (cmdline (cdr (assoc :cmdline params)))
- (flags (cdr (assoc :flags params)))
- (full-body (org-babel-expand-body:fortran body params))
- (compile
- (progn
- (with-temp-file tmp-src-file (insert full-body))
- (org-babel-eval
- (format "%s -o %s %s %s"
- org-babel-fortran-compiler
- (org-babel-process-file-name tmp-bin-file)
- (mapconcat 'identity
- (if (listp flags) flags (list flags)) " ")
- (org-babel-process-file-name tmp-src-file)) ""))))
+ (cmdline (cdr (assq :cmdline params)))
+ (flags (cdr (assq :flags params)))
+ (full-body (org-babel-expand-body:fortran body params)))
+ (with-temp-file tmp-src-file (insert full-body))
+ (org-babel-eval
+ (format "%s -o %s %s %s"
+ org-babel-fortran-compiler
+ (org-babel-process-file-name tmp-bin-file)
+ (mapconcat 'identity
+ (if (listp flags) flags (list flags)) " ")
+ (org-babel-process-file-name tmp-src-file)) "")
(let ((results
- (org-babel-trim
+ (org-trim
(org-remove-indentation
(org-babel-eval
(concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results)
(let ((tmp-file (org-babel-temp-file "f-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defun org-babel-expand-body:fortran (body params)
"Expand a block of fortran or fortran code with org-babel according to
its header arguments."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (main-p (not (string= (cdr (assoc :main params)) "no")))
- (includes (or (cdr (assoc :includes params))
+ (let ((vars (org-babel--get-vars params))
+ (main-p (not (string= (cdr (assq :main params)) "no")))
+ (includes (or (cdr (assq :includes params))
(org-babel-read (org-entry-get nil "includes" t))))
(defines (org-babel-read
- (or (cdr (assoc :defines params))
+ (or (cdr (assq :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
(mapconcat 'identity
(list
@@ -109,17 +108,17 @@ its header arguments."
(defun org-babel-fortran-ensure-main-wrap (body params)
"Wrap body in a \"program ... end program\" block if none exists."
(if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(if vars (error "Cannot use :vars if `program' statement is present"))
body)
(format "program main\n%s\nend program main\n" body)))
-(defun org-babel-prep-session:fortran (session params)
+(defun org-babel-prep-session:fortran (_session _params)
"This function does nothing as fortran is a compiled language with no
support for sessions"
(error "Fortran is a compiled languages -- no support for sessions"))
-(defun org-babel-load-session:fortran (session body params)
+(defun org-babel-load-session:fortran (_session _body _params)
"This function does nothing as fortran is a compiled language with no
support for sessions"
(error "Fortran is a compiled languages -- no support for sessions"))
@@ -147,7 +146,7 @@ of the same value."
(format "character(len=%d), parameter :: %S = '%s'\n"
(length val) var val))
;; val is a matrix
- ((and (listp val) (org-every #'listp val))
+ ((and (listp val) (cl-every #'listp val))
(format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n"
var (length val) (length (car val))
(org-babel-fortran-transform-list val)
diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el
index 237ecec..e91e05a 100644
--- a/lisp/ob-gnuplot.el
+++ b/lisp/ob-gnuplot.el
@@ -1,4 +1,4 @@
-;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation
+;;; ob-gnuplot.el --- Babel Functions for Gnuplot -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -39,9 +39,8 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
-(declare-function org-time-string-to-time "org" (s))
+(declare-function org-time-string-to-time "org" (s &optional buffer pos))
(declare-function org-combine-plists "org" (&rest plists))
(declare-function orgtbl-to-generic "org-table" (table params))
(declare-function gnuplot-mode "ext:gnuplot-mode" ())
@@ -80,7 +79,7 @@
Dumps all vectors into files and returns an association list
of variable names and the related value to be used in the gnuplot
code."
- (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params))))
+ (let ((*org-babel-gnuplot-missing* (cdr (assq :missing params))))
(mapcar
(lambda (pair)
(cons
@@ -94,32 +93,30 @@ code."
(if tablep val (mapcar 'list val)))
(org-babel-temp-file "gnuplot-") params)
val))))
- (mapcar #'cdr (org-babel-get-header params :var)))))
+ (org-babel--get-vars params))))
(defun org-babel-expand-body:gnuplot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params))
- (out-file (cdr (assoc :file params)))
- (prologue (cdr (assoc :prologue params)))
- (epilogue (cdr (assoc :epilogue params)))
- (term (or (cdr (assoc :term params))
+ (out-file (cdr (assq :file params)))
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params)))
+ (term (or (cdr (assq :term params))
(when out-file
(let ((ext (file-name-extension out-file)))
(or (cdr (assoc (intern (downcase ext))
*org-babel-gnuplot-terms*))
ext)))))
- (cmdline (cdr (assoc :cmdline params)))
- (title (cdr (assoc :title params)))
- (lines (cdr (assoc :line params)))
- (sets (cdr (assoc :set params)))
- (x-labels (cdr (assoc :xlabels params)))
- (y-labels (cdr (assoc :ylabels params)))
- (timefmt (cdr (assoc :timefmt params)))
- (time-ind (or (cdr (assoc :timeind params))
+ (title (cdr (assq :title params)))
+ (lines (cdr (assq :line params)))
+ (sets (cdr (assq :set params)))
+ (x-labels (cdr (assq :xlabels params)))
+ (y-labels (cdr (assq :ylabels params)))
+ (timefmt (cdr (assq :timefmt params)))
+ (time-ind (or (cdr (assq :timeind params))
(when timefmt 1)))
- (add-to-body (lambda (text) (setq body (concat text "\n" body))))
- output)
+ (add-to-body (lambda (text) (setq body (concat text "\n" body)))))
;; append header argument settings to body
(when title (funcall add-to-body (format "set title '%s'" title)))
(when lines (mapc (lambda (el) (funcall add-to-body el)) lines))
@@ -171,9 +168,8 @@ code."
"Execute a block of Gnuplot code.
This function is called by `org-babel-execute-src-block'."
(require 'gnuplot)
- (let ((session (cdr (assoc :session params)))
- (result-type (cdr (assoc :results params)))
- (out-file (cdr (assoc :file params)))
+ (let ((session (cdr (assq :session params)))
+ (result-type (cdr (assq :results params)))
(body (org-babel-expand-body:gnuplot body params))
output)
(save-window-excursion
@@ -206,10 +202,12 @@ This function is called by `org-babel-execute-src-block'."
(var-lines (org-babel-variable-assignments:gnuplot params)))
(message "%S" session)
(org-babel-comint-in-buffer session
- (mapc (lambda (var-line)
- (insert var-line) (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)
- (sit-for .1) (goto-char (point-max))) var-lines))
+ (dolist (var-line var-lines)
+ (insert var-line)
+ (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)
+ (sit-for .1)
+ (goto-char (point-max))))
session))
(defun org-babel-load-session:gnuplot (session body params)
@@ -228,7 +226,7 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-gnuplot-process-vars params)))
(defvar gnuplot-buffer)
-(defun org-babel-gnuplot-initiate-session (&optional session params)
+(defun org-babel-gnuplot-initiate-session (&optional session _params)
"Initiate a gnuplot session.
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session. The current
diff --git a/lisp/ob-groovy.el b/lisp/ob-groovy.el
index 14f644c..9578c70 100644
--- a/lisp/ob-groovy.el
+++ b/lisp/ob-groovy.el
@@ -1,4 +1,4 @@
-;;; ob-groovy.el --- org-babel functions for Groovy evaluation
+;;; ob-groovy.el --- Babel Functions for Groovy -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
@@ -31,7 +31,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
(add-to-list 'org-babel-tangle-lang-exts '("groovy" . "groovy"))
@@ -51,9 +50,8 @@ called by `org-babel-execute-src-block'"
(message "executing Groovy source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-groovy-initiate-session (nth 0 processed-params)))
- (vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
- (result-type (cdr (assoc :result-type params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params))
(result (org-babel-groovy-evaluate
@@ -62,9 +60,9 @@ called by `org-babel-execute-src-block'"
(org-babel-reassemble-table
result
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defvar org-babel-groovy-wrapper-method
@@ -78,19 +76,19 @@ println(new Runner().run())
(defun org-babel-groovy-evaluate
- (session body &optional result-type result-params)
+ (session body &optional result-type result-params)
"Evaluate BODY in external Groovy process.
If RESULT-TYPE equals `output' then return standard output as a string.
If RESULT-TYPE equals `value' then return the value of the last statement
in BODY as elisp."
(when session (error "Sessions are not (yet) supported for Groovy"))
- (case result-type
- (output
+ (pcase result-type
+ (`output
(let ((src-file (org-babel-temp-file "groovy-")))
(progn (with-temp-file src-file (insert body))
(org-babel-eval
(concat org-babel-groovy-command " " src-file) ""))))
- (value
+ (`value
(let* ((src-file (org-babel-temp-file "groovy-"))
(wrapper (format org-babel-groovy-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
@@ -101,11 +99,11 @@ in BODY as elisp."
(org-babel-script-escape raw)))))))
-(defun org-babel-prep-session:groovy (session params)
+(defun org-babel-prep-session:groovy (_session _params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Groovy"))
-(defun org-babel-groovy-initiate-session (&optional session)
+(defun org-babel-groovy-initiate-session (&optional _session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session. Sessions are not
supported in Groovy."
diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el
index e9cb3cc..5dcb516 100644
--- a/lisp/ob-haskell.el
+++ b/lisp/ob-haskell.el
@@ -1,4 +1,4 @@
-;;; ob-haskell.el --- org-babel functions for haskell evaluation
+;;; ob-haskell.el --- Babel Functions for Haskell -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -41,9 +41,9 @@
;;; Code:
(require 'ob)
(require 'comint)
-(eval-when-compile (require 'cl))
(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function haskell-mode "ext:haskell-mode" ())
(declare-function run-haskell "ext:inf-haskell" (&optional arg))
(declare-function inferior-haskell-load-file
@@ -61,42 +61,35 @@
(defun org-babel-execute:haskell (body params)
"Execute a block of Haskell code."
- (let* ((session (cdr (assoc :session params)))
- (vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((session (cdr (assq :session params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:haskell params)))
(session (org-babel-haskell-initiate-session session params))
(raw (org-babel-comint-with-output
(session org-babel-haskell-eoe t full-body)
- (insert (org-babel-trim full-body))
+ (insert (org-trim full-body))
(comint-send-input nil t)
(insert org-babel-haskell-eoe)
(comint-send-input nil t)))
(results (mapcar
- #'org-babel-haskell-read-string
+ #'org-babel-strip-quotes
(cdr (member org-babel-haskell-eoe
- (reverse (mapcar #'org-babel-trim raw)))))))
+ (reverse (mapcar #'org-trim raw)))))))
(org-babel-reassemble-table
(let ((result
- (case result-type
- (output (mapconcat #'identity (reverse (cdr results)) "\n"))
- (value (car results)))))
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (pcase result-type
+ (`output (mapconcat #'identity (reverse (cdr results)) "\n"))
+ (`value (car results)))))
+ (org-babel-result-cond (cdr (assq :result-params params))
result (org-babel-script-escape result)))
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colname-names params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rowname-names params))))))
-
-(defun org-babel-haskell-read-string (string)
- "Strip \\\"s from around a haskell string."
- (if (string-match "^\"\\([^\000]+\\)\"$" string)
- (match-string 1 string)
- string))
-
-(defun org-babel-haskell-initiate-session (&optional session params)
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colname-names params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rowname-names params))))))
+
+(defun org-babel-haskell-initiate-session (&optional _session _params)
"Initiate a haskell session.
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session."
@@ -131,7 +124,7 @@ then create one. Return the initialized session."
(format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-haskell-var-to-haskell (var)
"Convert an elisp value VAR into a haskell variable.
@@ -144,13 +137,14 @@ specifying a variable of the same value."
(defvar org-export-copy-to-kill-ring)
(declare-function org-export-to-file "ox"
(backend file
- &optional async subtreep visible-only body-only ext-plist))
+ &optional async subtreep visible-only body-only
+ ext-plist post-process))
(defun org-babel-haskell-export-to-lhs (&optional arg)
"Export to a .lhs file with all haskell code blocks escaped.
When called with a prefix argument the resulting
.lhs file will be exported to a .tex file. This function will
create two new files, base-name.lhs and base-name.tex where
-base-name is the name of the current org-mode file.
+base-name is the name of the current Org file.
Note that all standard Babel literate programming
constructs (header arguments, no-web syntax etc...) are ignored."
@@ -178,12 +172,12 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(save-match-data (setq indentation (length (match-string 1))))
(replace-match (save-match-data
(concat
- "#+begin_latex\n\\begin{code}\n"
+ "#+begin_export latex\n\\begin{code}\n"
(if (or preserve-indentp
(string-match "-i" (match-string 2)))
(match-string 3)
(org-remove-indentation (match-string 3)))
- "\n\\end{code}\n#+end_latex\n"))
+ "\n\\end{code}\n#+end_export\n"))
t t)
(indent-code-rigidly (match-beginning 0) (match-end 0) indentation)))
(save-excursion
diff --git a/lisp/ob-io.el b/lisp/ob-io.el
index ec2cd02..186b1b2 100644
--- a/lisp/ob-io.el
+++ b/lisp/ob-io.el
@@ -1,4 +1,4 @@
-;;; ob-io.el --- org-babel functions for Io evaluation
+;;; ob-io.el --- Babel Functions for Io -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@@ -33,7 +33,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
(add-to-list 'org-babel-tangle-lang-exts '("io" . "io"))
@@ -47,9 +46,8 @@ called by `org-babel-execute-src-block'"
(message "executing Io source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-io-initiate-session (nth 0 processed-params)))
- (vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
- (result-type (cdr (assoc :result-type params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params))
(result (org-babel-io-evaluate
@@ -58,9 +56,9 @@ called by `org-babel-execute-src-block'"
(org-babel-reassemble-table
result
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defvar org-babel-io-wrapper-method
"(
@@ -75,29 +73,29 @@ If RESULT-TYPE equals `output' then return standard output as a string.
If RESULT-TYPE equals `value' then return the value of the last statement
in BODY as elisp."
(when session (error "Sessions are not (yet) supported for Io"))
- (case result-type
- (output
+ (pcase result-type
+ (`output
(if (member "repl" result-params)
(org-babel-eval org-babel-io-command body)
(let ((src-file (org-babel-temp-file "io-")))
(progn (with-temp-file src-file (insert body))
(org-babel-eval
(concat org-babel-io-command " " src-file) "")))))
- (value (let* ((src-file (org-babel-temp-file "io-"))
- (wrapper (format org-babel-io-wrapper-method body)))
- (with-temp-file src-file (insert wrapper))
- (let ((raw (org-babel-eval
- (concat org-babel-io-command " " src-file) "")))
- (org-babel-result-cond result-params
- raw
- (org-babel-script-escape raw)))))))
+ (`value (let* ((src-file (org-babel-temp-file "io-"))
+ (wrapper (format org-babel-io-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ (let ((raw (org-babel-eval
+ (concat org-babel-io-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-script-escape raw)))))))
-(defun org-babel-prep-session:io (session params)
+(defun org-babel-prep-session:io (_session _params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Io"))
-(defun org-babel-io-initiate-session (&optional session)
+(defun org-babel-io-initiate-session (&optional _session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session. Sessions are not
supported in Io."
diff --git a/lisp/ob-java.el b/lisp/ob-java.el
index 5856c65..ccae020 100644
--- a/lisp/ob-java.el
+++ b/lisp/ob-java.el
@@ -1,4 +1,4 @@
-;;; ob-java.el --- org-babel functions for java evaluation
+;;; ob-java.el --- Babel Functions for Java -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@@ -51,34 +51,32 @@ parameters may be used, like javac -verbose"
:type 'string)
(defun org-babel-execute:java (body params)
- (let* ((classname (or (cdr (assoc :classname params))
+ (let* ((classname (or (cdr (assq :classname params))
(error
"Can't compile a java block without a classname")))
(packagename (file-name-directory classname))
(src-file (concat classname ".java"))
- (cmpflag (or (cdr (assoc :cmpflag params)) ""))
- (cmdline (or (cdr (assoc :cmdline params)) ""))
- (full-body (org-babel-expand-body:generic body params))
- (compile
- (progn (with-temp-file src-file (insert full-body))
- (org-babel-eval
- (concat org-babel-java-compiler
- " " cmpflag " " src-file) ""))))
+ (cmpflag (or (cdr (assq :cmpflag params)) ""))
+ (cmdline (or (cdr (assq :cmdline params)) ""))
+ (full-body (org-babel-expand-body:generic body params)))
+ (with-temp-file src-file (insert full-body))
+ (org-babel-eval
+ (concat org-babel-java-compiler " " cmpflag " " src-file) "")
;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
(let ((results (org-babel-eval (concat org-babel-java-command
" " cmdline " " classname) "")))
(org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results)
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(provide 'ob-java)
diff --git a/lisp/ob-js.el b/lisp/ob-js.el
index 9440aa9..1a20d7e 100644
--- a/lisp/ob-js.el
+++ b/lisp/ob-js.el
@@ -1,4 +1,4 @@
-;;; ob-js.el --- org-babel functions for Javascript
+;;; ob-js.el --- Babel Functions for Javascript -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -39,7 +39,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function run-mozilla "ext:moz" (arg))
@@ -62,14 +61,14 @@
(defun org-babel-execute:js (body params)
"Execute a block of Javascript code with org-babel.
This function is called by `org-babel-execute-src-block'"
- (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((org-babel-js-cmd (or (cdr (assq :cmd params)) org-babel-js-cmd))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:js params)))
- (result (if (not (string= (cdr (assoc :session params)) "none"))
+ (result (if (not (string= (cdr (assq :session params)) "none"))
;; session evaluation
(let ((session (org-babel-prep-session:js
- (cdr (assoc :session params)) params)))
+ (cdr (assq :session params)) params)))
(nth 1
(org-babel-comint-with-output
(session (format "%S" org-babel-js-eoe) t body)
@@ -89,7 +88,7 @@ This function is called by `org-babel-execute-src-block'"
(org-babel-eval
(format "%s %s" org-babel-js-cmd
(org-babel-process-file-name script-file)) "")))))
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-result-cond (cdr (assq :result-params params))
result (org-babel-js-read result))))
(defun org-babel-js-read (results)
@@ -97,7 +96,9 @@ This function is called by `org-babel-execute-src-block'"
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
- (if (and (stringp results) (string-match "^\\[[^\000]+\\]$" results))
+ (if (and (stringp results)
+ (string-prefix-p "[" results)
+ (string-suffix-p "]" results))
(org-babel-read
(concat "'"
(replace-regexp-in-string
@@ -134,7 +135,7 @@ specifying a variable of the same value."
(mapcar
(lambda (pair) (format "var %s=%s;"
(car pair) (org-babel-js-var-to-js (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-js-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el
index 6a63456..318f549 100644
--- a/lisp/ob-keys.el
+++ b/lisp/ob-keys.el
@@ -1,4 +1,4 @@
-;;; ob-keys.el --- key bindings for org-babel
+;;; ob-keys.el --- Key Bindings for Babel -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -23,8 +23,8 @@
;;; Commentary:
-;; Add org-babel keybindings to the org-mode keymap for exposing
-;; org-babel functions. These will all share a common prefix. See
+;; Add Org Babel keybindings to the Org mode keymap for exposing
+;; Org Babel functions. These will all share a common prefix. See
;; the value of `org-babel-key-bindings' for a list of interactive
;; functions and their associated keys.
diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el
index 681e229..8fc0493 100644
--- a/lisp/ob-latex.el
+++ b/lisp/ob-latex.el
@@ -1,4 +1,4 @@
-;;; ob-latex.el --- org-babel functions for latex "evaluation"
+;;; ob-latex.el --- Babel Functions for LaTeX -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -32,11 +32,11 @@
;;; Code:
(require 'ob)
-(declare-function org-create-formula-image "org" (string tofile options buffer))
-(declare-function org-splice-latex-header "org"
- (tpl def-pkg pkg snippets-p &optional extra))
+(declare-function org-create-formula-image "org" (string tofile options buffer &optional type))
+(declare-function org-latex-compile "ox-latex" (texfile &optional snippet))
(declare-function org-latex-guess-inputenc "ox-latex" (header))
-(declare-function org-latex-compile "ox-latex" (file))
+(declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
@@ -53,12 +53,16 @@
(defconst org-babel-header-args:latex
'((border . :any)
(fit . :any)
+ (imagemagick . ((nil t)))
(iminoptions . :any)
(imoutoptions . :any)
(packages . :any)
(pdfheight . :any)
(pdfpng . :any)
- (pdfwidth . :any))
+ (pdfwidth . :any)
+ (headers . :any)
+ (packages . :any)
+ (buffer . ((yes no))))
"LaTeX-specific header arguments.")
(defcustom org-babel-latex-htlatex "htlatex"
@@ -80,38 +84,38 @@
(regexp-quote (format "%S" (car pair)))
(if (stringp (cdr pair))
(cdr pair) (format "%S" (cdr pair)))
- body))) (mapcar #'cdr (org-babel-get-header params :var)))
- (org-babel-trim body))
+ body))) (org-babel--get-vars params))
+ (org-trim body))
(defun org-babel-execute:latex (body params)
"Execute a block of Latex code with Babel.
This function is called by `org-babel-execute-src-block'."
(setq body (org-babel-expand-body:latex body params))
- (if (cdr (assoc :file params))
- (let* ((out-file (cdr (assoc :file params)))
+ (if (cdr (assq :file params))
+ (let* ((out-file (cdr (assq :file params)))
+ (extension (file-name-extension out-file))
(tex-file (org-babel-temp-file "latex-" ".tex"))
- (border (cdr (assoc :border params)))
- (imagemagick (cdr (assoc :imagemagick params)))
- (im-in-options (cdr (assoc :iminoptions params)))
- (im-out-options (cdr (assoc :imoutoptions params)))
- (pdfpng (cdr (assoc :pdfpng params)))
- (fit (or (cdr (assoc :fit params)) border))
- (height (and fit (cdr (assoc :pdfheight params))))
- (width (and fit (cdr (assoc :pdfwidth params))))
- (headers (cdr (assoc :headers params)))
- (in-buffer (not (string= "no" (cdr (assoc :buffer params)))))
+ (border (cdr (assq :border params)))
+ (imagemagick (cdr (assq :imagemagick params)))
+ (im-in-options (cdr (assq :iminoptions params)))
+ (im-out-options (cdr (assq :imoutoptions params)))
+ (fit (or (cdr (assq :fit params)) border))
+ (height (and fit (cdr (assq :pdfheight params))))
+ (width (and fit (cdr (assq :pdfwidth params))))
+ (headers (cdr (assq :headers params)))
+ (in-buffer (not (string= "no" (cdr (assq :buffer params)))))
(org-latex-packages-alist
- (append (cdr (assoc :packages params)) org-latex-packages-alist)))
+ (append (cdr (assq :packages params)) org-latex-packages-alist)))
(cond
- ((and (string-match "\\.png$" out-file) (not imagemagick))
+ ((and (string-suffix-p ".png" out-file) (not imagemagick))
(org-create-formula-image
body out-file org-format-latex-options in-buffer))
- ((string-match "\\.tikz$" out-file)
+ ((string-suffix-p ".tikz" out-file)
(when (file-exists-p out-file) (delete-file out-file))
(with-temp-file out-file
(insert body)))
- ((and (or (string-match "\\.svg$" out-file)
- (string-match "\\.html$" out-file))
+ ((and (or (string= "svg" extension)
+ (string= "html" extension))
(executable-find org-babel-latex-htlatex))
;; TODO: this is a very different way of generating the
;; frame latex document than in the pdf case. Ideally, both
@@ -141,7 +145,7 @@ This function is called by `org-babel-execute-src-block'."
(shell-command (format "%s %s" org-babel-latex-htlatex tex-file)))
(cond
((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg"))
- (if (string-match "\\.svg$" out-file)
+ (if (string-suffix-p ".svg" out-file)
(progn
(shell-command "pwd")
(shell-command (format "mv %s %s"
@@ -149,13 +153,13 @@ This function is called by `org-babel-execute-src-block'."
out-file)))
(error "SVG file produced but HTML file requested")))
((file-exists-p (concat (file-name-sans-extension tex-file) ".html"))
- (if (string-match "\\.html$" out-file)
+ (if (string-suffix-p ".html" out-file)
(shell-command "mv %s %s"
(concat (file-name-sans-extension tex-file)
".html")
out-file)
(error "HTML file produced but SVG file requested")))))
- ((or (string-match "\\.pdf$" out-file) imagemagick)
+ ((or (string= "pdf" extension) imagemagick)
(with-temp-file tex-file
(require 'ox-latex)
(insert
@@ -188,16 +192,16 @@ This function is called by `org-babel-execute-src-block'."
(when (file-exists-p out-file) (delete-file out-file))
(let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file)))
(cond
- ((string-match "\\.pdf$" out-file)
+ ((string= "pdf" extension)
(rename-file transient-pdf-file out-file))
(imagemagick
(org-babel-latex-convert-pdf
transient-pdf-file out-file im-in-options im-out-options)
(when (file-exists-p transient-pdf-file)
- (delete-file transient-pdf-file))))))
- ((string-match "\\.\\([^\\.]+\\)$" out-file)
- (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
- (match-string 1 out-file))))
+ (delete-file transient-pdf-file)))
+ (t
+ (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
+ extension))))))
nil) ;; signal that output has already been written to file
body))
@@ -213,7 +217,7 @@ This function is called by `org-babel-execute-src-block'."
(require 'ox-latex)
(org-latex-compile file))
-(defun org-babel-prep-session:latex (session params)
+(defun org-babel-prep-session:latex (_session _params)
"Return an error because LaTeX doesn't support sessions."
(error "LaTeX does not support sessions"))
diff --git a/lisp/ob-ledger.el b/lisp/ob-ledger.el
index d07f257..ee2ce0a 100644
--- a/lisp/ob-ledger.el
+++ b/lisp/ob-ledger.el
@@ -1,4 +1,4 @@
-;;; ob-ledger.el --- org-babel functions for ledger evaluation
+;;; ob-ledger.el --- Babel Functions for Ledger -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -46,8 +46,7 @@
"Execute a block of Ledger entries with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Ledger source code block")
- (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (cmdline (cdr (assoc :cmdline params)))
+ (let ((cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "ledger-"))
(out-file (org-babel-temp-file "ledger-output-")))
(with-temp-file in-file (insert body))
@@ -61,7 +60,7 @@ called by `org-babel-execute-src-block'."
" > " (org-babel-process-file-name out-file))))
(with-temp-buffer (insert-file-contents out-file) (buffer-string))))
-(defun org-babel-prep-session:ledger (session params)
+(defun org-babel-prep-session:ledger (_session _params)
(error "Ledger does not support sessions"))
(provide 'ob-ledger)
diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el
index bfbace5..3d2e50f 100644
--- a/lisp/ob-lilypond.el
+++ b/lisp/ob-lilypond.el
@@ -1,4 +1,4 @@
-;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
+;;; ob-lilypond.el --- Babel Functions for Lilypond -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -92,7 +92,7 @@ you can leave the string empty on this case."
:version "24.3"
:package-version '(Org . "8.2.7")
:set
- (lambda (symbol value)
+ (lambda (_symbol value)
(setq
org-babel-lilypond-ly-command (nth 0 value)
org-babel-lilypond-pdf-command (nth 1 value)
@@ -123,7 +123,7 @@ blocks.")
(defun org-babel-expand-body:lilypond (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
@@ -157,9 +157,8 @@ specific arguments to =org-babel-tangle="
(defun org-babel-lilypond-process-basic (body params)
"Execute a lilypond block in basic mode."
- (let* ((result-params (cdr (assoc :result-params params)))
- (out-file (cdr (assoc :file params)))
- (cmdline (or (cdr (assoc :cmdline params))
+ (let* ((out-file (cdr (assq :file params)))
+ (cmdline (or (cdr (assq :cmdline params))
""))
(in-file (org-babel-temp-file "lilypond-")))
@@ -182,7 +181,7 @@ specific arguments to =org-babel-tangle="
cmdline
in-file) "")) nil)
-(defun org-babel-prep-session:lilypond (session params)
+(defun org-babel-prep-session:lilypond (_session _params)
"Return an error because LilyPond exporter does not support sessions."
(error "Sorry, LilyPond does not currently support sessions!"))
@@ -272,25 +271,19 @@ LINE is the erroneous line"
(defun org-babel-lilypond-parse-line-num (&optional buffer)
"Extract error line number."
- (when buffer
- (set-buffer buffer))
+ (when buffer (set-buffer buffer))
(let ((start
(and (search-backward ":" nil t)
(search-backward ":" nil t)
(search-backward ":" nil t)
- (search-backward ":" nil t)))
- (num nil))
- (if start
- (progn
- (forward-char)
- (let ((num (buffer-substring
- (+ 1 start)
- (- (search-forward ":" nil t) 1))))
- (setq num (string-to-number num))
- (if (numberp num)
- num
- nil)))
- nil)))
+ (search-backward ":" nil t))))
+ (when start
+ (forward-char)
+ (let ((num (string-to-number
+ (buffer-substring
+ (+ 1 start)
+ (- (search-forward ":" nil t) 1)))))
+ (and (numberp num) num)))))
(defun org-babel-lilypond-parse-error-line (file-name lineNo)
"Extract the erroneous line from the tangled .ly file
diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el
index 04df7fb..da7e4f4 100644
--- a/lisp/ob-lisp.el
+++ b/lisp/ob-lisp.el
@@ -1,4 +1,4 @@
-;;; ob-lisp.el --- org-babel functions for common lisp evaluation
+;;; ob-lisp.el --- Babel Functions for Common Lisp -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -25,17 +25,22 @@
;;; Commentary:
-;;; support for evaluating common lisp code, relies on slime for all eval
+;;; Support for evaluating Common Lisp code, relies on SLY or SLIME
+;;; for all eval.
;;; Requirements:
-;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.)
-;; See http://common-lisp.net/project/slime/
+;; Requires SLY (Sylvester the Cat's Common Lisp IDE) or SLIME
+;; (Superior Lisp Interaction Mode for Emacs). See:
+;; - https://github.com/capitaomorte/sly
+;; - http://common-lisp.net/project/slime/
;;; Code:
(require 'ob)
+(declare-function sly-eval "ext:sly" (sexp &optional package))
(declare-function slime-eval "ext:slime" (sexp &optional package))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp"))
@@ -43,6 +48,14 @@
(defvar org-babel-default-header-args:lisp '())
(defvar org-babel-header-args:lisp '((package . :any)))
+(defcustom org-babel-lisp-eval-fn #'slime-eval
+ "The function to be called to evaluate code on the Lisp side.
+Valid values include `slime-eval' and `sly-eval'."
+ :group 'org-babel
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :type 'function)
+
(defcustom org-babel-lisp-dir-fmt
"(let ((*default-pathname-defaults* #P%S\n)) %%s\n)"
"Format string used to wrap code bodies to set the current directory.
@@ -54,51 +67,54 @@ current directory string."
(defun org-babel-expand-body:lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
+ (let* ((vars (org-babel--get-vars params))
+ (result-params (cdr (assq :result-params params)))
(print-level nil) (print-length nil)
- (body (org-babel-trim
- (if (> (length vars) 0)
- (concat "(let ("
- (mapconcat
- (lambda (var)
- (format "(%S (quote %S))" (car var) (cdr var)))
- vars "\n ")
- ")\n" body ")")
- body))))
+ (body (if (null vars) (org-trim body)
+ (concat "(let ("
+ (mapconcat
+ (lambda (var)
+ (format "(%S (quote %S))" (car var) (cdr var)))
+ vars "\n ")
+ ")\n" body ")"))))
(if (or (member "code" result-params)
(member "pp" result-params))
(format "(pprint %s)" body)
body)))
(defun org-babel-execute:lisp (body params)
- "Execute a block of Common Lisp code with Babel."
- (require 'slime)
+ "Execute a block of Common Lisp code with Babel.
+BODY is the contents of the block, as a string. PARAMS is
+a property list containing the parameters of the block."
+ (require (pcase org-babel-lisp-eval-fn
+ (`slime-eval 'slime)
+ (`sly-eval 'sly)))
(org-babel-reassemble-table
(let ((result
- (funcall (if (member "output" (cdr (assoc :result-params params)))
- #'car #'cadr)
- (with-temp-buffer
- (insert (org-babel-expand-body:lisp body params))
- (slime-eval `(swank:eval-and-grab-output
- ,(let ((dir (if (assoc :dir params)
- (cdr (assoc :dir params))
- default-directory)))
- (format
- (if dir (format org-babel-lisp-dir-fmt dir)
- "(progn %s\n)")
- (buffer-substring-no-properties
- (point-min) (point-max)))))
- (cdr (assoc :package params)))))))
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (funcall (if (member "output" (cdr (assq :result-params params)))
+ #'car #'cadr)
+ (with-temp-buffer
+ (insert (org-babel-expand-body:lisp body params))
+ (funcall org-babel-lisp-eval-fn
+ `(swank:eval-and-grab-output
+ ,(let ((dir (if (assq :dir params)
+ (cdr (assq :dir params))
+ default-directory)))
+ (format
+ (if dir (format org-babel-lisp-dir-fmt dir)
+ "(progn %s\n)")
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (cdr (assq :package params)))))))
+ (org-babel-result-cond (cdr (assq :result-params params))
result
(condition-case nil
(read (org-babel-lisp-vector-to-list result))
(error result))))
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params)))))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params)))))
(defun org-babel-lisp-vector-to-list (results)
;; TODO: better would be to replace #(...) with [...]
diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el
index cf5cb4e..1c4123b 100644
--- a/lisp/ob-lob.el
+++ b/lisp/ob-lob.el
@@ -1,4 +1,4 @@
-;;; ob-lob.el --- functions supporting the Library of Babel
+;;; ob-lob.el --- Functions Supporting the Library of Babel -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -23,27 +23,27 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'ob-core)
(require 'ob-table)
-(declare-function org-babel-in-example-or-verbatim "ob-exp" nil)
+(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
(defvar org-babel-library-of-babel nil
"Library of source-code blocks.
-This is an association list. Populate the library by adding
-files to `org-babel-lob-files'.")
-
-(defcustom org-babel-lob-files nil
- "Files used to populate the `org-babel-library-of-babel'.
-To add files to this list use the `org-babel-lob-ingest' command."
- :group 'org-babel
- :version "24.1"
- :type '(repeat file))
+This is an association list. Populate the library by calling
+`org-babel-lob-ingest' on files containing source blocks.")
(defvar org-babel-default-lob-header-args '((:exports . "results"))
- "Default header arguments to use when exporting #+lob/call lines.")
+ "Default header arguments to use when exporting Babel calls.
+By default, a Babel call inherits its arguments from the source
+block being called. Header arguments defined in this variable
+take precedence over these. It is useful for properties that
+should not be inherited from a source block.")
(defun org-babel-lob-ingest (&optional file)
"Add all named source blocks defined in FILE to `org-babel-library-of-babel'."
@@ -62,24 +62,7 @@ To add files to this list use the `org-babel-lob-ingest' command."
lob-ingest-count (if (> lob-ingest-count 1) "s" ""))
lob-ingest-count))
-(defconst org-babel-block-lob-one-liner-regexp
- (concat
- "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
- "(\\([^\n]*?\\))\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?")
- "Regexp to match non-inline calls to predefined source block functions.")
-
-(defconst org-babel-inline-lob-one-liner-regexp
- (concat
- "\\([^\n]*?\\)call_\\([^()[:space:]\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
- "(\\(.*?\\))\\(\\[\\(.*?\\)\\]\\)?")
- "Regexp to match inline calls to predefined source block functions.")
-
-(defconst org-babel-lob-one-liner-regexp
- (concat "\\(" org-babel-block-lob-one-liner-regexp
- "\\|" org-babel-inline-lob-one-liner-regexp "\\)")
- "Regexp to match calls to predefined source block functions.")
-
-;; functions for executing lob one-liners
+;; Functions for executing lob one-liners.
;;;###autoload
(defun org-babel-lob-execute-maybe ()
@@ -88,87 +71,76 @@ Detect if this is context for a Library Of Babel source block and
if so then run the appropriate source block from the Library."
(interactive)
(let ((info (org-babel-lob-get-info)))
- (if (and (nth 0 info) (not (org-babel-in-example-or-verbatim)))
- (progn (org-babel-lob-execute info) t)
- nil)))
+ (when info
+ (org-babel-execute-src-block nil info)
+ t)))
+
+(defun org-babel-lob--src-info (name)
+ "Return internal representation for Babel data named NAME.
+NAME is a string. This function looks into the current document
+for a Babel call or source block. If none is found, it looks
+after NAME in the Library of Babel. Eventually, if that also
+fails, it returns nil."
+ ;; During export, look into the pristine copy of the document being
+ ;; exported instead of the current one, which could miss some data.
+ (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (catch :found
+ (let ((case-fold-search t)
+ (regexp (org-babel-named-data-regexp-for-name name)))
+ (while (re-search-forward regexp nil t)
+ (let ((element (org-element-at-point)))
+ (when (equal name (org-element-property :name element))
+ (throw :found
+ (pcase (org-element-type element)
+ (`src-block (org-babel-get-src-block-info t element))
+ (`babel-call (org-babel-lob-get-info element))
+ ;; Non-executable data found. Since names are
+ ;; supposed to be unique throughout a document,
+ ;; bail out.
+ (_ nil))))))
+ ;; No element named NAME in buffer. Try Library of Babel.
+ (cdr (assoc-string name org-babel-library-of-babel)))))))
;;;###autoload
-(defun org-babel-lob-get-info ()
- "Return a Library of Babel function call as a string."
- (let ((case-fold-search t)
- (nonempty (lambda (a b)
- (let ((it (match-string a)))
- (if (= (length it) 0) (match-string b) it)))))
- (save-excursion
- (beginning-of-line 1)
- (when (looking-at org-babel-lob-one-liner-regexp)
- (append
- (mapcar #'org-no-properties
- (list
- (format "%s%s(%s)%s"
- (funcall nonempty 3 12)
- (if (not (= 0 (length (funcall nonempty 5 14))))
- (concat "[" (funcall nonempty 5 14) "]") "")
- (or (funcall nonempty 7 16) "")
- (or (funcall nonempty 8 19) ""))
- (funcall nonempty 9 18)))
- (list (length (if (= (length (match-string 12)) 0)
- (match-string 2) (match-string 11)))
- (save-excursion
- (forward-line -1)
- (save-match-data
- (and (looking-at (concat org-babel-src-name-regexp
- "\\([^\n]*\\)$"))
- (org-no-properties (match-string 1)))))))))))
-
-(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el
-(defun org-babel-lob-execute (info)
- "Execute the lob call specified by INFO."
- (let* ((mkinfo (lambda (p)
- (list "emacs-lisp" "results" p nil
- (nth 3 info) ;; name
- (nth 2 info))))
- (pre-params (apply #'org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-header-args:emacs-lisp
- (append
- (org-babel-params-from-properties)
- (list
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat
- ":var results="
- (mapconcat #'identity (butlast info 2)
- " "))))))))
- (pre-info (funcall mkinfo pre-params))
- (cache-p (and (cdr (assoc :cache pre-params))
- (string= "yes" (cdr (assoc :cache pre-params)))))
- (new-hash (when cache-p
- (org-babel-sha1-hash
- ;; Do *not* pre-process params for call line
- ;; hash evaluation, since for a call line :var
- ;; extension *is* execution.
- (let* ((params (nth 2 pre-info))
- (sha1-nth2 (list
- (cons
- (cons :c-var (cdr (assoc :var params)))
- (assq-delete-all :var (copy-tree params)))))
- (sha1-info (copy-tree pre-info)))
- (prog1 sha1-info
- (setcar (cddr sha1-info) sha1-nth2))))))
- (old-hash (when cache-p (org-babel-current-result-hash pre-info)))
- (org-babel-current-src-block-location (point-marker)))
- (if (and cache-p (equal new-hash old-hash))
- (save-excursion (goto-char (org-babel-where-is-src-block-result
- nil pre-info))
- (forward-line 1)
- (message "%S" (org-babel-read-result)))
- (prog1 (let* ((proc-params (org-babel-process-params pre-params))
- org-confirm-babel-evaluate)
- (org-babel-execute-src-block nil (funcall mkinfo proc-params)))
- ;; update the hash
- (when new-hash
- (org-babel-set-current-result-hash new-hash pre-info))))))
+(defun org-babel-lob-get-info (&optional datum)
+ "Return internal representation for Library of Babel function call.
+Consider DATUM, when provided, or element at point. Return nil
+when not on an appropriate location. Otherwise return a list
+compatible with `org-babel-get-src-block-info', which see."
+ (let* ((context (or datum (org-element-context)))
+ (type (org-element-type context)))
+ (when (memq type '(babel-call inline-babel-call))
+ (pcase (org-babel-lob--src-info (org-element-property :call context))
+ (`(,language ,body ,header ,_ ,_ ,_ ,coderef)
+ (let ((begin (org-element-property (if (eq type 'inline-babel-call)
+ :begin
+ :post-affiliated)
+ context)))
+ (list language
+ body
+ (apply #'org-babel-merge-params
+ header
+ org-babel-default-lob-header-args
+ (append
+ (org-with-wide-buffer
+ (goto-char begin)
+ (org-babel-params-from-properties language))
+ (list
+ (org-babel-parse-header-arguments
+ (org-element-property :inside-header context))
+ (let ((args (org-element-property :arguments context)))
+ (and args
+ (mapcar (lambda (ref) (cons :var ref))
+ (org-babel-ref-split-args args))))
+ (org-babel-parse-header-arguments
+ (org-element-property :end-header context)))))
+ nil
+ (org-element-property :name context)
+ begin
+ coderef)))
+ (_ nil)))))
(provide 'ob-lob)
diff --git a/lisp/ob-lua.el b/lisp/ob-lua.el
new file mode 100644
index 0000000..afb5c45
--- /dev/null
+++ b/lisp/ob-lua.el
@@ -0,0 +1,403 @@
+;;; ob-lua.el --- Org Babel functions for Lua evaluation -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014, 2016 Free Software Foundation, Inc.
+
+;; Authors: Dieter Schoen
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;; Requirements:
+;; for session support, lua-mode is needed.
+;; lua-mode is not part of GNU Emacs/orgmode, but can be obtained
+;; from marmalade or melpa.
+;; The source respository is here:
+;; https://github.com/immerrr/lua-mode
+
+;; However, sessions are not yet working.
+
+;; Org-Babel support for evaluating lua source code.
+
+;;; Code:
+(require 'ob)
+(require 'cl-lib)
+
+(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-trim "org" (s &optional keep-lead))
+(declare-function lua-shell "ext:lua-mode" (&optional argprompt))
+(declare-function lua-toggle-shells "ext:lua-mode" (arg))
+(declare-function run-lua "ext:lua" (cmd &optional dedicated show))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("lua" . "lua"))
+
+(defvar org-babel-default-header-args:lua '())
+
+(defcustom org-babel-lua-command "lua"
+ "Name of the command for executing Lua code."
+ :version "24.5"
+ :package-version '(Org . "8.3")
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-lua-mode 'lua-mode
+ "Preferred lua mode for use in running lua interactively.
+This will typically be 'lua-mode."
+ :group 'org-babel
+ :version "24.5"
+ :package-version '(Org . "8.3")
+ :type 'symbol)
+
+(defcustom org-babel-lua-hline-to "None"
+ "Replace hlines in incoming tables with this when translating to lua."
+ :group 'org-babel
+ :version "24.5"
+ :package-version '(Org . "8.3")
+ :type 'string)
+
+(defcustom org-babel-lua-None-to 'hline
+ "Replace 'None' in lua tables with this before returning."
+ :group 'org-babel
+ :version "24.5"
+ :package-version '(Org . "8.3")
+ :type 'symbol)
+
+(defun org-babel-execute:lua (body params)
+ "Execute a block of Lua code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((session (org-babel-lua-initiate-session
+ (cdr (assq :session params))))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
+ (return-val (when (and (eq result-type 'value) (not session))
+ (cdr (assq :return params))))
+ (preamble (cdr (assq :preamble params)))
+ (full-body
+ (org-babel-expand-body:generic
+ (concat body (if return-val (format "\nreturn %s" return-val) ""))
+ params (org-babel-variable-assignments:lua params)))
+ (result (org-babel-lua-evaluate
+ session full-body result-type result-params preamble)))
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params))))))
+
+(defun org-babel-prep-session:lua (session params)
+ "Prepare SESSION according to the header arguments in PARAMS.
+VARS contains resolved variable references"
+ (let* ((session (org-babel-lua-initiate-session session))
+ (var-lines
+ (org-babel-variable-assignments:lua params)))
+ (org-babel-comint-in-buffer session
+ (mapc (lambda (var)
+ (end-of-line 1) (insert var) (comint-send-input)
+ (org-babel-comint-wait-for-output session)) var-lines))
+ session))
+
+(defun org-babel-load-session:lua (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:lua session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+;; helper functions
+
+(defun org-babel-variable-assignments:lua (params)
+ "Return a list of Lua statements assigning the block's variables."
+ (mapcar
+ (lambda (pair)
+ (format "%s=%s"
+ (car pair)
+ (org-babel-lua-var-to-lua (cdr pair))))
+ (org-babel--get-vars params)))
+
+(defun org-babel-lua-var-to-lua (var)
+ "Convert an elisp value to a lua variable.
+Convert an elisp value, VAR, into a string of lua source code
+specifying a variable of the same value."
+ (if (listp var)
+ (if (and (= 1 (length var)) (not (listp (car var))))
+ (org-babel-lua-var-to-lua (car var))
+ (if (and
+ (= 2 (length var))
+ (not (listp (car var))))
+ (concat
+ (substring-no-properties (car var))
+ "="
+ (org-babel-lua-var-to-lua (cdr var)))
+ (concat "{" (mapconcat #'org-babel-lua-var-to-lua var ", ") "}")))
+ (if (eq var 'hline)
+ org-babel-lua-hline-to
+ (format
+ (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
+ (if (stringp var) (substring-no-properties var) var)))))
+
+(defun org-babel-lua-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If the results look like a list or tuple, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (let ((res (org-babel-script-escape results)))
+ (if (listp res)
+ (mapcar (lambda (el) (if (eq el 'None)
+ org-babel-lua-None-to el))
+ res)
+ res)))
+
+(defvar org-babel-lua-buffers '((:default . "*Lua*")))
+
+(defun org-babel-lua-session-buffer (session)
+ "Return the buffer associated with SESSION."
+ (cdr (assoc session org-babel-lua-buffers)))
+
+(defun org-babel-lua-with-earmuffs (session)
+ (let ((name (if (stringp session) session (format "%s" session))))
+ (if (and (string= "*" (substring name 0 1))
+ (string= "*" (substring name (- (length name) 1))))
+ name
+ (format "*%s*" name))))
+
+(defun org-babel-lua-without-earmuffs (session)
+ (let ((name (if (stringp session) session (format "%s" session))))
+ (if (and (string= "*" (substring name 0 1))
+ (string= "*" (substring name (- (length name) 1))))
+ (substring name 1 (- (length name) 1))
+ name)))
+
+(defvar lua-default-interpreter)
+(defvar lua-which-bufname)
+(defvar lua-shell-buffer-name)
+(defun org-babel-lua-initiate-session-by-key (&optional session)
+ "Initiate a lua session.
+If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session."
+ ;; (require org-babel-lua-mode)
+ (save-window-excursion
+ (let* ((session (if session (intern session) :default))
+ (lua-buffer (org-babel-lua-session-buffer session))
+ ;; (cmd (if (member system-type '(cygwin windows-nt ms-dos))
+ ;; (concat org-babel-lua-command " -i")
+ ;; org-babel-lua-command))
+ )
+ (cond
+ ((and (eq 'lua-mode org-babel-lua-mode)
+ (fboundp 'lua-start-process)) ; lua-mode.el
+ ;; Make sure that lua-which-bufname is initialized, as otherwise
+ ;; it will be overwritten the first time a Lua buffer is
+ ;; created.
+ ;;(lua-toggle-shells lua-default-interpreter)
+ ;; `lua-shell' creates a buffer whose name is the value of
+ ;; `lua-which-bufname' with '*'s at the beginning and end
+ (let* ((bufname (if (and lua-buffer (buffer-live-p lua-buffer))
+ (replace-regexp-in-string ;; zap surrounding *
+ "^\\*\\([^*]+\\)\\*$" "\\1" (buffer-name lua-buffer))
+ (concat "Lua-" (symbol-name session))))
+ (lua-which-bufname bufname))
+ (lua-start-process)
+ (setq lua-buffer (org-babel-lua-with-earmuffs bufname))))
+ (t
+ (error "No function available for running an inferior Lua")))
+ (setq org-babel-lua-buffers
+ (cons (cons session lua-buffer)
+ (assq-delete-all session org-babel-lua-buffers)))
+ session)))
+
+(defun org-babel-lua-initiate-session (&optional session _params)
+ "Create a session named SESSION according to PARAMS."
+ (unless (string= session "none")
+ (error "Sessions currently not supported, work in progress")
+ (org-babel-lua-session-buffer
+ (org-babel-lua-initiate-session-by-key session))))
+
+(defvar org-babel-lua-eoe-indicator "--eoe"
+ "A string to indicate that evaluation has completed.")
+
+(defvar org-babel-lua-wrapper-method
+ "
+function main()
+%s
+end
+
+fd=io.open(\"%s\", \"w\")
+fd:write( main() )
+fd:close()")
+(defvar org-babel-lua-pp-wrapper-method
+ "
+-- table to string
+function t2s(t, indent)
+ if indent == nil then
+ indent = \"\"
+ end
+ if type(t) == \"table\" then
+ ts = \"\"
+ for k,v in pairs(t) do
+ if type(v) == \"table\" then
+ ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" ..
+ t2s(v, indent .. \" \")
+ else
+ ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" ..
+ t2s(v, indent .. \" \") .. \"\\n\"
+ end
+ end
+ return ts
+ else
+ return tostring(t)
+ end
+end
+
+
+function main()
+%s
+end
+
+fd=io.open(\"%s\", \"w\")
+fd:write(t2s(main()))
+fd:close()")
+
+(defun org-babel-lua-evaluate
+ (session body &optional result-type result-params preamble)
+ "Evaluate BODY as Lua code."
+ (if session
+ (org-babel-lua-evaluate-session
+ session body result-type result-params)
+ (org-babel-lua-evaluate-external-process
+ body result-type result-params preamble)))
+
+(defun org-babel-lua-evaluate-external-process
+ (body &optional result-type result-params preamble)
+ "Evaluate BODY in external lua process.
+If RESULT-TYPE equals 'output then return standard output as a
+string. If RESULT-TYPE equals 'value then return the value of the
+last statement in BODY, as elisp."
+ (let ((raw
+ (pcase result-type
+ (`output (org-babel-eval org-babel-lua-command
+ (concat (if preamble (concat preamble "\n"))
+ body)))
+ (`value (let ((tmp-file (org-babel-temp-file "lua-")))
+ (org-babel-eval
+ org-babel-lua-command
+ (concat
+ (if preamble (concat preamble "\n") "")
+ (format
+ (if (member "pp" result-params)
+ org-babel-lua-pp-wrapper-method
+ org-babel-lua-wrapper-method)
+ (mapconcat
+ (lambda (line) (format "\t%s" line))
+ (split-string
+ (org-remove-indentation
+ (org-trim body))
+ "[\r\n]") "\n")
+ (org-babel-process-file-name tmp-file 'noquote))))
+ (org-babel-eval-read-file tmp-file))))))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-lua-table-or-string (org-trim raw)))))
+
+(defun org-babel-lua-evaluate-session
+ (session body &optional result-type result-params)
+ "Pass BODY to the Lua process in SESSION.
+If RESULT-TYPE equals 'output then return standard output as a
+string. If RESULT-TYPE equals 'value then return the value of the
+last statement in BODY, as elisp."
+ (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5)))
+ (dump-last-value
+ (lambda
+ (tmp-file pp)
+ (mapc
+ (lambda (statement) (insert statement) (funcall send-wait))
+ (if pp
+ (list
+ "-- table to string
+function t2s(t, indent)
+ if indent == nil then
+ indent = \"\"
+ end
+ if type(t) == \"table\" then
+ ts = \"\"
+ for k,v in pairs(t) do
+ if type(v) == \"table\" then
+ ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" ..
+ t2s(v, indent .. \" \")
+ else
+ ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" ..
+ t2s(v, indent .. \" \") .. \"\\n\"
+ end
+ end
+ return ts
+ else
+ return tostring(t)
+ end
+end
+"
+ (concat "fd:write(_))
+fd:close()"
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (list (format "fd=io.open(\"%s\", \"w\")
+fd:write( _ )
+fd:close()"
+ (org-babel-process-file-name tmp-file
+ 'noquote)))))))
+ (input-body (lambda (body)
+ (mapc (lambda (line) (insert line) (funcall send-wait))
+ (split-string body "[\r\n]"))
+ (funcall send-wait)))
+ (results
+ (pcase result-type
+ (`output
+ (mapconcat
+ #'org-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-lua-eoe-indicator t body)
+ (funcall input-body body)
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-lua-eoe-indicator)
+ (funcall send-wait))
+ 2) "\n"))
+ (`value
+ (let ((tmp-file (org-babel-temp-file "lua-")))
+ (org-babel-comint-with-output
+ (session org-babel-lua-eoe-indicator nil body)
+ (let ((comint-process-echoes nil))
+ (funcall input-body body)
+ (funcall dump-last-value tmp-file
+ (member "pp" result-params))
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-lua-eoe-indicator)
+ (funcall send-wait)))
+ (org-babel-eval-read-file tmp-file))))))
+ (unless (string= (substring org-babel-lua-eoe-indicator 1 -1) results)
+ (org-babel-result-cond result-params
+ results
+ (org-babel-lua-table-or-string results)))))
+
+(defun org-babel-lua-read-string (string)
+ "Strip 's from around Lua string."
+ (org-unbracket-string "'" "'" string))
+
+(provide 'ob-lua)
+
+
+
+;;; ob-lua.el ends here
diff --git a/lisp/ob-makefile.el b/lisp/ob-makefile.el
index 8f33773..69c6e51 100644
--- a/lisp/ob-makefile.el
+++ b/lisp/ob-makefile.el
@@ -1,4 +1,4 @@
-;;; ob-makefile.el --- org-babel functions for makefile evaluation
+;;; ob-makefile.el --- Babel Functions for Makefile -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -24,19 +24,19 @@
;;; Commentary:
-;; This file exists solely for tangling a Makefile from org-mode files.
+;; This file exists solely for tangling a Makefile from Org files.
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:makefile '())
-(defun org-babel-execute:makefile (body params)
+(defun org-babel-execute:makefile (body _params)
"Execute a block of makefile code.
This function is called by `org-babel-execute-src-block'."
body)
-(defun org-babel-prep-session:makefile (session params)
+(defun org-babel-prep-session:makefile (_session _params)
"Return an error if the :session header argument is set. Make
does not support sessions."
(error "Makefile sessions are nonsensical"))
diff --git a/lisp/ob-matlab.el b/lisp/ob-matlab.el
index 69b4c45..0d3909d 100644
--- a/lisp/ob-matlab.el
+++ b/lisp/ob-matlab.el
@@ -1,4 +1,4 @@
-;;; ob-matlab.el --- org-babel support for matlab evaluation
+;;; ob-matlab.el --- Babel support for Matlab -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
diff --git a/lisp/ob-maxima.el b/lisp/ob-maxima.el
index 9b6cee6..4d16156 100644
--- a/lisp/ob-maxima.el
+++ b/lisp/ob-maxima.el
@@ -1,4 +1,4 @@
-;;; ob-maxima.el --- org-babel functions for maxima evaluation
+;;; ob-maxima.el --- Babel Functions for Maxima -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -48,7 +48,7 @@
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapconcat 'identity
(list
;; graphic output
@@ -69,9 +69,9 @@
"Execute a block of Maxima entries with org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
- (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (let ((result-params (split-string (or (cdr (assq :results params)) "")))
(result
- (let* ((cmdline (or (cdr (assoc :cmdline params)) ""))
+ (let* ((cmdline (or (cdr (assq :cmdline params)) ""))
(in-file (org-babel-temp-file "maxima-" ".max"))
(cmd (format "%s --very-quiet -r 'batchload(%S)$' %s"
org-babel-maxima-command in-file cmdline)))
@@ -98,7 +98,7 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-import-elisp-from-file tmp-file))))))
-(defun org-babel-prep-session:maxima (session params)
+(defun org-babel-prep-session:maxima (_session _params)
(error "Maxima does not support sessions"))
(defun org-babel-maxima-var-to-maxima (pair)
diff --git a/lisp/ob-mscgen.el b/lisp/ob-mscgen.el
index dae4c65..f53b09f 100644
--- a/lisp/ob-mscgen.el
+++ b/lisp/ob-mscgen.el
@@ -1,4 +1,4 @@
-;;; ob-msc.el --- org-babel functions for mscgen evaluation
+;;; ob-msc.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -65,15 +65,15 @@
This function is called by `org-babel-execute-src-block'.
Default filetype is png. Modify by setting :filetype parameter to
mscgen supported formats."
- (let* ((out-file (or (cdr (assoc :file params)) "output.png" ))
- (filetype (or (cdr (assoc :filetype params)) "png" )))
- (unless (cdr (assoc :file params))
+ (let* ((out-file (or (cdr (assq :file params)) "output.png" ))
+ (filetype (or (cdr (assq :filetype params)) "png" )))
+ (unless (cdr (assq :file params))
(error "
ERROR: no output file specified. Add \":file name.png\" to the src header"))
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:mscgen (session params)
+(defun org-babel-prep-session:mscgen (_session _params)
"Raise an error because Mscgen doesn't support sessions."
(error "Mscgen does not support sessions"))
diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el
index eadc388..4c9d295 100644
--- a/lisp/ob-ocaml.el
+++ b/lisp/ob-ocaml.el
@@ -1,4 +1,4 @@
-;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
+;;; ob-ocaml.el --- Babel Functions for Ocaml -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -37,11 +37,11 @@
;;; Code:
(require 'ob)
(require 'comint)
-(eval-when-compile (require 'cl))
(declare-function tuareg-run-caml "ext:tuareg" ())
(declare-function tuareg-run-ocaml "ext:tuareg" ())
(declare-function tuareg-interactive-send-input "ext:tuareg" ())
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml"))
@@ -60,14 +60,13 @@
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with Babel."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (full-body (org-babel-expand-body:generic
+ (let* ((full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:ocaml params)))
(session (org-babel-prep-session:ocaml
- (cdr (assoc :session params)) params))
+ (cdr (assq :session params)) params))
(raw (org-babel-comint-with-output
- (session org-babel-ocaml-eoe-output t full-body)
+ (session org-babel-ocaml-eoe-output nil full-body)
(insert
(concat
(org-babel-chomp full-body) ";;\n"
@@ -80,32 +79,31 @@
(progn (setq out nil) line)
(when (string-match re line)
(progn (setq out t) nil))))
- (mapcar #'org-babel-trim (reverse raw)))))))
- (raw (org-babel-trim clean))
- (result-params (cdr (assoc :result-params params)))
- (parsed
- (string-match
- "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$"
+ (mapcar #'org-trim (reverse raw)))))))
+ (raw (org-trim clean))
+ (result-params (cdr (assq :result-params params))))
+ (string-match
+ "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$"
+ raw)
+ (let ((output (match-string 1 raw))
+ (type (match-string 3 raw))
+ (value (match-string 5 raw)))
+ (org-babel-reassemble-table
+ (org-babel-result-cond result-params
+ (cond
+ ((member "verbatim" result-params) raw)
+ ((member "output" result-params) output)
+ (t raw))
+ (if (and value type)
+ (org-babel-ocaml-parse-output value type)
raw))
- (output (match-string 1 raw))
- (type (match-string 3 raw))
- (value (match-string 5 raw)))
- (org-babel-reassemble-table
- (org-babel-result-cond result-params
- (cond
- ((member "verbatim" result-params) raw)
- ((member "output" result-params) output)
- (t raw))
- (if (and value type)
- (org-babel-ocaml-parse-output value type)
- raw))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (org-babel-pick-name
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
+ (org-babel-pick-name
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defvar tuareg-interactive-buffer-name)
-(defun org-babel-prep-session:ocaml (session params)
+(defun org-babel-prep-session:ocaml (session _params)
"Prepare SESSION according to the header arguments in PARAMS."
(require 'tuareg)
(let ((tuareg-interactive-buffer-name (if (and (not (string= session "none"))
@@ -123,7 +121,7 @@
(mapcar
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-ocaml-elisp-to-ocaml (val)
"Return a string of ocaml code which evaluates to VAL."
diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el
index fba5a01..09b4092 100644
--- a/lisp/ob-octave.el
+++ b/lisp/ob-octave.el
@@ -1,4 +1,4 @@
-;;; ob-octave.el --- org-babel functions for octave and matlab evaluation
+;;; ob-octave.el --- Babel Functions for Octave and Matlab -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -30,10 +30,10 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function matlab-shell "ext:matlab-mode")
(declare-function matlab-shell-run-region "ext:matlab-mode")
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-default-header-args:matlab '())
(defvar org-babel-default-header-args:octave '())
@@ -74,11 +74,8 @@ end")
(let* ((session
(funcall (intern (format "org-babel-%s-initiate-session"
(if matlabp "matlab" "octave")))
- (cdr (assoc :session params)) params))
- (vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
- (out-file (cdr (assoc :file params)))
+ (cdr (assq :session params)) params))
+ (result-type (cdr (assq :result-type params)))
(full-body
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:octave params)))
@@ -99,9 +96,9 @@ end")
(org-babel-reassemble-table
result
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defun org-babel-prep-session:matlab (session params)
"Prepare SESSION according to PARAMS."
@@ -114,7 +111,7 @@ end")
(format "%s=%s;"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defalias 'org-babel-variable-assignments:matlab
'org-babel-variable-assignments:octave)
@@ -148,7 +145,7 @@ If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
(org-babel-octave-initiate-session session params 'matlab))
-(defun org-babel-octave-initiate-session (&optional session params matlabp)
+(defun org-babel-octave-initiate-session (&optional session _params matlabp)
"Create an octave inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
@@ -180,9 +177,9 @@ value of the last statement in BODY, as elisp."
(let ((cmd (if matlabp
org-babel-matlab-shell-command
org-babel-octave-shell-command)))
- (case result-type
- (output (org-babel-eval cmd body))
- (value (let ((tmp-file (org-babel-temp-file "octave-")))
+ (pcase result-type
+ (`output (org-babel-eval cmd body))
+ (`value (let ((tmp-file (org-babel-temp-file "octave-")))
(org-babel-eval
cmd
(format org-babel-octave-wrapper-method body
@@ -191,17 +188,17 @@ value of the last statement in BODY, as elisp."
(org-babel-octave-import-elisp-from-file tmp-file))))))
(defun org-babel-octave-evaluate-session
- (session body result-type &optional matlabp)
+ (session body result-type &optional matlabp)
"Evaluate BODY in SESSION."
(let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-")))
(wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-"))
(full-body
- (case result-type
- (output
+ (pcase result-type
+ (`output
(mapconcat
#'org-babel-chomp
(list body org-babel-octave-eoe-indicator) "\n"))
- (value
+ (`value
(if (and matlabp org-babel-matlab-with-emacs-link)
(concat
(format org-babel-matlab-emacs-link-wrapper-method
@@ -234,21 +231,20 @@ value of the last statement in BODY, as elisp."
org-babel-octave-eoe-output)
t full-body)
(insert full-body) (comint-send-input nil t)))) results)
- (case result-type
- (value
+ (pcase result-type
+ (`value
(org-babel-octave-import-elisp-from-file tmp-file))
- (output
- (progn
- (setq results
- (if matlabp
- (cdr (reverse (delq "" (mapcar
- #'org-babel-octave-read-string
- (mapcar #'org-babel-trim raw)))))
- (cdr (member org-babel-octave-eoe-output
- (reverse (mapcar
- #'org-babel-octave-read-string
- (mapcar #'org-babel-trim raw)))))))
- (mapconcat #'identity (reverse results) "\n"))))))
+ (`output
+ (setq results
+ (if matlabp
+ (cdr (reverse (delq "" (mapcar
+ #'org-babel-strip-quotes
+ (mapcar #'org-trim raw)))))
+ (cdr (member org-babel-octave-eoe-output
+ (reverse (mapcar
+ #'org-babel-strip-quotes
+ (mapcar #'org-trim raw)))))))
+ (mapconcat #'identity (reverse results) "\n")))))
(defun org-babel-octave-import-elisp-from-file (file-name)
"Import data from FILE-NAME.
@@ -263,12 +259,6 @@ This removes initial blank and comment lines and then calls
(delete-region beg end)))
(org-babel-import-elisp-from-file temp-file '(16))))
-(defun org-babel-octave-read-string (string)
- "Strip \\\"s from around octave string."
- (if (string-match "^\"\\([^\000]+\\)\"$" string)
- (match-string 1 string)
- string))
-
(provide 'ob-octave)
diff --git a/lisp/ob-org.el b/lisp/ob-org.el
index af5b548..580d2b0 100644
--- a/lisp/ob-org.el
+++ b/lisp/ob-org.el
@@ -1,4 +1,4 @@
-;;; ob-org.el --- org-babel functions for org code block evaluation
+;;; ob-org.el --- Babel Functions for Org Code Blocks -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -41,7 +41,7 @@
"Default header inserted during export of org blocks.")
(defun org-babel-expand-body:org (body params)
- (dolist (var (mapcar #'cdr (org-babel-get-header params :var)))
+ (dolist (var (org-babel--get-vars params))
(setq body (replace-regexp-in-string
(regexp-quote (format "$%s" (car var)))
(format "%s" (cdr var))
@@ -51,7 +51,7 @@
(defun org-babel-execute:org (body params)
"Execute a block of Org code with.
This function is called by `org-babel-execute-src-block'."
- (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (let ((result-params (split-string (or (cdr (assq :results params)) "")))
(body (org-babel-expand-body:org
(replace-regexp-in-string "^," "" body) params)))
(cond
@@ -61,7 +61,7 @@ This function is called by `org-babel-execute-src-block'."
((member "ascii" result-params) (org-export-string-as body 'ascii t))
(t body))))
-(defun org-babel-prep-session:org (session params)
+(defun org-babel-prep-session:org (_session _params)
"Return an error because org does not support sessions."
(error "Org does not support sessions"))
diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el
index 3a63837..a1aadbb 100644
--- a/lisp/ob-perl.el
+++ b/lisp/ob-perl.el
@@ -1,4 +1,4 @@
-;;; ob-perl.el --- org-babel functions for perl evaluation
+;;; ob-perl.el --- Babel Functions for Perl -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -28,7 +28,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl"))
@@ -41,20 +40,20 @@
(defun org-babel-execute:perl (body params)
"Execute a block of Perl code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((session (cdr (assoc :session params)))
- (result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((session (cdr (assq :session params)))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:perl params)))
(session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-perl-evaluate session full-body result-type result-params)
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
-(defun org-babel-prep-session:perl (session params)
+(defun org-babel-prep-session:perl (_session _params)
"Prepare SESSION according to the header arguments in PARAMS."
(error "Sessions are not supported for Perl"))
@@ -63,7 +62,7 @@ This function is called by `org-babel-execute-src-block'."
(mapcar
(lambda (pair)
(org-babel-perl--var-to-perl (cdr pair) (car pair)))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
;; helper functions
@@ -76,7 +75,7 @@ This function is called by `org-babel-execute-src-block'."
The elisp value, VAR, is converted to a string of perl source code
specifying a var of the same value."
(if varn
- (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix)
+ (let ((org-babel-perl--lvl 0) (lvar (listp var)))
(concat "my $" (symbol-name varn) "=" (when lvar "\n")
(org-babel-perl--var-to-perl var)
";\n"))
@@ -92,7 +91,7 @@ specifying a var of the same value."
(defvar org-babel-perl-buffers '(:default . nil))
-(defun org-babel-perl-initiate-session (&optional session params)
+(defun org-babel-perl-initiate-session (&optional _session _params)
"Return nil because sessions are not supported by perl."
nil)
@@ -136,13 +135,13 @@ return the value of the last statement in BODY, as elisp."
(tmp-babel-file (org-babel-process-file-name
tmp-file 'noquote)))
(let ((results
- (case result-type
- (output
+ (pcase result-type
+ (`output
(with-temp-file tmp-file
(insert
(org-babel-eval org-babel-perl-command body))
(buffer-string)))
- (value
+ (`value
(org-babel-eval org-babel-perl-command
(format org-babel-perl-wrapper-method
body tmp-babel-file))))))
diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el
index 2a4ddc0..348b1f6 100644
--- a/lisp/ob-picolisp.el
+++ b/lisp/ob-picolisp.el
@@ -1,4 +1,4 @@
-;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
+;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -55,7 +55,6 @@
;;; Code:
(require 'ob)
(require 'comint)
-(eval-when-compile (require 'cl))
(declare-function run-picolisp "ext:inferior-picolisp" (cmd))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
@@ -80,9 +79,9 @@
(defun org-babel-expand-body:picolisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
- (print-level nil) (print-length nil))
+ (let ((vars (org-babel--get-vars params))
+ (print-level nil)
+ (print-length nil))
(if (> (length vars) 0)
(concat "(prog (let ("
(mapconcat
@@ -100,12 +99,11 @@
(message "executing Picolisp source code block")
(let* (
;; Name of the session or "none".
- (session-name (cdr (assoc :session params)))
+ (session-name (cdr (assq :session params)))
;; Set the session if the session variable is non-nil.
(session (org-babel-picolisp-initiate-session session-name))
;; Either OUTPUT or VALUE which should behave as described above.
- (result-type (cdr (assoc :result-type params)))
- (result-params (cdr (assoc :result-params params)))
+ (result-params (cdr (assq :result-params params)))
;; Expand the body with `org-babel-expand-body:picolisp'.
(full-body (org-babel-expand-body:picolisp body params))
;; Wrap body appropriately for the type of evaluation and results.
diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el
index 9a0604c..9ce65a9 100644
--- a/lisp/ob-plantuml.el
+++ b/lisp/ob-plantuml.el
@@ -1,4 +1,4 @@
-;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
+;;; ob-plantuml.el --- Babel Functions for Plantuml -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -49,21 +49,36 @@
(defun org-babel-execute:plantuml (body params)
"Execute a block of plantuml code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (out-file (or (cdr (assoc :file params))
+ (let* ((out-file (or (cdr (assq :file params))
(error "PlantUML requires a \":file\" header argument")))
- (cmdline (cdr (assoc :cmdline params)))
+ (cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
- (java (or (cdr (assoc :java params)) ""))
+ (java (or (cdr (assq :java params)) ""))
(cmd (if (string= "" org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set")
(concat "java " java " -jar "
(shell-quote-argument
(expand-file-name org-plantuml-jar-path))
+ (if (string= (file-name-extension out-file) "png")
+ " -tpng" "")
(if (string= (file-name-extension out-file) "svg")
" -tsvg" "")
(if (string= (file-name-extension out-file) "eps")
" -teps" "")
+ (if (string= (file-name-extension out-file) "pdf")
+ " -tpdf" "")
+ (if (string= (file-name-extension out-file) "vdx")
+ " -tvdx" "")
+ (if (string= (file-name-extension out-file) "xmi")
+ " -txmi" "")
+ (if (string= (file-name-extension out-file) "scxml")
+ " -tscxml" "")
+ (if (string= (file-name-extension out-file) "html")
+ " -thtml" "")
+ (if (string= (file-name-extension out-file) "txt")
+ " -ttxt" "")
+ (if (string= (file-name-extension out-file) "utxt")
+ " -utxt" "")
" -p " cmdline " < "
(org-babel-process-file-name in-file)
" > "
@@ -74,7 +89,7 @@ This function is called by `org-babel-execute-src-block'."
(message "%s" cmd) (org-babel-eval cmd "")
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:plantuml (session params)
+(defun org-babel-prep-session:plantuml (_session _params)
"Return an error because plantuml does not support sessions."
(error "Plantuml does not support sessions"))
diff --git a/lisp/ob-processing.el b/lisp/ob-processing.el
index 2410402..e1801e2 100644
--- a/lisp/ob-processing.el
+++ b/lisp/ob-processing.el
@@ -1,4 +1,4 @@
-;;; ob-processing.el --- Babel functions for evaluation of processing
+;;; ob-processing.el --- Babel functions for processing -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
@@ -52,7 +52,6 @@
;;; Code:
(require 'ob)
(require 'sha1)
-(eval-when-compile (require 'cl))
(declare-function processing-sketch-run "ext:processing-mode" ())
@@ -96,7 +95,7 @@
(progn
(setq sketch-dir-candidate
(make-temp-file "processing" t))
- (when (org-string-match-p
+ (when (string-match-p
"-"
(file-name-nondirectory sketch-dir-candidate))
(delete-directory sketch-dir-candidate)
@@ -134,7 +133,7 @@ This function is called by `org-babel-execute-src-block'."
sketch-canvas-id
"\"></canvas>"))))
-(defun org-babel-prep-session:processing (session params)
+(defun org-babel-prep-session:processing (_session _params)
"Return an error if the :session header argument is set.
Processing does not support sessions"
(error "Processing does not support sessions"))
@@ -142,7 +141,7 @@ Processing does not support sessions"
(defun org-babel-variable-assignments:processing (params)
"Return list of processing statements assigning the block's variables."
(mapcar #'org-babel-processing-var-to-processing
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-processing-var-to-processing (pair)
"Convert an elisp value into a Processing variable.
@@ -179,17 +178,16 @@ a variable of the same value."
DATA is a list. Return type as a symbol.
-The type is `String' if any element in DATA is
-a string. Otherwise, it is either `float', if some elements are
-floats, or `int'."
- (let* ((type 'int)
- find-type ; For byte-compiler.
- (find-type
- (lambda (row)
- (dolist (e row type)
- (cond ((listp e) (setq type (funcall find-type e)))
- ((stringp e) (throw 'exit 'String))
- ((floatp e) (setq type 'float)))))))
+The type is `String' if any element in DATA is a string.
+Otherwise, it is either `float', if some elements are floats, or
+`int'."
+ (letrec ((type 'int)
+ (find-type
+ (lambda (row)
+ (dolist (e row type)
+ (cond ((listp e) (setq type (funcall find-type e)))
+ ((stringp e) (throw 'exit 'String))
+ ((floatp e) (setq type 'float)))))))
(catch 'exit (funcall find-type data))))
(provide 'ob-processing)
diff --git a/lisp/ob-python.el b/lisp/ob-python.el
index 1932e61..05f2dbb 100644
--- a/lisp/ob-python.el
+++ b/lisp/ob-python.el
@@ -1,4 +1,4 @@
-;;; ob-python.el --- org-babel functions for python evaluation
+;;; ob-python.el --- Babel Functions for Python -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -28,12 +28,12 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function org-remove-indentation "org" )
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function py-shell "ext:python-mode" (&optional argprompt))
(declare-function py-toggle-shells "ext:python-mode" (arg))
-(declare-function run-python "ext:python" (cmd &optional dedicated show))
+(declare-function run-python "ext:python" (&optional cmd dedicated show))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
@@ -48,7 +48,7 @@
:type 'string)
(defcustom org-babel-python-mode
- (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python)
+ (if (featurep 'python-mode) 'python-mode 'python)
"Preferred python mode for use in running python interactively.
This will typically be either `python' or `python-mode'."
:group 'org-babel
@@ -74,14 +74,14 @@ This will typically be either `python' or `python-mode'."
"Execute a block of Python code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-python-initiate-session
- (cdr (assoc :session params))))
- (result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
+ (cdr (assq :session params))))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
(return-val (when (and (eq result-type 'value) (not session))
- (cdr (assoc :return params))))
- (preamble (cdr (assoc :preamble params)))
+ (cdr (assq :return params))))
+ (preamble (cdr (assq :preamble params)))
(org-babel-python-command
- (or (cdr (assoc :python params)) org-babel-python-command))
+ (or (cdr (assq :python params)) org-babel-python-command))
(full-body
(org-babel-expand-body:generic
(concat body (if return-val (format "\nreturn %s" return-val) ""))
@@ -90,10 +90,10 @@ This function is called by `org-babel-execute-src-block'."
session full-body result-type result-params preamble)))
(org-babel-reassemble-table
result
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params))))))
(defun org-babel-prep-session:python (session params)
"Prepare SESSION according to the header arguments in PARAMS.
@@ -125,7 +125,7 @@ VARS contains resolved variable references"
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-python-var-to-python (var)
"Convert an elisp value to a python variable.
@@ -133,7 +133,7 @@ Convert an elisp value, VAR, into a string of python source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]")
- (if (equal var 'hline)
+ (if (eq var 'hline)
org-babel-python-hline-to
(format
(if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
@@ -145,7 +145,7 @@ If the results look like a list or tuple, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(let ((res (org-babel-script-escape results)))
(if (listp res)
- (mapcar (lambda (el) (if (equal el 'None)
+ (mapcar (lambda (el) (if (eq el 'None)
org-babel-python-None-to el))
res)
res)))
@@ -216,7 +216,7 @@ then create. Return the initialized session."
(assq-delete-all session org-babel-python-buffers)))
session)))
-(defun org-babel-python-initiate-session (&optional session params)
+(defun org-babel-python-initiate-session (&optional session _params)
"Create a session named SESSION according to PARAMS."
(unless (string= session "none")
(org-babel-python-session-buffer
@@ -248,36 +248,35 @@ open('%s', 'w').write( pprint.pformat(main()) )")
body result-type result-params preamble)))
(defun org-babel-python-evaluate-external-process
- (body &optional result-type result-params preamble)
+ (body &optional result-type result-params preamble)
"Evaluate BODY in external python process.
If RESULT-TYPE equals `output' then return standard output as a
string. If RESULT-TYPE equals `value' then return the value of the
last statement in BODY, as elisp."
(let ((raw
- (case result-type
- (output (org-babel-eval org-babel-python-command
- (concat (if preamble (concat preamble "\n"))
- body)))
- (value (let ((tmp-file (org-babel-temp-file "python-")))
- (org-babel-eval
- org-babel-python-command
- (concat
- (if preamble (concat preamble "\n") "")
- (format
- (if (member "pp" result-params)
- org-babel-python-pp-wrapper-method
- org-babel-python-wrapper-method)
- (mapconcat
- (lambda (line) (format "\t%s" line))
- (split-string
- (org-remove-indentation
- (org-babel-trim body))
- "[\r\n]") "\n")
- (org-babel-process-file-name tmp-file 'noquote))))
- (org-babel-eval-read-file tmp-file))))))
+ (pcase result-type
+ (`output (org-babel-eval org-babel-python-command
+ (concat (if preamble (concat preamble "\n"))
+ body)))
+ (`value (let ((tmp-file (org-babel-temp-file "python-")))
+ (org-babel-eval
+ org-babel-python-command
+ (concat
+ (if preamble (concat preamble "\n") "")
+ (format
+ (if (member "pp" result-params)
+ org-babel-python-pp-wrapper-method
+ org-babel-python-wrapper-method)
+ (mapconcat
+ (lambda (line) (format "\t%s" line))
+ (split-string (org-remove-indentation (org-trim body))
+ "[\r\n]")
+ "\n")
+ (org-babel-process-file-name tmp-file 'noquote))))
+ (org-babel-eval-read-file tmp-file))))))
(org-babel-result-cond result-params
raw
- (org-babel-python-table-or-string (org-babel-trim raw)))))
+ (org-babel-python-table-or-string (org-trim raw)))))
(defun org-babel-python-evaluate-session
(session body &optional result-type result-params)
@@ -304,10 +303,10 @@ last statement in BODY, as elisp."
(split-string body "[\r\n]"))
(funcall send-wait)))
(results
- (case result-type
- (output
+ (pcase result-type
+ (`output
(mapconcat
- #'org-babel-trim
+ #'org-trim
(butlast
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
@@ -316,7 +315,7 @@ last statement in BODY, as elisp."
(insert org-babel-python-eoe-indicator)
(funcall send-wait))
2) "\n"))
- (value
+ (`value
(let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator nil body)
@@ -335,8 +334,9 @@ last statement in BODY, as elisp."
(defun org-babel-python-read-string (string)
"Strip \\='s from around Python string."
- (if (string-match "^'\\([^\000]+\\)'$" string)
- (match-string 1 string)
+ (if (and (string-prefix-p "'" string)
+ (string-suffix-p "'" string))
+ (substring string 1 -1)
string))
(provide 'ob-python)
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
index 95eb114..c109d89 100644
--- a/lisp/ob-ref.el
+++ b/lisp/ob-ref.el
@@ -1,4 +1,4 @@
-;;; ob-ref.el --- org-babel functions for referencing external data
+;;; ob-ref.el --- Babel Functions for Referencing External Data -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -50,23 +50,20 @@
;;; Code:
(require 'ob-core)
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
+(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
(declare-function org-end-of-meta-data "org" (&optional full))
(declare-function org-find-property "org" (property &optional value))
-(declare-function org-remove-if-not "org" (predicate seq))
-(declare-function org-at-table-p "org" (&optional table-type))
-(declare-function org-count "org" (CL-ITEM CL-SEQ))
-(declare-function org-at-item-p "org-list" ())
-(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
(declare-function org-id-find-id-file "org-id" (id))
+(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-narrow-to-subtree "org" ())
(declare-function org-show-context "org" (&optional key))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
-(declare-function org-babel-lob-execute "ob-lob" (info))
-(declare-function org-babel-lob-get-info "ob-lob" nil)
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-ref-split-regexp
"[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
@@ -94,7 +91,8 @@ the variable."
org-babel-current-src-block-location)))
(org-babel-read ref))))
(if (equal out ref)
- (if (string-match "^\".*\"$" ref)
+ (if (and (string-prefix-p "\"" ref)
+ (string-suffix-p "\"" ref))
(read ref)
(org-babel-ref-resolve ref))
out))))))
@@ -106,7 +104,7 @@ the variable."
(m (when file (org-id-find-id-in-file id file 'marker))))
(when (and file m)
(message "file:%S" file)
- (org-pop-to-buffer-same-window (marker-buffer m))
+ (pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)
@@ -121,7 +119,6 @@ the variable."
(point))
(point-max))))
-(defvar org-babel-lob-one-liner-regexp)
(defvar org-babel-library-of-babel)
(defun org-babel-ref-resolve (ref)
"Resolve the reference REF and return its value."
@@ -129,12 +126,12 @@ the variable."
(with-current-buffer (or org-babel-exp-reference-buffer (current-buffer))
(save-excursion
(let ((case-fold-search t)
- type args new-refere new-header-args new-referent result
- lob-info split-file split-ref index index-row index-col id)
+ args new-refere new-header-args new-referent split-file split-ref
+ index)
;; if ref is indexed grab the indices -- beware nested indices
(when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
(let ((str (substring ref 0 (match-beginning 0))))
- (= (org-count ?( str) (org-count ?) str))))
+ (= (cl-count ?( str) (cl-count ?) str))))
(setq index (match-string 1 ref))
(setq ref (substring ref 0 (match-beginning 0))))
;; assign any arguments to pass to source block
@@ -154,71 +151,54 @@ the variable."
(when (string-match "^\\(.+\\):\\(.+\\)$" ref)
(setq split-file (match-string 1 ref))
(setq split-ref (match-string 2 ref))
- (find-file split-file) (setq ref split-ref))
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
- (res-rx (org-babel-named-data-regexp-for-name ref)))
- ;; goto ref in the current buffer
- (or
- ;; check for code blocks
- (re-search-forward src-rx nil t)
- ;; check for named data
- (re-search-forward res-rx nil t)
- ;; check for local or global headlines by id
- (setq id (org-babel-ref-goto-headline-id ref))
- ;; check the Library of Babel
- (setq lob-info (cdr (assoc (intern ref)
- org-babel-library-of-babel)))))
- (unless (or lob-info id) (goto-char (match-beginning 0)))
- ;; ;; TODO: allow searching for names in other buffers
- ;; (setq id-loc (org-id-find ref 'marker)
- ;; buffer (marker-buffer id-loc)
- ;; loc (marker-position id-loc))
- ;; (move-marker id-loc nil)
- (error "Reference `%s' not found in this buffer" ref))
- (cond
- (lob-info (setq type 'lob))
- (id (setq type 'id))
- ((and (looking-at org-babel-src-name-regexp)
- (save-excursion
- (forward-line 1)
- (or (looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp))))
- (setq type 'source-block))
- ((and (looking-at org-babel-src-name-regexp)
- (save-excursion
- (forward-line 1)
- (looking-at org-babel-lob-one-liner-regexp)))
- (setq type 'call-line))
- (t (while (not (setq type (org-babel-ref-at-ref-p)))
- (forward-line 1)
- (beginning-of-line)
- (if (or (= (point) (point-min)) (= (point) (point-max)))
- (error "Reference not found")))))
- (let ((params (append args '((:results . "silent")))))
- (setq result
- (case type
- (results-line (org-babel-read-result))
- (table (org-babel-read-table))
- (list (org-babel-read-list))
- (file (org-babel-read-link))
- (source-block (org-babel-execute-src-block
- nil nil (if org-babel-update-intermediate
- nil params)))
- (call-line (save-excursion
- (forward-line 1)
- (org-babel-lob-execute
- (org-babel-lob-get-info))))
- (lob (org-babel-execute-src-block
- nil lob-info params))
- (id (org-babel-ref-headline-body)))))
- (if (symbolp result)
- (format "%S" result)
- (if (and index (listp result))
- (org-babel-ref-index-list index result)
- result))))))))
+ (find-file split-file)
+ (setq ref split-ref))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let* ((params (append args '((:results . "silent"))))
+ (regexp (org-babel-named-data-regexp-for-name ref))
+ (result
+ (catch :found
+ ;; Check for code blocks or named data.
+ (while (re-search-forward regexp nil t)
+ ;; Ignore COMMENTed headings and orphaned
+ ;; affiliated keywords.
+ (unless (org-in-commented-heading-p)
+ (let ((e (org-element-at-point)))
+ (when (equal (org-element-property :name e) ref)
+ (goto-char
+ (org-element-property :post-affiliated e))
+ (pcase (org-element-type e)
+ (`babel-call
+ (throw :found
+ (org-babel-execute-src-block
+ nil (org-babel-lob-get-info e) params)))
+ (`src-block
+ (throw :found
+ (org-babel-execute-src-block
+ nil nil
+ (and
+ (not org-babel-update-intermediate)
+ params))))
+ ((and (let v (org-babel-read-element e))
+ (guard v))
+ (throw :found v))
+ (_ (error "Reference not found")))))))
+ ;; Check for local or global headlines by ID.
+ (when (org-babel-ref-goto-headline-id ref)
+ (throw :found (org-babel-ref-headline-body)))
+ ;; Check the Library of Babel.
+ (let ((info (cdr (assq (intern ref)
+ org-babel-library-of-babel))))
+ (when info
+ (throw :found
+ (org-babel-execute-src-block nil info params))))
+ (error "Reference `%s' not found in this buffer" ref))))
+ (cond
+ ((symbolp result) (format "%S" result))
+ ((and index (listp result))
+ (org-babel-ref-index-list index result))
+ (t result)))))))))
(defun org-babel-ref-index-list (index lis)
"Return the subset of LIS indexed by INDEX.
@@ -261,21 +241,9 @@ to \"0:-1\"."
(defun org-babel-ref-split-args (arg-string)
"Split ARG-STRING into top-level arguments of balanced parenthesis."
- (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44)))
+ (mapcar #'org-trim (org-babel-balanced-split arg-string 44)))
-(defvar org-bracket-link-regexp)
-(defun org-babel-ref-at-ref-p ()
- "Return the type of reference located at point.
-Return nil if none of the supported reference types are found.
-Supported reference types are tables and source blocks."
- (cond ((org-at-table-p) 'table)
- ((org-at-item-p) 'list)
- ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block)
- ((looking-at org-bracket-link-regexp) 'file)
- ((looking-at org-babel-result-regexp) 'results-line)))
(provide 'ob-ref)
-
-
;;; ob-ref.el ends here
diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el
index 0cc665d..6415f35 100644
--- a/lisp/ob-ruby.el
+++ b/lisp/ob-ruby.el
@@ -1,4 +1,4 @@
-;;; ob-ruby.el --- org-babel functions for ruby evaluation
+;;; ob-ruby.el --- Babel Functions for Ruby -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -37,8 +37,8 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function run-ruby "ext:inf-ruby" (&optional command name))
(declare-function xmp "ext:rcodetools" (&optional option))
@@ -68,16 +68,16 @@
"Execute a block of Ruby code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-ruby-initiate-session
- (cdr (assoc :session params))))
- (result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
+ (cdr (assq :session params))))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:ruby params)))
(result (if (member "xmp" result-params)
(with-temp-buffer
(require 'rcodetools)
(insert full-body)
- (xmp (cdr (assoc :xmp-option params)))
+ (xmp (cdr (assq :xmp-option params)))
(buffer-string))
(org-babel-ruby-evaluate
session full-body result-type result-params))))
@@ -85,10 +85,10 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-result-cond result-params
result
(org-babel-ruby-table-or-string result))
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params))))))
(defun org-babel-prep-session:ruby (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
@@ -121,7 +121,7 @@ This function is called by `org-babel-execute-src-block'."
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-ruby-var-to-ruby (var)
"Convert VAR into a ruby variable.
@@ -129,7 +129,7 @@ Convert an elisp value into a string of ruby source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]")
- (if (equal var 'hline)
+ (if (eq var 'hline)
org-babel-ruby-hline-to
(format "%S" var))))
@@ -139,12 +139,12 @@ If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(let ((res (org-babel-script-escape results)))
(if (listp res)
- (mapcar (lambda (el) (if (equal el 'nil)
- org-babel-ruby-nil-to el))
+ (mapcar (lambda (el) (if (not el)
+ org-babel-ruby-nil-to el))
res)
res)))
-(defun org-babel-ruby-initiate-session (&optional session params)
+(defun org-babel-ruby-initiate-session (&optional session _params)
"Initiate a ruby session.
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session."
@@ -185,26 +185,26 @@ end
")
(defun org-babel-ruby-evaluate
- (buffer body &optional result-type result-params)
+ (buffer body &optional result-type result-params)
"Pass BODY to the Ruby process in BUFFER.
If RESULT-TYPE equals `output' then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals `value' then
return the value of the last statement in BODY, as elisp."
(if (not buffer)
;; external process evaluation
- (case result-type
- (output (org-babel-eval org-babel-ruby-command body))
- (value (let ((tmp-file (org-babel-temp-file "ruby-")))
- (org-babel-eval
- org-babel-ruby-command
- (format (if (member "pp" result-params)
- org-babel-ruby-pp-wrapper-method
- org-babel-ruby-wrapper-method)
- body (org-babel-process-file-name tmp-file 'noquote)))
- (org-babel-eval-read-file tmp-file))))
+ (pcase result-type
+ (`output (org-babel-eval org-babel-ruby-command body))
+ (`value (let ((tmp-file (org-babel-temp-file "ruby-")))
+ (org-babel-eval
+ org-babel-ruby-command
+ (format (if (member "pp" result-params)
+ org-babel-ruby-pp-wrapper-method
+ org-babel-ruby-wrapper-method)
+ body (org-babel-process-file-name tmp-file 'noquote)))
+ (org-babel-eval-read-file tmp-file))))
;; comint session evaluation
- (case result-type
- (output
+ (pcase result-type
+ (`output
(let ((eoe-string (format "puts \"%s\"" org-babel-ruby-eoe-indicator)))
;; Force the session to be ready before the actual session
;; code is run. There is some problem in comint that will
@@ -220,7 +220,7 @@ return the value of the last statement in BODY, as elisp."
(butlast
(split-string
(mapconcat
- #'org-babel-trim
+ #'org-trim
(org-babel-comint-with-output
(buffer org-babel-ruby-eoe-indicator t body)
(mapc
@@ -231,7 +231,7 @@ return the value of the last statement in BODY, as elisp."
"conf.prompt_mode=_org_prompt_mode;conf.echo=true"
eoe-string)))
"\n") "[\r\n]") 4) "\n")))
- (value
+ (`value
(let* ((tmp-file (org-babel-temp-file "ruby-"))
(ppp (or (member "code" result-params)
(member "pp" result-params))))
@@ -254,12 +254,6 @@ return the value of the last statement in BODY, as elisp."
(comint-send-input nil t))
(org-babel-eval-read-file tmp-file))))))
-(defun org-babel-ruby-read-string (string)
- "Strip \\\"s from around a ruby string."
- (if (string-match "^\"\\([^\000]+\\)\"$" string)
- (match-string 1 string)
- string))
-
(provide 'ob-ruby)
diff --git a/lisp/ob-sass.el b/lisp/ob-sass.el
index f675914..53fb45e 100644
--- a/lisp/ob-sass.el
+++ b/lisp/ob-sass.el
@@ -1,4 +1,4 @@
-;;; ob-sass.el --- org-babel functions for the sass css generation language
+;;; ob-sass.el --- Babel Functions for the Sass CSS generation language -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -45,10 +45,9 @@
(defun org-babel-execute:sass (body params)
"Execute a block of Sass code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (file (cdr (assoc :file params)))
+ (let* ((file (cdr (assq :file params)))
(out-file (or file (org-babel-temp-file "sass-out-")))
- (cmdline (cdr (assoc :cmdline params)))
+ (cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "sass-in-"))
(cmd (concat "sass " (or cmdline "")
" " (org-babel-process-file-name in-file)
@@ -60,7 +59,7 @@ This function is called by `org-babel-execute-src-block'."
nil ;; signal that output has already been written to file
(with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
-(defun org-babel-prep-session:sass (session params)
+(defun org-babel-prep-session:sass (_session _params)
"Raise an error because sass does not support sessions."
(error "Sass does not support sessions"))
diff --git a/lisp/ob-scala.el b/lisp/ob-scala.el
index 7df8da8..8cdf2c0 100644
--- a/lisp/ob-scala.el
+++ b/lisp/ob-scala.el
@@ -1,4 +1,4 @@
-;;; ob-scala.el --- org-babel functions for Scala evaluation
+;;; ob-scala.el --- Babel Functions for Scala -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@@ -31,7 +31,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala"))
@@ -45,9 +44,8 @@ called by `org-babel-execute-src-block'"
(message "executing Scala source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-scala-initiate-session (nth 0 processed-params)))
- (vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
- (result-type (cdr (assoc :result-type params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params))
(result (org-babel-scala-evaluate
@@ -56,9 +54,9 @@ called by `org-babel-execute-src-block'"
(org-babel-reassemble-table
result
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defvar org-babel-scala-wrapper-method
@@ -76,19 +74,19 @@ print(str_result)
(defun org-babel-scala-evaluate
- (session body &optional result-type result-params)
+ (session body &optional result-type result-params)
"Evaluate BODY in external Scala process.
If RESULT-TYPE equals `output' then return standard output as a string.
If RESULT-TYPE equals `value' then return the value of the last statement
in BODY as elisp."
(when session (error "Sessions are not (yet) supported for Scala"))
- (case result-type
- (output
+ (pcase result-type
+ (`output
(let ((src-file (org-babel-temp-file "scala-")))
- (progn (with-temp-file src-file (insert body))
- (org-babel-eval
- (concat org-babel-scala-command " " src-file) ""))))
- (value
+ (with-temp-file src-file (insert body))
+ (org-babel-eval
+ (concat org-babel-scala-command " " src-file) "")))
+ (`value
(let* ((src-file (org-babel-temp-file "scala-"))
(wrapper (format org-babel-scala-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
@@ -99,11 +97,11 @@ in BODY as elisp."
(org-babel-script-escape raw)))))))
-(defun org-babel-prep-session:scala (session params)
+(defun org-babel-prep-session:scala (_session _params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Scala"))
-(defun org-babel-scala-initiate-session (&optional session)
+(defun org-babel-scala-initiate-session (&optional _session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session. Sessions are not
supported in Scala."
diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index 0473138..c1d5462 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -1,4 +1,4 @@
-;;; ob-scheme.el --- org-babel functions for Scheme
+;;; ob-scheme.el --- Babel Functions for Scheme -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -45,17 +45,18 @@
(defvar geiser-default-implementation) ; Defined in geiser-impl.el
(defvar geiser-active-implementations) ; Defined in geiser-impl.el
-(declare-function run-geiser "geiser-repl" (impl))
-(declare-function geiser-mode "geiser-mode" ())
-(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg))
-(declare-function geiser-repl-exit "geiser-repl" (&optional arg))
+(declare-function run-geiser "ext:geiser-repl" (impl))
+(declare-function geiser-mode "ext:geiser-mode" ())
+(declare-function geiser-eval-region "ext:geiser-mode"
+ (start end &optional and-go raw nomsg))
+(declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg))
(defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.")
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(if (> (length vars) 0)
(concat "(let ("
(mapconcat
@@ -172,7 +173,7 @@ is true; otherwise returns the last value."
(setq result (if (or (string= result "#<void>")
(string= result "#<unspecified>"))
nil
- (read result)))))
+ result))))
result))
(defun org-babel-execute:scheme (body params)
@@ -184,23 +185,23 @@ This function is called by `org-babel-execute-src-block'"
(buffer-name source-buffer))))
(save-excursion
(org-babel-reassemble-table
- (let* ((result-type (cdr (assoc :result-type params)))
- (impl (or (when (cdr (assoc :scheme params))
- (intern (cdr (assoc :scheme params))))
+ (let* ((result-type (cdr (assq :result-type params)))
+ (impl (or (when (cdr (assq :scheme params))
+ (intern (cdr (assq :scheme params))))
geiser-default-implementation
(car geiser-active-implementations)))
(session (org-babel-scheme-make-session-name
- source-buffer-name (cdr (assoc :session params)) impl))
+ source-buffer-name (cdr (assq :session params)) impl))
(full-body (org-babel-expand-body:scheme body params)))
(org-babel-scheme-execute-with-geiser
full-body ; code
(string= result-type "output") ; output?
impl ; implementation
(and (not (string= session "none")) session))) ; session
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params)))))))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params)))))))
(provide 'ob-scheme)
diff --git a/lisp/ob-screen.el b/lisp/ob-screen.el
index db89733..c4c9528 100644
--- a/lisp/ob-screen.el
+++ b/lisp/ob-screen.el
@@ -1,4 +1,4 @@
-;;; ob-screen.el --- org-babel support for interactive terminal
+;;; ob-screen.el --- Babel Support for Interactive Terminal -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -48,18 +48,17 @@ In case you want to use a different screen than one selected by your $PATH")
\"default\" session is used when none is specified."
(message "Sending source code block to interactive terminal session...")
(save-window-excursion
- (let* ((session (cdr (assoc :session params)))
+ (let* ((session (cdr (assq :session params)))
(socket (org-babel-screen-session-socketname session)))
(unless socket (org-babel-prep-session:screen session params))
(org-babel-screen-session-execute-string
session (org-babel-expand-body:generic body params)))))
-(defun org-babel-prep-session:screen (session params)
+(defun org-babel-prep-session:screen (_session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
- (let* ((session (cdr (assoc :session params)))
- (socket (org-babel-screen-session-socketname session))
- (cmd (cdr (assoc :cmd params)))
- (terminal (cdr (assoc :terminal params)))
+ (let* ((session (cdr (assq :session params)))
+ (cmd (cdr (assq :cmd params)))
+ (terminal (cdr (assq :terminal params)))
(process-name (concat "org-babel: terminal (" session ")")))
(apply 'start-process process-name "*Messages*"
terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location
@@ -104,7 +103,7 @@ In case you want to use a different screen than one selected by your $PATH")
sockets)))))
(when match-socket (car (split-string match-socket)))))
-(defun org-babel-screen-session-write-temp-file (session body)
+(defun org-babel-screen-session-write-temp-file (_session body)
"Save BODY in a temp file that is named after SESSION."
(let ((tmpfile (org-babel-temp-file "screen-")))
(with-temp-file tmpfile
@@ -119,11 +118,10 @@ In case you want to use a different screen than one selected by your $PATH")
"Test if the default setup works.
The terminal should shortly flicker."
(interactive)
- (let* ((session "org-babel-testing")
- (random-string (format "%s" (random 99999)))
+ (let* ((random-string (format "%s" (random 99999)))
(tmpfile (org-babel-temp-file "ob-screen-test-"))
(body (concat "echo '" random-string "' > " tmpfile "\nexit\n"))
- process tmp-string)
+ tmp-string)
(org-babel-execute:screen body org-babel-default-header-args:screen)
;; XXX: need to find a better way to do the following
(while (not (file-readable-p tmpfile))
diff --git a/lisp/ob-sed.el b/lisp/ob-sed.el
index f68bb14..dd8a17b 100644
--- a/lisp/ob-sed.el
+++ b/lisp/ob-sed.el
@@ -1,4 +1,4 @@
-;;; ob-sed.el --- org-babel functions for sed scripts
+;;; ob-sed.el --- Babel Functions for Sed Scripts -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
diff --git a/lisp/ob-shell.el b/lisp/ob-shell.el
index 527e6f5..74b6c7e 100644
--- a/lisp/ob-shell.el
+++ b/lisp/ob-shell.el
@@ -1,4 +1,4 @@
-;;; ob-shell.el --- org-babel functions for shell evaluation
+;;; ob-shell.el --- Babel Functions for Shell Evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -28,49 +28,60 @@
;;; Code:
(require 'ob)
(require 'shell)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
-(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body))
+(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)
+ t)
(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
-(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body))
+(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)
+ t)
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function orgtbl-to-generic "org-table" (table params))
(defvar org-babel-default-header-args:shell '())
+(defvar org-babel-shell-names)
+
+(defun org-babel-shell-initialize ()
+ "Define execution functions associated to shell names.
+This function has to be called whenever `org-babel-shell-names'
+is modified outside the Customize interface."
+ (interactive)
+ (dolist (name org-babel-shell-names)
+ (eval `(defun ,(intern (concat "org-babel-execute:" name))
+ (body params)
+ ,(format "Execute a block of %s commands with Babel." name)
+ (let ((shell-file-name ,name))
+ (org-babel-execute:shell body params))))))
(defcustom org-babel-shell-names
'("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh")
- "List of names of shell supported by babel shell code blocks."
+ "List of names of shell supported by babel shell code blocks.
+Call `org-babel-shell-initialize' when modifying this variable
+outside the Customize interface."
:group 'org-babel
- :type 'string
- :initialize
- (lambda (symbol value)
- (set-default symbol (second value))
- (mapc
- (lambda (name)
- (eval `(defun ,(intern (concat "org-babel-execute:" name)) (body params)
- ,(format "Execute a block of %s commands with Babel." name)
- (let ((shell-file-name ,name))
- (org-babel-execute:shell body params)))))
- (second value))))
+ :type '(repeat (string :tag "Shell name: "))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (org-babel-shell-initialize)))
(defun org-babel-execute:shell (body params)
"Execute a block of Shell commands with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session
- (cdr (assoc :session params))))
- (stdin (let ((stdin (cdr (assoc :stdin params))))
+ (cdr (assq :session params))))
+ (stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin (org-babel-sh-var-to-string
(org-babel-ref-resolve stdin)))))
- (cmdline (cdr (assoc :cmdline params)))
+ (cmdline (cdr (assq :cmdline params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:shell params))))
(org-babel-reassemble-table
(org-babel-sh-evaluate session full-body params stdin cmdline)
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defun org-babel-prep-session:shell (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
@@ -131,18 +142,18 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-variable-assignments:shell (params)
"Return list of shell statements assigning the block's variables."
- (let ((sep (cdr (assoc :separator params)))
- (hline (when (string= "yes" (cdr (assoc :hlines params)))
- (or (cdr (assoc :hline-string params))
+ (let ((sep (cdr (assq :separator params)))
+ (hline (when (string= "yes" (cdr (assq :hlines params)))
+ (or (cdr (assq :hline-string params))
"hline"))))
(mapcar
(lambda (pair)
- (if (string-match "bash$" shell-file-name)
+ (if (string-suffix-p "bash" shell-file-name)
(org-babel-variable-assignments:bash
(car pair) (cdr pair) sep hline)
(org-babel-variable-assignments:sh-generic
(car pair) (cdr pair) sep hline)))
- (mapcar #'cdr (org-babel-get-header params :var)))))
+ (org-babel--get-vars params))))
(defun org-babel-sh-var-to-sh (var &optional sep hline)
"Convert an elisp value to a shell variable.
@@ -157,14 +168,14 @@ var of the same value."
"Convert an elisp value to a string."
(let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
- ((and (listp var) (or (listp (car var)) (equal (car var) 'hline)))
+ ((and (listp var) (or (listp (car var)) (eq (car var) 'hline)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var
:hline hline)))
((listp var)
(mapconcat echo-var var "\n"))
(t (funcall echo-var var)))))
-(defun org-babel-sh-initiate-session (&optional session params)
+(defun org-babel-sh-initiate-session (&optional session _params)
"Initiate a session named SESSION according to PARAMS."
(when (and session (not (string= session "none")))
(save-window-excursion
@@ -192,8 +203,8 @@ return the value of the last statement in BODY."
((or stdin cmdline) ; external shell script w/STDIN
(let ((script-file (org-babel-temp-file "sh-script-"))
(stdin-file (org-babel-temp-file "sh-stdin-"))
- (shebang (cdr (assoc :shebang params)))
- (padline (not (string= "no" (cdr (assoc :padline params))))))
+ (shebang (cdr (assq :shebang params)))
+ (padline (not (string= "no" (cdr (assq :padline params))))))
(with-temp-file script-file
(when shebang (insert (concat shebang "\n")))
(when padline (insert "\n"))
@@ -212,7 +223,7 @@ return the value of the last statement in BODY."
(mapconcat
#'org-babel-sh-strip-weird-long-prompt
(mapcar
- #'org-babel-trim
+ #'org-trim
(butlast
(org-babel-comint-with-output
(session org-babel-sh-eoe-output t body)
@@ -227,24 +238,24 @@ return the value of the last statement in BODY."
(accept-process-output
(get-buffer-process (current-buffer)))))
(append
- (split-string (org-babel-trim body) "\n")
+ (split-string (org-trim body) "\n")
(list org-babel-sh-eoe-indicator))))
2)) "\n"))
('otherwise ; external shell script
- (if (and (cdr (assoc :shebang params))
- (> (length (cdr (assoc :shebang params))) 0))
+ (if (and (cdr (assq :shebang params))
+ (> (length (cdr (assq :shebang params))) 0))
(let ((script-file (org-babel-temp-file "sh-script-"))
- (shebang (cdr (assoc :shebang params)))
- (padline (not (equal "no" (cdr (assoc :padline params))))))
+ (shebang (cdr (assq :shebang params)))
+ (padline (not (equal "no" (cdr (assq :padline params))))))
(with-temp-file script-file
(when shebang (insert (concat shebang "\n")))
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
(org-babel-eval script-file ""))
- (org-babel-eval shell-file-name (org-babel-trim body)))))))
+ (org-babel-eval shell-file-name (org-trim body)))))))
(when results
- (let ((result-params (cdr (assoc :result-params params))))
+ (let ((result-params (cdr (assq :result-params params))))
(org-babel-result-cond result-params
results
(let ((tmp-file (org-babel-temp-file "sh-")))
diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el
index 413fe0d..f502d43 100644
--- a/lisp/ob-shen.el
+++ b/lisp/ob-shen.el
@@ -1,4 +1,4 @@
-;;; ob-shen.el --- org-babel functions for Shen
+;;; ob-shen.el --- Babel Functions for Shen -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -43,7 +43,7 @@
(defun org-babel-expand-body:shen (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(if (> (length vars) 0)
(concat "(let "
(mapconcat (lambda (var)
@@ -63,14 +63,13 @@
"Execute a block of Shen code with org-babel.
This function is called by `org-babel-execute-src-block'"
(require 'inf-shen)
- (let* ((result-type (cdr (assoc :result-type params)))
- (result-params (cdr (assoc :result-params params)))
+ (let* ((result-params (cdr (assq :result-params params)))
(full-body (org-babel-expand-body:shen body params)))
(let ((results
(with-temp-buffer
(insert full-body)
(call-interactively #'shen-eval-defun))))
- (org-babel-result-cond result-params
+ (org-babel-result-cond result-params
results
(condition-case nil (org-babel-script-escape results)
(error results))))))
diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index f096572..ec94c35 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -1,4 +1,4 @@
-;;; ob-sql.el --- org-babel functions for sql evaluation
+;;; ob-sql.el --- Babel Functions for SQL -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -57,11 +57,11 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function org-table-import "org-table" (file arg))
(declare-function orgtbl-to-csv "org-table" (table params))
(declare-function org-table-to-lisp "org-table" (&optional txt))
+(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
(defvar org-babel-default-header-args:sql '())
@@ -78,7 +78,7 @@
(defun org-babel-expand-body:sql (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sql-expand-vars
- body (mapcar #'cdr (org-babel-get-header params :var))))
+ body (org-babel--get-vars params)))
(defun org-babel-sql-dbstring-mysql (host port user password database)
"Make MySQL cmd line args for database connection. Pass nil to omit that arg."
@@ -90,100 +90,155 @@
(when password (concat "-p" password))
(when database (concat "-D" database))))))
-(defun org-babel-sql-dbstring-postgresql (host user database)
+(defun org-babel-sql-dbstring-postgresql (host port user database)
"Make PostgreSQL command line args for database connection.
Pass nil to omit that arg."
(combine-and-quote-strings
(delq nil
(list (when host (concat "-h" host))
+ (when port (format "-p%d" port))
(when user (concat "-U" user))
(when database (concat "-d" database))))))
+(defun org-babel-sql-dbstring-oracle (host port user password database)
+ "Make Oracle command line args for database connection."
+ (format "%s/%s@%s:%s/%s" user password host port database))
+
+(defun org-babel-sql-dbstring-mssql (host user password database)
+ "Make sqlcmd commmand line args for database connection.
+`sqlcmd' is the preferred command line tool to access Microsoft
+SQL Server on Windows and Linux platform."
+ (mapconcat #'identity
+ (delq nil
+ (list (when host (format "-S \"%s\"" host))
+ (when user (format "-U \"%s\"" user))
+ (when password (format "-P \"%s\"" password))
+ (when database (format "-d \"%s\"" database))))
+ " "))
+
+(defun org-babel-sql-convert-standard-filename (file)
+ "Convert the file name to OS standard.
+If in Cygwin environment, uses Cygwin specific function to
+convert the file name. Otherwise, uses Emacs' standard conversion
+function."
+ (format "\"%s\""
+ (if (fboundp 'cygwin-convert-file-name-to-windows)
+ (cygwin-convert-file-name-to-windows file)
+ (convert-standard-filename file))))
+
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (cdr (assoc :result-params params)))
- (cmdline (cdr (assoc :cmdline params)))
- (dbhost (cdr (assoc :dbhost params)))
+ (let* ((result-params (cdr (assq :result-params params)))
+ (cmdline (cdr (assq :cmdline params)))
+ (dbhost (cdr (assq :dbhost params)))
(dbport (cdr (assq :dbport params)))
- (dbuser (cdr (assoc :dbuser params)))
- (dbpassword (cdr (assoc :dbpassword params)))
- (database (cdr (assoc :database params)))
- (engine (cdr (assoc :engine params)))
- (colnames-p (not (equal "no" (cdr (assoc :colnames params)))))
+ (dbuser (cdr (assq :dbuser params)))
+ (dbpassword (cdr (assq :dbpassword params)))
+ (database (cdr (assq :database params)))
+ (engine (cdr (assq :engine params)))
+ (colnames-p (not (equal "no" (cdr (assq :colnames params)))))
(in-file (org-babel-temp-file "sql-in-"))
- (out-file (or (cdr (assoc :out-file params))
+ (out-file (or (cdr (assq :out-file params))
(org-babel-temp-file "sql-out-")))
(header-delim "")
- (command (case (intern engine)
- ('dbi (format "dbish --batch %s < %s | sed '%s' > %s"
+ (command (pcase (intern engine)
+ (`dbi (format "dbish --batch %s < %s | sed '%s' > %s"
(or cmdline "")
(org-babel-process-file-name in-file)
"/^+/d;s/^|//;s/(NULL)/ /g;$d"
(org-babel-process-file-name out-file)))
- ('monetdb (format "mclient -f tab %s < %s > %s"
- (or cmdline "")
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)))
- ('msosql (format "osql %s -s \"\t\" -i %s -o %s"
- (or cmdline "")
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)))
- ('mysql (format "mysql %s %s %s < %s > %s"
+ (`monetdb (format "mclient -f tab %s < %s > %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
+ (`mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s"
+ (or cmdline "")
+ (org-babel-sql-dbstring-mssql
+ dbhost dbuser dbpassword database)
+ (org-babel-sql-convert-standard-filename
+ (org-babel-process-file-name in-file))
+ (org-babel-sql-convert-standard-filename
+ (org-babel-process-file-name out-file))))
+ (`mysql (format "mysql %s %s %s < %s > %s"
(org-babel-sql-dbstring-mysql
dbhost dbport dbuser dbpassword database)
(if colnames-p "" "-N")
- (or cmdline "")
+ (or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
- ('postgresql (format
- "psql --set=\"ON_ERROR_STOP=1\" %s -A -P footer=off -F \"\t\" %s -f %s -o %s %s"
+ (`postgresql (format
+ "%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \
+footer=off -F \"\t\" %s -f %s -o %s %s"
+ (if dbpassword
+ (format "PGPASSWORD=%s " dbpassword)
+ "")
(if colnames-p "" "-t")
- (org-babel-sql-dbstring-postgresql dbhost dbuser database)
+ (org-babel-sql-dbstring-postgresql
+ dbhost dbport dbuser database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
- (t (error "No support for the %s SQL engine" engine)))))
+ (`oracle (format
+ "sqlplus -s %s < %s > %s"
+ (org-babel-sql-dbstring-oracle
+ dbhost dbport dbuser dbpassword database)
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
+ (_ (error "No support for the %s SQL engine" engine)))))
(with-temp-file in-file
(insert
- (case (intern engine)
- ('dbi "/format partbox\n")
- (t ""))
+ (pcase (intern engine)
+ (`dbi "/format partbox\n")
+ (`oracle "SET PAGESIZE 50000
+SET NEWPAGE 0
+SET TAB OFF
+SET SPACE 0
+SET LINESIZE 9999
+SET ECHO OFF
+SET FEEDBACK OFF
+SET VERIFY OFF
+SET HEADING ON
+SET MARKUP HTML OFF SPOOL OFF
+SET COLSEP '|'
+
+")
+ (`mssql "SET NOCOUNT ON
+
+")
+ (_ ""))
(org-babel-expand-body:sql body params)))
- (message command)
(org-babel-eval command "")
(org-babel-result-cond result-params
(with-temp-buffer
- (progn (insert-file-contents-literally out-file) (buffer-string)))
+ (progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer
(cond
- ((or (eq (intern engine) 'mysql)
- (eq (intern engine) 'dbi)
- (eq (intern engine) 'postgresql))
- ;; Add header row delimiter after column-names header in first line
- (cond
- (colnames-p
- (with-temp-buffer
- (insert-file-contents out-file)
- (goto-char (point-min))
- (forward-line 1)
- (insert "-\n")
- (setq header-delim "-")
- (write-file out-file)))))
- (t
- ;; Need to figure out the delimiter for the header row
- (with-temp-buffer
- (insert-file-contents out-file)
- (goto-char (point-min))
- (when (re-search-forward "^\\(-+\\)[^-]" nil t)
- (setq header-delim (match-string-no-properties 1)))
- (goto-char (point-max))
- (forward-char -1)
- (while (looking-at "\n")
- (delete-char 1)
- (goto-char (point-max))
- (forward-char -1))
- (write-file out-file))))
+ ((memq (intern engine) '(dbi mysql postgresql))
+ ;; Add header row delimiter after column-names header in first line
+ (cond
+ (colnames-p
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (forward-line 1)
+ (insert "-\n")
+ (setq header-delim "-")
+ (write-file out-file)))))
+ (t
+ ;; Need to figure out the delimiter for the header row
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\(-+\\)[^-]" nil t)
+ (setq header-delim (match-string-no-properties 1)))
+ (goto-char (point-max))
+ (forward-char -1)
+ (while (looking-at "\n")
+ (delete-char 1)
+ (goto-char (point-max))
+ (forward-char -1))
+ (write-file out-file))))
(org-table-import out-file '(16))
(org-babel-reassemble-table
(mapcar (lambda (x)
@@ -191,10 +246,10 @@ This function is called by `org-babel-execute-src-block'."
'hline
x))
(org-table-to-lisp))
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params))))))))
(defun org-babel-sql-expand-vars (body vars)
"Expand the variables held in VARS in BODY."
@@ -217,7 +272,7 @@ This function is called by `org-babel-execute-src-block'."
vars)
body)
-(defun org-babel-prep-session:sql (session params)
+(defun org-babel-prep-session:sql (_session _params)
"Raise an error because Sql sessions aren't implemented."
(error "SQL sessions not yet implemented"))
diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el
index 705d7ce..0d954a4 100644
--- a/lisp/ob-sqlite.el
+++ b/lisp/ob-sqlite.el
@@ -1,4 +1,4 @@
-;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
+;;; ob-sqlite.el --- Babel Functions for SQLite Databases -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -53,23 +53,22 @@
(defun org-babel-expand-body:sqlite (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sqlite-expand-vars
- body (mapcar #'cdr (org-babel-get-header params :var))))
+ body (org-babel--get-vars params)))
(defvar org-babel-sqlite3-command "sqlite3")
(defun org-babel-execute:sqlite (body params)
"Execute a block of Sqlite code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (db (cdr (assoc :db params)))
- (separator (cdr (assoc :separator params)))
- (nullvalue (cdr (assoc :nullvalue params)))
- (headers-p (equal "yes" (cdr (assoc :colnames params))))
+ (let ((result-params (split-string (or (cdr (assq :results params)) "")))
+ (db (cdr (assq :db params)))
+ (separator (cdr (assq :separator params)))
+ (nullvalue (cdr (assq :nullvalue params)))
+ (headers-p (equal "yes" (cdr (assq :colnames params))))
(others (delq nil (mapcar
- (lambda (arg) (car (assoc arg params)))
+ (lambda (arg) (car (assq arg params)))
(list :header :echo :bail :column
- :csv :html :line :list))))
- exit-code)
+ :csv :html :line :list)))))
(unless db (error "ob-sqlite: can't evaluate without a database"))
(with-temp-buffer
(insert
@@ -140,7 +139,7 @@ This function is called by `org-babel-execute-src-block'."
(equal 1 (length (car result))))
(org-babel-read (caar result))
(mapcar (lambda (row)
- (if (equal 'hline row)
+ (if (eq 'hline row)
'hline
(mapcar #'org-babel-string-read row))) result)))
@@ -150,7 +149,7 @@ This function is called by `org-babel-execute-src-block'."
(cons (car table) (cons 'hline (cdr table)))
table))
-(defun org-babel-prep-session:sqlite (session params)
+(defun org-babel-prep-session:sqlite (_session _params)
"Raise an error because support for SQLite sessions isn't implemented.
Prepare SESSION according to the header arguments specified in PARAMS."
(error "SQLite sessions not yet implemented"))
diff --git a/lisp/ob-stan.el b/lisp/ob-stan.el
index e69de29..bf4e394 100644
--- a/lisp/ob-stan.el
+++ b/lisp/ob-stan.el
@@ -0,0 +1,84 @@
+;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
+
+;; Author: Kyle Meyer
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating Stan [1] source code.
+;;
+;; Evaluating a Stan block can produce two different results.
+;;
+;; 1) Dump the source code contents to a file.
+;;
+;; This file can then be used as a variable in other blocks, which
+;; allows interfaces like RStan to use the model.
+;;
+;; 2) Compile the contents to a model file.
+;;
+;; This provides access to the CmdStan interface. To use this, set
+;; `org-babel-stan-cmdstan-directory' and provide a :file argument
+;; that does not end in ".stan".
+;;
+;; For more information and usage examples, visit
+;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html
+;;
+;; [1] http://mc-stan.org/
+
+;;; Code:
+(require 'ob)
+(require 'org-compat)
+
+(defcustom org-babel-stan-cmdstan-directory nil
+ "CmdStan source directory.
+'make' will be called from this directory to compile the Stan
+block. When nil, executing Stan blocks dumps the content to a
+plain text file."
+ :group 'org-babel
+ :type 'string)
+
+(defvar org-babel-default-header-args:stan
+ '((:results . "file")))
+
+(defun org-babel-execute:stan (body params)
+ "Generate Stan file from BODY according to PARAMS.
+A :file header argument must be given. If
+`org-babel-stan-cmdstan-directory' is non-nil and the file name
+does not have a \".stan\" extension, save an intermediate
+\".stan\" file and compile the block to the named file.
+Otherwise, write the Stan code directly to the named file."
+ (let ((file (expand-file-name
+ (or (cdr (assq :file params))
+ (user-error "Set :file argument to execute Stan blocks")))))
+ (if (or (not org-babel-stan-cmdstan-directory)
+ (string-match-p "\\.stan\\'" file))
+ (with-temp-file file (insert body))
+ (with-temp-file (concat file ".stan") (insert body))
+ (let ((default-directory org-babel-stan-cmdstan-directory))
+ (call-process-shell-command (concat "make " file))))
+ nil)) ; Signal that output has been written to file.
+
+(defun org-babel-prep-session:stan (_session _params)
+ "Return an error because Stan does not support sessions."
+ (user-error "Stan does not support sessions"))
+
+(provide 'ob-stan)
+;;; ob-stan.el ends here
diff --git a/lisp/ob-table.el b/lisp/ob-table.el
index 6e6d7ac..efee5b7 100644
--- a/lisp/ob-table.el
+++ b/lisp/ob-table.el
@@ -1,4 +1,4 @@
-;;; ob-table.el --- support for calling org-babel functions from tables
+;;; ob-table.el --- Support for Calling Babel Functions from Tables -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -23,8 +23,8 @@
;;; Commentary:
-;; Should allow calling functions from org-mode tables using the
-;; function `org-sbe' as so...
+;; Should allow calling functions from Org tables using the function
+;; `org-sbe' as so...
;; #+begin_src emacs-lisp :results silent
;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
@@ -55,13 +55,15 @@
;;; Code:
(require 'ob-core)
+(declare-function org-trim "org" (s &optional keep-lead))
+
(defun org-babel-table-truncate-at-newline (string)
"Replace newline character with ellipses.
If STRING ends in a newline character, then remove the newline
character and replace it with ellipses."
(if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string))
(concat (substring string 0 (match-beginning 0))
- (if (match-string 1 string) "...")) string))
+ (when (match-string 1 string) "...")) string))
(defmacro org-sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with VARIABLES.
@@ -142,7 +144,7 @@ as shown in the example below.
nil (list "emacs-lisp" "results" params)
'((:results . "silent"))))
"")))
- (org-babel-trim (if (stringp result) result (format "%S" result)))))))
+ (org-trim (if (stringp result) result (format "%S" result)))))))
(provide 'ob-table)
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index a42dd1d..5e1b953 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -1,4 +1,4 @@
-;;; ob-tangle.el --- extract source code from org-mode files
+;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -26,12 +26,14 @@
;; Extract the code from source blocks out into raw source-code files.
;;; Code:
+
+(require 'cl-lib)
(require 'org-src)
(declare-function make-directory "files" (dir &optional parents))
(declare-function org-at-heading-p "org" (&optional ignored))
-(declare-function org-babel-update-block-body "org" (new-body))
-(declare-function org-back-to-heading "org" (invisible-ok))
+(declare-function org-babel-update-block-body "ob-core" (new-body))
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-edit-special "org" (&optional arg))
(declare-function org-element-at-point "org-element" ())
@@ -39,11 +41,14 @@
(declare-function org-fill-template "org" (template alist))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
-(declare-function org-link-escape "org" (text &optional table))
+(declare-function org-link-escape "org" (text &optional table merge))
(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
+(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-store-link "org" (arg))
-(declare-function org-string-nw-p "org" (s))
+(declare-function org-string-nw-p "org-macs" (s))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function outline-previous-heading "outline" ())
+(declare-function org-id-find "org-id" (id &optional markerp))
(defvar org-link-types-re)
@@ -63,7 +68,7 @@ then the name of the language is used."
(string "File Extension"))))
(defcustom org-babel-tangle-use-relative-file-links t
- "Use relative path names in links from tangled source back the Org-mode file."
+ "Use relative path names in links from tangled source back the Org file."
:group 'org-babel-tangle
:type 'boolean)
@@ -91,7 +96,7 @@ The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
-%link --------- Org-mode style link to the code block
+%link --------- Org style link to the code block
%source-name -- name of the code block
Upon insertion the formatted comment will be commented out, and
@@ -111,7 +116,7 @@ The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
-%link --------- Org-mode style link to the code block
+%link --------- Org style link to the code block
%source-name -- name of the code block
Upon insertion the formatted comment will be commented out, and
@@ -133,8 +138,8 @@ of tangled comments."
:group 'org-babel
:type 'boolean)
-(defcustom org-babel-process-comment-text #'org-remove-indentation
- "Function called to process raw Org-mode text collected to be
+(defcustom org-babel-process-comment-text 'org-remove-indentation
+ "Function called to process raw Org text collected to be
inserted as comments in tangled source-code files. The function
should take a single string argument and return a string
result. The default value is `org-remove-indentation'."
@@ -223,7 +228,7 @@ used to limit the exported source code blocks by language."
org-babel-default-header-args))
(tangle-file
(when (equal arg '(16))
- (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light))))
+ (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
(user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
@@ -276,11 +281,11 @@ used to limit the exported source code blocks by language."
;; We avoid append-to-file as it does not work with tramp.
(let ((content (buffer-string)))
(with-temp-buffer
- (if (file-exists-p file-name)
- (insert-file-contents file-name))
+ (when (file-exists-p file-name)
+ (insert-file-contents file-name))
(goto-char (point-max))
;; Handle :padlines unless first line in file
- (unless (or (string= "no" (cdr (assoc :padline (nth 4 spec))))
+ (unless (or (string= "no" (cdr (assq :padline (nth 4 spec))))
(= (point) (point-min)))
(insert "\n"))
(insert content)
@@ -290,10 +295,8 @@ used to limit the exported source code blocks by language."
(unless tangle-mode (setq tangle-mode #o755)))
;; update counter
(setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector
- (cons file-name tangle-mode)
- nil
- (lambda (a b) (equal (car a) (car b))))))))
+ (unless (assoc file-name path-collector)
+ (push (cons file-name tangle-mode) path-collector))))))
specs)))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
@@ -321,7 +324,7 @@ used to limit the exported source code blocks by language."
Call this function inside of a source-code file generated by
`org-babel-tangle' to remove all comments inserted automatically
by `org-babel-tangle'. Warning, this comment removes any lines
-containing constructs which resemble org-mode file links or noweb
+containing constructs which resemble Org file links or noweb
references."
(interactive)
(goto-char (point-min))
@@ -362,11 +365,10 @@ that the appropriate major-mode is set. SPEC has the form:
(comments (cdr (assq :comments info)))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes") (string= comments "noweb")))
- (link-data (mapcar (lambda (el)
- (cons (symbol-name el)
- (let ((le (eval el)))
- (if (stringp le) le (format "%S" le)))))
- '(start-line file link source-name)))
+ (link-data `(("start-line" . ,(number-to-string start-line))
+ ("file" . ,file)
+ ("link" . ,link)
+ ("source-name" . ,source-name)))
(insert-comment (lambda (text)
(when (and comments
(not (string= comments "no"))
@@ -390,10 +392,10 @@ that the appropriate major-mode is set. SPEC has the form:
insert-comment
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
(insert
- (format
- "%s\n"
- (org-unescape-code-in-string
- (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
+ (org-unescape-code-in-string
+ (if org-src-preserve-indentation (org-trim body t)
+ (org-trim (org-remove-indentation body))))
+ "\n")
(when link-p
(funcall
insert-comment
@@ -411,7 +413,7 @@ can be used to limit the collected code blocks by target file."
(let ((current-heading-pos
(org-with-wide-buffer
(org-with-limited-levels (outline-previous-heading)))))
- (if (eq last-heading-pos current-heading-pos) (incf counter)
+ (if (eq last-heading-pos current-heading-pos) (cl-incf counter)
(setq counter 1)
(setq last-heading-pos current-heading-pos)))
(unless (org-in-commented-heading-p)
@@ -453,11 +455,11 @@ list to be used by `org-babel-tangle' directly."
(and (string-match org-bracket-link-regexp link)
(match-string 1 link))))
(source-name
- (intern (or (nth 4 info)
- (format "%s:%d"
- (or (ignore-errors (nth 4 (org-heading-components)))
- "No heading")
- block-counter))))
+ (or (nth 4 info)
+ (format "%s:%d"
+ (or (ignore-errors (nth 4 (org-heading-components)))
+ "No heading")
+ block-counter)))
(expand-cmd
(intern (concat "org-babel-expand-body:" src-lang)))
(assignments-cmd
@@ -469,7 +471,7 @@ list to be used by `org-babel-tangle' directly."
(org-babel-expand-noweb-references info)
(nth 1 info)))
(body
- (if (assoc :no-expand params)
+ (if (assq :no-expand params)
body
(if (fboundp expand-cmd)
(funcall expand-cmd body params)
@@ -487,8 +489,8 @@ list to be used by `org-babel-tangle' directly."
(run-hooks 'org-babel-tangle-body-hook)
(buffer-string))))
(comment
- (when (or (string= "both" (cdr (assoc :comments params)))
- (string= "org" (cdr (assoc :comments params))))
+ (when (or (string= "both" (cdr (assq :comments params)))
+ (string= "org" (cdr (assq :comments params))))
;; From the previous heading or code-block end
(funcall
org-babel-process-comment-text
@@ -510,26 +512,25 @@ list to be used by `org-babel-tangle' directly."
(list (cons src-lang (list result)))
result)))
-(defun org-babel-tangle-comment-links ( &optional info)
+(defun org-babel-tangle-comment-links (&optional info)
"Return a list of begin and end link comments for the code block at point."
- (let* ((start-line (org-babel-where-is-src-block-head))
- (file (buffer-file-name))
- (link (org-link-escape (progn (call-interactively 'org-store-link)
- (org-no-properties
- (car (pop org-stored-links))))))
- (source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
- (link-data (mapcar (lambda (el)
- (cons (symbol-name el)
- (let ((le (eval el)))
- (if (stringp le) le (format "%S" le)))))
- '(start-line file link source-name))))
+ (let ((link-data
+ `(("start-line" . ,(number-to-string
+ (org-babel-where-is-src-block-head)))
+ ("file" . ,(buffer-file-name))
+ ("link" . ,(org-link-escape
+ (progn
+ (call-interactively #'org-store-link)
+ (org-no-properties (car (pop org-stored-links))))))
+ ("source-name" .
+ ,(nth 4 (or info (org-babel-get-src-block-info 'light)))))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))
;; de-tangling functions
(defvar org-bracket-link-analytic-regexp)
(defun org-babel-detangle (&optional source-code-file)
- "Propagate changes in source file back original to Org-mode file.
+ "Propagate changes in source file back original to Org file.
This requires that code blocks were tangled with link comments
which enable the original code blocks to be found."
(interactive)
@@ -553,7 +554,7 @@ which enable the original code blocks to be found."
"Jump from a tangled code file to the related Org mode file."
(interactive)
(let ((mid (point))
- start body-start end done
+ start body-start end
target-buffer target-char link path block-name body)
(save-window-excursion
(save-excursion
@@ -575,7 +576,7 @@ which enable the original code blocks to be found."
(setq body (buffer-substring body-start end)))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
- (find-file path)
+ (find-file (or (car (org-id-find path)) path))
(setq target-buffer (current-buffer))
;; Go to the beginning of the relative block in Org file.
(org-open-link-from-string link)
@@ -598,7 +599,8 @@ which enable the original code blocks to be found."
(forward-char (- mid body-start))
(setq target-char (point)))
(org-src-switch-to-buffer target-buffer t)
- (prog1 body (goto-char target-char))))
+ (goto-char target-char)
+ body))
(provide 'ob-tangle)
diff --git a/lisp/ob.el b/lisp/ob.el
index cc46693..491b0d7 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -1,4 +1,4 @@
-;;; ob.el --- working with code blocks in org-mode
+;;; ob.el --- Working with Code Blocks in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 19a4095..7ee721a 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -24,7 +24,7 @@
;;
;;; Commentary:
-;; This file contains the code for creating and using the Agenda for Org-mode.
+;; This file contains the code for creating and using the Agenda for Org.
;;
;; The functions `org-batch-agenda', `org-batch-agenda-csv', and
;; `org-batch-store-agenda-views' are implemented as macros to provide
@@ -45,10 +45,9 @@
;;; Code:
+(require 'cl-lib)
(require 'org)
(require 'org-macs)
-(eval-when-compile
- (require 'cl))
(declare-function diary-add-to-list "diary-lib"
(date string specifier &optional marker globcolor literal))
@@ -80,16 +79,15 @@
(declare-function org-is-habit-p "org-habit" (&optional pom))
(declare-function org-habit-parse-todo "org-habit" (&optional pom))
(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
-(declare-function org-pop-to-buffer-same-window "org-compat"
- (&optional buffer-or-name norecord label))
(declare-function org-agenda-columns "org-colview" ())
(declare-function org-add-archive-files "org-archive" (files))
(declare-function org-capture "org-capture" (&optional goto keys))
-(defvar calendar-mode-map) ; defined in calendar.el
-(defvar org-clock-current-task nil) ; defined in org-clock.el
-(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
-(defvar org-habit-show-habits) ; defined in org-habit.el
+(defvar calendar-mode-map)
+(defvar org-clock-current-task)
+(defvar org-current-tag-alist)
+(defvar org-mobile-force-id-on-agenda-items)
+(defvar org-habit-show-habits)
(defvar org-habit-show-habits-only-for-today)
(defvar org-habit-show-all-today)
@@ -97,8 +95,8 @@
(defvar org-agenda-buffer-name "*Org Agenda*")
(defvar org-agenda-overriding-header nil)
(defvar org-agenda-title-append nil)
-(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
-(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
+(with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
+(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(defvar original-date) ; dynamically scoped, calendar.el does scope this
(defvar org-agenda-undo-list nil
@@ -136,7 +134,7 @@ addresses the separator between the current and the previous block."
(string)))
(defgroup org-agenda-export nil
- "Options concerning exporting agenda views in Org-mode."
+ "Options concerning exporting agenda views in Org mode."
:tag "Org Agenda Export"
:group 'org-agenda)
@@ -238,7 +236,7 @@ you can \"misuse\" it to also add other text to the header."
:type 'boolean)
(defgroup org-agenda-custom-commands nil
- "Options concerning agenda views in Org-mode."
+ "Options concerning agenda views in Org mode."
:tag "Org Agenda Custom Commands"
:group 'org-agenda)
@@ -262,8 +260,8 @@ you can \"misuse\" it to also add other text to the header."
;; Keep custom values for `org-agenda-filter-preset' compatible with
;; the new variable `org-agenda-tag-filter-preset'.
-(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
-(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
+(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+(defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
"List of types searched for when creating the daily/weekly agenda.
@@ -442,8 +440,9 @@ This will be spliced into the custom type of
(defcustom org-agenda-custom-commands
'(("n" "Agenda and all TODOs" ((agenda "") (alltodo ""))))
"Custom commands for the agenda.
+\\<org-mode-map>
These commands will be offered on the splash screen displayed by the
-agenda dispatcher \\[org-agenda]. Each entry is a list like this:
+agenda dispatcher `\\[org-agenda]'. Each entry is a list like this:
(key desc type match settings files)
@@ -608,14 +607,17 @@ subtree to see if any of the subtasks have project status.
See also the variable `org-tags-match-list-sublevels' which applies
to projects matched by this search as well.
-After defining this variable, you may use \\[org-agenda-list-stuck-projects]
-or `C-c a #' to produce the list."
+After defining this variable, you may use `\\[org-agenda-list-stuck-projects]'
+\(bound to `C-c a #') to produce the list."
:group 'org-agenda-custom-commands
:type '(list
(string :tag "Tags/TODO match to identify a project")
- (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
- (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string))
- (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree")))
+ (repeat :tag "Projects are *not* stuck if they have an entry with \
+TODO keyword any of" (string))
+ (repeat :tag "Projects are *not* stuck if they have an entry with \
+TAG being any of" (string))
+ (regexp :tag "Projects are *not* stuck if this regexp matches inside \
+the subtree")))
(defgroup org-agenda-skip nil
"Options concerning skipping parts of agenda files."
@@ -999,8 +1001,6 @@ you want to use two-columns display (see `org-agenda-menu-two-columns')."
:version "24.1"
:type 'boolean)
-(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3")
-
(defcustom org-agenda-menu-two-columns nil
"Non-nil means, use two columns to show custom commands in the dispatcher.
If you use this, you probably want to set `org-agenda-menu-show-matcher'
@@ -1009,7 +1009,6 @@ to nil."
:version "24.1"
:type 'boolean)
-(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3")
(defcustom org-agenda-finalize-hook nil
"Hook run just before displaying an agenda buffer.
The buffer is still writable when the hook is called.
@@ -1022,8 +1021,8 @@ headlines as the agenda display heavily relies on them."
(defcustom org-agenda-mouse-1-follows-link nil
"Non-nil means mouse-1 on a link will follow the link in the agenda.
-A longer mouse click will still set point. Does not work on XEmacs.
-Needs to be set before org.el is loaded."
+A longer mouse click will still set point. Needs to be set
+before org.el is loaded."
:group 'org-agenda-startup
:type 'boolean)
@@ -1052,9 +1051,9 @@ current item's tree, in an indirect buffer."
(defcustom org-agenda-entry-text-maxlines 5
"Number of text lines to be added when `E' is pressed in the agenda.
-Note that this variable only used during agenda display. Add add entry text
+Note that this variable only used during agenda display. To add entry text
when exporting the agenda, configure the variable
-`org-agenda-add-entry-ext-maxlines'."
+`org-agenda-add-entry-text-maxlines'."
:group 'org-agenda
:type 'integer)
@@ -1126,16 +1125,6 @@ option will be ignored."
:group 'org-agenda-windows
:type 'boolean)
-(defcustom org-agenda-ndays nil
- "Number of days to include in overview display.
-Should be 1 or 7.
-Obsolete, see `org-agenda-span'."
- :group 'org-agenda-daily/weekly
- :type '(choice (const nil)
- (integer)))
-
-(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
-
(defcustom org-agenda-span 'week
"Number of days to include in overview display.
Can be day, week, month, year, or any number of days.
@@ -1284,9 +1273,9 @@ shown, either today or the nearest into the future."
(defcustom org-scheduled-past-days 10000
"Number of days to continue listing scheduled items not marked DONE.
-When an item is scheduled on a date, it shows up in the agenda on this
-day and will be listed until it is marked done for the number of days
-given here."
+When an item is scheduled on a date, it shows up in the agenda on
+this day and will be listed until it is marked done or for the
+number of days given here."
:group 'org-agenda-daily/weekly
:type 'integer)
@@ -1415,7 +1404,7 @@ boolean search."
:version "24.1"
:type 'boolean)
-(org-defvaralias 'org-agenda-search-view-search-words-only
+(defvaralias 'org-agenda-search-view-search-words-only
'org-agenda-search-view-always-boolean)
(defcustom org-agenda-search-view-force-full-words nil
@@ -1436,7 +1425,7 @@ value, don't limit agenda view by outline level."
:type 'integer)
(defgroup org-agenda-time-grid nil
- "Options concerning the time grid in the Org-mode Agenda."
+ "Options concerning the time grid in the Org Agenda."
:tag "Org Agenda Time Grid"
:group 'org-agenda)
@@ -1508,7 +1497,7 @@ a grid line."
:type 'string)
(defgroup org-agenda-sorting nil
- "Options concerning sorting in the Org-mode Agenda."
+ "Options concerning sorting in the Org Agenda."
:tag "Org Agenda Sorting"
:group 'org-agenda)
@@ -1614,7 +1603,7 @@ When nil, such items are sorted as 0 minutes effort."
:type 'boolean)
(defgroup org-agenda-line-format nil
- "Options concerning the entry prefix in the Org-mode agenda display."
+ "Options concerning the entry prefix in the Org agenda display."
:tag "Org Agenda Line Format"
:group 'org-agenda)
@@ -1860,10 +1849,10 @@ When this is the symbol `prefix', only remove tags when
(const :tag "Never" nil)
(const :tag "When prefix format contains %T" prefix)))
-(org-defvaralias 'org-agenda-remove-tags-when-in-prefix
+(defvaralias 'org-agenda-remove-tags-when-in-prefix
'org-agenda-remove-tags)
-(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80)
+(defcustom org-agenda-tags-column -80
"Shift tags in agenda items to this column.
If this number is positive, it specifies the column. If it is negative,
it means that the tags should be flushright to that column. For example,
@@ -1871,7 +1860,7 @@ it means that the tags should be flushright to that column. For example,
:group 'org-agenda-line-format
:type 'integer)
-(org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
+(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
(defcustom org-agenda-fontify-priorities 'cookies
"Non-nil means highlight low and high priorities in agenda.
@@ -1950,6 +1939,14 @@ category, you can use:
:tag "Org Agenda Column View"
:group 'org-agenda)
+(defcustom org-agenda-view-columns-initially nil
+ "When non-nil, switch to columns view right after creating the agenda."
+ :group 'org-agenda-column-view
+ :type 'boolean
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :safe #'booleanp)
+
(defcustom org-agenda-columns-show-summaries t
"Non-nil means show summaries for columns displayed in the agenda view."
:group 'org-agenda-column-view
@@ -1999,7 +1996,7 @@ For example, this value makes those two functions available:
With selected entries in an agenda buffer, `B R' will call
the custom function `set-category' on the selected entries.
Note that functions in this alist don't need to be quoted."
- :type 'alist
+ :type '(alist :key-type character :value-type (group function))
:version "24.1"
:group 'org-agenda)
@@ -2030,7 +2027,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
(defvar org-agenda-mode-map (make-sparse-keymap)
"Keymap for `org-agenda-mode'.")
-(org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
+(defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
(defvar org-agenda-menu) ; defined later in this file.
(defvar org-agenda-restrict nil) ; defined later in this file.
@@ -2047,6 +2044,8 @@ The buffer is still writable when this hook is called.")
(defvar org-agenda-force-single-file nil)
(defvar org-agenda-bulk-marked-entries nil
"List of markers that refer to marked entries in the agenda.")
+(defvar org-agenda-current-date nil
+ "Active date when building the agenda.")
;;; Multiple agenda buffers support
@@ -2067,12 +2066,12 @@ When nil, `q' will kill the single agenda buffer."
(> (prefix-numeric-value arg) 0)
(not org-agenda-sticky))))
(if (equal new-value org-agenda-sticky)
- (and (org-called-interactively-p 'interactive)
+ (and (called-interactively-p 'interactive)
(message "Sticky agenda was already %s"
(if org-agenda-sticky "enabled" "disabled")))
(setq org-agenda-sticky new-value)
(org-agenda-kill-all-agenda-buffers)
- (and (org-called-interactively-p 'interactive)
+ (and (called-interactively-p 'interactive)
(message "Sticky agenda %s"
(if org-agenda-sticky "enabled" "disabled"))))))
@@ -2117,7 +2116,7 @@ When nil, `q' will kill the single agenda buffer."
"Variables that must be local in agenda buffers to allow multiple buffers.")
(defun org-agenda-mode ()
- "Mode for time-sorted view on action items in Org-mode files.
+ "Mode for time-sorted view on action items in Org files.
The following commands are available:
@@ -2137,32 +2136,32 @@ The following commands are available:
(when (and val
(member var org-agenda-local-vars))
(set var val)))))
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
+ (setq-local org-agenda-this-buffer-is-sticky t))
(org-agenda-sticky
;; Creating a sticky Agenda buffer for the first time
(kill-all-local-variables)
(mapc 'make-local-variable org-agenda-local-vars)
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
+ (setq-local org-agenda-this-buffer-is-sticky t))
(t
;; Creating a non-sticky agenda buffer
(kill-all-local-variables)
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil)))
+ (setq-local org-agenda-this-buffer-is-sticky nil)))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil
org-agenda-bulk-marked-entries nil)
(setq major-mode 'org-agenda-mode)
;; Keep global-font-lock-mode from turning on font-lock-mode
- (org-set-local 'font-lock-global-modes (list 'not major-mode))
+ (setq-local font-lock-global-modes (list 'not major-mode))
(setq mode-name "Org-Agenda")
(setq indent-tabs-mode nil)
(use-local-map org-agenda-mode-map)
(easy-menu-add org-agenda-menu)
(if org-startup-truncated (setq truncate-lines t))
- (org-set-local 'line-move-visual nil)
- (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
- (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
+ (setq-local line-move-visual nil)
+ (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
+ (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
;; Make sure properties are removed when copying text
- (org-add-hook 'filter-buffer-substring-functions
+ (add-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(substring-no-properties (funcall fun start end delete)))
nil t)
@@ -2319,7 +2318,6 @@ The following commands are available:
(org-defkey org-agenda-mode-map "_" 'org-agenda-filter-by-effort)
(org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp)
(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all)
-(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
(org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively)
(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline)
@@ -2399,7 +2397,7 @@ The following commands are available:
["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
["Write view to file" org-agenda-write t]
["Rebuild buffer" org-agenda-redo t]
- ["Save all Org-mode Buffers" org-save-all-org-buffers t]
+ ["Save all Org buffers" org-save-all-org-buffers t]
"--"
["Show original entry" org-agenda-show t]
["Go To (other window)" org-agenda-goto t]
@@ -2668,6 +2666,7 @@ to limit entries to in this type."
(const timeline))
(integer :tag "Max number of minutes")))))
+(defvar org-agenda-keep-restricted-file-list nil)
(defvar org-keys nil)
(defvar org-match nil)
;;;###autoload
@@ -2700,9 +2699,9 @@ More commands can be added by configuring the variable
`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
searches can be pre-defined in this way.
-If the current buffer is in Org-mode and visiting a file, you can also
+If the current buffer is in Org mode and visiting a file, you can also
first press `<' once to indicate that the agenda should be temporarily
-\(until the next use of \\[org-agenda]) restricted to the current file.
+\(until the next use of `\\[org-agenda]') restricted to the current file.
Pressing `<' twice means to restrict to the current subtree or region
\(if active)."
(interactive "P")
@@ -2734,7 +2733,7 @@ Pressing `<' twice means to restrict to the current subtree or region
entry key type org-match lprops ans)
;; Turn off restriction unless there is an overriding one,
(unless org-agenda-overriding-restriction
- (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list)
+ (unless org-agenda-keep-restricted-file-list
;; There is a request to keep the file list in place
(put 'org-agenda-files 'org-restrict nil))
(setq org-agenda-restrict nil)
@@ -2831,7 +2830,7 @@ Pressing `<' twice means to restrict to the current subtree or region
((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
((equal org-keys "e") (call-interactively 'org-store-agenda-views))
((equal org-keys "?") (org-tags-view nil "+FLAGGED")
- (org-add-hook
+ (add-hook
'post-command-hook
(lambda ()
(unless (current-message)
@@ -2848,7 +2847,7 @@ Pressing `<' twice means to restrict to the current subtree or region
t t))
((equal org-keys "L")
(unless (derived-mode-p 'org-mode)
- (user-error "This is not an Org-mode file"))
+ (user-error "This is not an Org file"))
(unless restriction
(put 'org-agenda-files 'org-restrict (list bfn))
(org-call-with-arg 'org-timeline arg)))
@@ -3046,7 +3045,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
(call-interactively 'org-toggle-sticky-agenda)
(sit-for 2))
((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
- (message "Restriction is only possible in Org-mode buffers")
+ (message "Restriction is only possible in Org buffers")
(ding) (sit-for 1))
((eq c ?1)
(org-agenda-remove-restriction-lock 'noupdate)
@@ -3104,9 +3103,9 @@ L Timeline for current buffer # List stuck projects (!=configure)
match ;; The byte compiler incorrectly complains about this. Keep it!
org-cmd type lprops)
(while (setq org-cmd (pop cmds))
- (setq type (car org-cmd)
- match (eval (nth 1 org-cmd))
- lprops (nth 2 org-cmd))
+ (setq type (car org-cmd))
+ (setq match (eval (nth 1 org-cmd)))
+ (setq lprops (nth 2 org-cmd))
(let ((org-agenda-overriding-arguments
(if (eq org-agenda-overriding-cmd org-cmd)
(or org-agenda-overriding-arguments
@@ -3159,7 +3158,7 @@ Parameters are alternating variable names and values that will be bound
before running the agenda command."
(org-eval-in-environment (org-make-parameter-alist parameters)
(let (org-agenda-sticky)
- (if (> (length cmd-key) 2)
+ (if (> (length cmd-key) 1)
(org-tags-view nil cmd-key)
(org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
@@ -3260,9 +3259,7 @@ This ensures the export commands can easily use it."
((not res) "")
((stringp res) res)
(t (prin1-to-string res))))
- (while (string-match "," res)
- (setq res (replace-match ";" t t res)))
- (org-trim res)))
+ (org-trim (replace-regexp-in-string "," ";" res nil t))))
;;;###autoload
(defun org-store-agenda-views (&rest parameters)
@@ -3338,13 +3335,15 @@ the agenda to write."
(interactive "FWrite agenda to file: \nP")
(if (or (not (file-writable-p file))
(and (file-exists-p file)
- (if (org-called-interactively-p 'any)
+ (if (called-interactively-p 'any)
(not (y-or-n-p (format "Overwrite existing file %s? " file))))))
(user-error "Cannot write agenda to file %s" file))
(org-let (if nosettings nil org-agenda-exporter-settings)
'(save-excursion
(save-window-excursion
- (let ((bs (copy-sequence (buffer-string))) beg content)
+ (let ((bs (copy-sequence (buffer-string)))
+ (extension (file-name-extension file))
+ beg content)
(with-temp-buffer
(rename-buffer org-agenda-write-buffer-name t)
(set-buffer-modified-p nil)
@@ -3352,9 +3351,9 @@ the agenda to write."
(org-agenda-remove-marked-text 'invisible 'org-filtered)
(run-hooks 'org-agenda-before-write-hook)
(cond
- ((org-bound-and-true-p org-mobile-creating-agendas)
+ ((bound-and-true-p org-mobile-creating-agendas)
(org-mobile-write-agenda-for-mobile file))
- ((string-match "\\.org\\'" file)
+ ((string= "org" extension)
(let (content p m message-log-max)
(goto-char (point-min))
(while (setq p (next-single-property-change (point) 'org-hd-marker nil))
@@ -3373,7 +3372,7 @@ the agenda to write."
(write-file file)
(kill-buffer (current-buffer))
(message "Org file written to %s" file)))
- ((string-match "\\.html?\\'" file)
+ ((member extension '("html" "htm"))
(require 'htmlize)
(set-buffer (htmlize-buffer (current-buffer)))
(when org-agenda-export-html-style
@@ -3385,11 +3384,11 @@ the agenda to write."
(write-file file)
(kill-buffer (current-buffer))
(message "HTML written to %s" file))
- ((string-match "\\.ps\\'" file)
+ ((string= "ps" extension)
(require 'ps-print)
(ps-print-buffer-with-faces file)
(message "Postscript written to %s" file))
- ((string-match "\\.pdf\\'" file)
+ ((string= "pdf" extension)
(require 'ps-print)
(ps-print-buffer-with-faces
(concat (file-name-sans-extension file) ".ps"))
@@ -3399,7 +3398,7 @@ the agenda to write."
(expand-file-name file))
(delete-file (concat (file-name-sans-extension file) ".ps"))
(message "PDF written to %s" file))
- ((string-match "\\.ics\\'" file)
+ ((string= "ics" extension)
(require 'ox-icalendar)
(org-icalendar-export-current-agenda (expand-file-name file)))
(t
@@ -3411,7 +3410,7 @@ the agenda to write."
(kill-buffer (current-buffer))
(message "Plain text written to %s" file))))))))
(set-buffer (or agenda-bufname
- (and (org-called-interactively-p 'any) (buffer-name))
+ (and (called-interactively-p 'any) (buffer-name))
org-agenda-buffer-name)))
(when open (org-open-file file)))
@@ -3432,7 +3431,7 @@ This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
entry text following headings shown in the agenda.
Drawers will be excluded, also the line with scheduling/deadline info."
(when (and (> org-agenda-add-entry-text-maxlines 0)
- (not (org-bound-and-true-p org-mobile-creating-agendas)))
+ (not (bound-and-true-p org-mobile-creating-agendas)))
(let (m txt)
(goto-char (point-min))
(while (not (eobp))
@@ -3457,85 +3456,83 @@ removed from the entry content. Currently only `planning' is allowed here."
(with-current-buffer (marker-buffer marker)
(if (not (derived-mode-p 'org-mode))
(setq txt "")
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (end-of-line 1)
- (setq txt (buffer-substring
- (min (1+ (point)) (point-max))
- (progn (outline-next-heading) (point)))
- drawer-re org-drawer-regexp
- kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
- ".*\n?"))
- (with-temp-buffer
- (insert txt)
- (when org-agenda-add-entry-text-descriptive-links
- (goto-char (point-min))
- (while (org-activate-bracket-links (point-max))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-link))))
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp (point-max) t)
- (set-text-properties (match-beginning 0) (match-end 0)
- nil))
- (goto-char (point-min))
- (while (re-search-forward drawer-re nil t)
- (delete-region
- (match-beginning 0)
- (progn (re-search-forward
- "^[ \t]*:END:.*\n?" nil 'move)
- (point))))
- (unless (member 'planning keep)
- (goto-char (point-min))
- (while (re-search-forward kwd-time-re nil t)
- (replace-match "")))
- (goto-char (point-min))
- (when org-agenda-entry-text-exclude-regexps
- (let ((re-list org-agenda-entry-text-exclude-regexps) re)
- (while (setq re (pop re-list))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (replace-match "")))))
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (if (looking-at "[ \t\n]+\\'") (replace-match ""))
-
- ;; find and remove min common indentation
- (goto-char (point-min))
- (untabify (point-min) (point-max))
- (setq ind (org-get-indentation))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$")
- (setq ind (min ind (org-get-indentation))))
- (beginning-of-line 2))
- (goto-char (point-min))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$")
- (move-to-column ind)
- (delete-region (point-at-bol) (point)))
- (beginning-of-line 2))
-
- (run-hooks 'org-agenda-entry-text-cleanup-hook)
-
- (goto-char (point-min))
- (when indent
- (while (and (not (eobp)) (re-search-forward "^" nil t))
- (replace-match indent t t)))
- (goto-char (point-min))
- (while (looking-at "[ \t]*\n") (replace-match ""))
- (goto-char (point-max))
- (when (> (org-current-line)
- n-lines)
- (org-goto-line (1+ n-lines))
- (backward-char 1))
- (setq txt (buffer-substring (point-min) (point)))))))))
+ (org-with-wide-buffer
+ (goto-char marker)
+ (end-of-line 1)
+ (setq txt (buffer-substring
+ (min (1+ (point)) (point-max))
+ (progn (outline-next-heading) (point)))
+ drawer-re org-drawer-regexp
+ kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
+ ".*\n?"))
+ (with-temp-buffer
+ (insert txt)
+ (when org-agenda-add-entry-text-descriptive-links
+ (goto-char (point-min))
+ (while (org-activate-bracket-links (point-max))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(face org-link))))
+ (goto-char (point-min))
+ (while (re-search-forward org-bracket-link-regexp (point-max) t)
+ (set-text-properties (match-beginning 0) (match-end 0)
+ nil))
+ (goto-char (point-min))
+ (while (re-search-forward drawer-re nil t)
+ (delete-region
+ (match-beginning 0)
+ (progn (re-search-forward
+ "^[ \t]*:END:.*\n?" nil 'move)
+ (point))))
+ (unless (member 'planning keep)
+ (goto-char (point-min))
+ (while (re-search-forward kwd-time-re nil t)
+ (replace-match "")))
+ (goto-char (point-min))
+ (when org-agenda-entry-text-exclude-regexps
+ (let ((re-list org-agenda-entry-text-exclude-regexps) re)
+ (while (setq re (pop re-list))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (replace-match "")))))
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (if (looking-at "[ \t\n]+\\'") (replace-match ""))
+
+ ;; find and remove min common indentation
+ (goto-char (point-min))
+ (untabify (point-min) (point-max))
+ (setq ind (org-get-indentation))
+ (while (not (eobp))
+ (unless (looking-at "[ \t]*$")
+ (setq ind (min ind (org-get-indentation))))
+ (beginning-of-line 2))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (looking-at "[ \t]*$")
+ (move-to-column ind)
+ (delete-region (point-at-bol) (point)))
+ (beginning-of-line 2))
+
+ (run-hooks 'org-agenda-entry-text-cleanup-hook)
+
+ (goto-char (point-min))
+ (when indent
+ (while (and (not (eobp)) (re-search-forward "^" nil t))
+ (replace-match indent t t)))
+ (goto-char (point-min))
+ (while (looking-at "[ \t]*\n") (replace-match ""))
+ (goto-char (point-max))
+ (when (> (org-current-line)
+ n-lines)
+ (org-goto-line (1+ n-lines))
+ (backward-char 1))
+ (setq txt (buffer-substring (point-min) (point))))))))
txt))
(defun org-check-for-org-mode ()
"Make sure current buffer is in org-mode. Error if not."
(or (derived-mode-p 'org-mode)
- (error "Cannot execute org-mode agenda command on buffer in %s"
+ (error "Cannot execute Org agenda command on buffer in %s"
major-mode)))
;;; Agenda prepare and finalize
@@ -3620,26 +3617,26 @@ FILTER-ALIST is an alist of filters we need to apply when
((equal (current-buffer) abuf) nil)
(awin (select-window awin))
((not (setq wconf (current-window-configuration))))
- ((equal org-agenda-window-setup 'current-window)
- (org-pop-to-buffer-same-window abuf))
- ((equal org-agenda-window-setup 'other-window)
+ ((eq org-agenda-window-setup 'current-window)
+ (pop-to-buffer-same-window abuf))
+ ((eq org-agenda-window-setup 'other-window)
(org-switch-to-buffer-other-window abuf))
- ((equal org-agenda-window-setup 'other-frame)
+ ((eq org-agenda-window-setup 'other-frame)
(switch-to-buffer-other-frame abuf))
((eq org-agenda-window-setup 'only-window)
(delete-other-windows)
- (org-pop-to-buffer-same-window abuf))
- ((equal org-agenda-window-setup 'reorganize-frame)
+ (pop-to-buffer-same-window abuf))
+ ((eq org-agenda-window-setup 'reorganize-frame)
(delete-other-windows)
(org-switch-to-buffer-other-window abuf)))
- (setq org-agenda-tag-filter (cdr (assoc 'tag filter-alist)))
- (setq org-agenda-category-filter (cdr (assoc 'cat filter-alist)))
- (setq org-agenda-effort-filter (cdr (assoc 'effort filter-alist)))
- (setq org-agenda-regexp-filter (cdr (assoc 're filter-alist)))
+ (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist)))
+ (setq org-agenda-category-filter (cdr (assq 'cat filter-alist)))
+ (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist)))
+ (setq org-agenda-regexp-filter (cdr (assq 're filter-alist)))
;; Additional test in case agenda is invoked from within agenda
;; buffer via elisp link.
(unless (equal (current-buffer) abuf)
- (org-pop-to-buffer-same-window abuf))
+ (pop-to-buffer-same-window abuf))
(setq org-agenda-pre-window-conf
(or wconf org-agenda-pre-window-conf))))
@@ -3703,7 +3700,7 @@ FILTER-ALIST is an alist of filters we need to apply when
(setq org-agenda-last-prefix-arg current-prefix-arg)
(setq org-agenda-this-buffer-name org-agenda-buffer-name)
(and name (not org-agenda-name)
- (org-set-local 'org-agenda-name name)))
+ (setq-local org-agenda-name name)))
(setq buffer-read-only nil))))
(defvar org-agenda-overriding-columns-format) ; From org-colview.el
@@ -3727,8 +3724,8 @@ FILTER-ALIST is an alist of filters we need to apply when
(remove-text-properties (point-min) (point-max) '(face nil)))
(if (and (boundp 'org-agenda-overriding-columns-format)
org-agenda-overriding-columns-format)
- (org-set-local 'org-agenda-overriding-columns-format
- org-agenda-overriding-columns-format))
+ (setq-local org-agenda-overriding-columns-format
+ org-agenda-overriding-columns-format))
(if (and (boundp 'org-agenda-view-columns-initially)
org-agenda-view-columns-initially)
(org-agenda-columns))
@@ -3785,13 +3782,13 @@ FILTER-ALIST is an alist of filters we need to apply when
(when (get 'org-agenda-effort-filter :preset-filter)
(org-agenda-filter-apply
(get 'org-agenda-effort-filter :preset-filter) 'effort))
- (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
+ (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
(defun org-agenda-mark-clocking-task ()
"Mark the current clock entry in the agenda if it is present."
;; We need to widen when `org-agenda-finalize' is called from
;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
- (when org-clock-current-task
+ (when (bound-and-true-p org-clock-current-task)
(save-restriction
(widen)
(org-agenda-unmark-clocking-task)
@@ -3858,7 +3855,7 @@ FILTER-ALIST is an alist of filters we need to apply when
When INVISIBLE is non-nil, hide currently blocked TODO instead of
dimming them."
(interactive "P")
- (when (org-called-interactively-p 'interactive)
+ (when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks..."))
(dolist (o (overlays-in (point-min) (point-max)))
(when (eq (overlay-get o 'org-type) 'org-blocked-todo)
@@ -3890,7 +3887,7 @@ dimming them."
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
(overlay-put ov 'org-type 'org-blocked-todo))))
(forward-line))))
- (when (org-called-interactively-p 'interactive)
+ (when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks...done")))
(defvar org-agenda-skip-function nil
@@ -3942,7 +3939,7 @@ functions do."
(defvar org-agenda-markers nil
"List of all currently active markers created by `org-agenda'.")
-(defvar org-agenda-last-marker-time (org-float-time)
+(defvar org-agenda-last-marker-time (float-time)
"Creation time of the last agenda marker.")
(defun org-agenda-new-marker (&optional pos)
@@ -3950,7 +3947,7 @@ functions do."
Maker is at point, or at POS if non-nil. Org mode keeps a list of
these markers and resets them when they are no longer in use."
(let ((m (copy-marker (or pos (point)) t)))
- (setq org-agenda-last-marker-time (org-float-time))
+ (setq org-agenda-last-marker-time (float-time))
(if org-agenda-buffer
(with-current-buffer org-agenda-buffer
(push m org-agenda-markers))
@@ -4011,13 +4008,12 @@ This check for agenda markers in all agenda buffers currently active."
(defun org-agenda-get-day-face (date)
"Return the face DATE should be displayed with."
- (or (and (functionp org-agenda-day-face-function)
- (funcall org-agenda-day-face-function date))
- (cond ((org-agenda-todayp date)
- 'org-agenda-date-today)
- ((member (calendar-day-of-week date) org-agenda-weekend-days)
- 'org-agenda-date-weekend)
- (t 'org-agenda-date))))
+ (cond ((and (functionp org-agenda-day-face-function)
+ (funcall org-agenda-day-face-function date)))
+ ((org-agenda-today-p date) 'org-agenda-date-today)
+ ((memq (calendar-day-of-week date) org-agenda-weekend-days)
+ 'org-agenda-date-weekend)
+ (t 'org-agenda-date)))
;;; Agenda timeline
@@ -4025,12 +4021,16 @@ This check for agenda markers in all agenda buffers currently active."
(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
(defun org-timeline (&optional dotodo)
- "Show a time-sorted view of the entries in the current org file.
-Only entries with a time stamp of today or later will be listed. With
-\\[universal-argument] prefix, all unfinished TODO items will also be shown,
+ "Show a time-sorted view of the entries in the current Org file.
+
+Only entries with a time stamp of today or later will be listed.
+
+With `\\[universal-argument]' prefix, all unfinished TODO items will also be \
+shown,
under the current date.
-If the buffer contains an active region, only check the region for
-dates."
+
+If the buffer contains an active region, only check the region
+for dates."
(interactive "P")
(let* ((dopast t)
(org-agenda-show-log-scoped org-agenda-show-log)
@@ -4213,8 +4213,7 @@ items if they have an hour specification like [h]h:mm."
(setq start-day (time-to-days (org-read-date nil t start-day))))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
- (let* ((span (org-agenda-ndays-to-span
- (or span org-agenda-ndays org-agenda-span)))
+ (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span)))
(today (org-today))
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
@@ -4244,9 +4243,9 @@ items if they have an hour specification like [h]h:mm."
(setq day-numbers (nreverse day-numbers))
(setq clocktable-start (car day-numbers)
clocktable-end (1+ (or (org-last day-numbers) 0)))
- (org-set-local 'org-starting-day (car day-numbers))
- (org-set-local 'org-arg-loc arg)
- (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
+ (setq-local org-starting-day (car day-numbers))
+ (setq-local org-arg-loc arg)
+ (setq-local org-agenda-current-span (org-agenda-ndays-to-span span))
(unless org-agenda-compact-blocks
(let* ((d1 (car day-numbers))
(d2 (org-last day-numbers))
@@ -4392,10 +4391,10 @@ START-DAY is an absolute time value."
((eq span 'fortnight) 14)
((eq span 'month)
(let ((date (calendar-gregorian-from-absolute start-day)))
- (calendar-last-day-of-month (car date) (caddr date))))
+ (calendar-last-day-of-month (car date) (cl-caddr date))))
((eq span 'year)
(let ((date (calendar-gregorian-from-absolute start-day)))
- (if (calendar-leap-year-p (caddr date)) 366 365)))))
+ (if (calendar-leap-year-p (cl-caddr date)) 366 365)))))
(defun org-agenda-span-name (span)
"Return a SPAN name."
@@ -4410,7 +4409,7 @@ START-DAY is an absolute time value."
(defvar org-agenda-search-history nil)
(defvar org-search-syntax-table nil
- "Special syntax table for org-mode search.
+ "Special syntax table for Org search.
In this table, we have single quotes not as word constituents, to
that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
@@ -4727,7 +4726,7 @@ Press `\\[org-agenda-manipulate-query-add]', \
(defun org-todo-list (&optional arg)
"Show all (not done) TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
-the list to these. When using \\[universal-argument], you will be prompted
+the list to these. When using `\\[universal-argument]', you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'."
(interactive "P")
@@ -4745,8 +4744,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
rtn rtnall files file pos)
(when (equal arg '(4))
(setq org-select-this-todo-keyword
- (org-icompleting-read "Keyword (or KWD1|K2D2|...): "
- (mapcar 'list kwds) nil nil)))
+ (completing-read "Keyword (or KWD1|K2D2|...): "
+ (mapcar #'list kwds) nil nil)))
(and (equal 0 arg) (setq org-select-this-todo-keyword nil))
(catch 'exit
(if org-agenda-sticky
@@ -4835,14 +4834,17 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
;; Prepare agendas (and `org-tag-alist-for-agenda') before
;; expanding tags within `org-make-tags-matcher'
(org-agenda-prepare (concat "TAGS " match))
- (setq matcher (org-make-tags-matcher match)
- match (car matcher) matcher (cdr matcher))
+ (setq org--matcher-tags-todo-only todo-only
+ matcher (org-make-tags-matcher match)
+ match (car matcher)
+ matcher (cdr matcher))
(org-compile-prefix-format 'tags)
(org-set-sorting-strategy 'tags)
(setq org-agenda-query-string match)
(setq org-agenda-redo-command
- (list 'org-tags-view `(quote ,todo-only)
- (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string))))
+ (list 'org-tags-view
+ `(quote ,org--matcher-tags-todo-only)
+ `(if current-prefix-arg nil ,org-agenda-query-string)))
(setq files (org-agenda-files nil 'ifmode)
rtnall nil)
(while (setq file (pop files))
@@ -4865,7 +4867,9 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
- (setq rtn (org-scan-tags 'agenda matcher todo-only))
+ (setq rtn (org-scan-tags 'agenda
+ matcher
+ org--matcher-tags-todo-only))
(setq rtnall (append rtnall rtn))))))))
(if org-agenda-overriding-header
(insert (org-add-props (copy-sequence org-agenda-overriding-header)
@@ -4883,17 +4887,19 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(insert (substitute-command-keys
"Press `\\[universal-argument] \\[org-agenda-redo]' \
to search again with new search string\n")))
- (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+ (add-text-properties pos (1- (point))
+ (list 'face 'org-agenda-structure)))
(org-agenda-mark-header-line (point-min))
(when rtnall
(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (add-text-properties (point-min) (point-max)
- `(org-agenda-type tags
- org-last-args (,todo-only ,match)
- org-redo-cmd ,org-agenda-redo-command
- org-series-cmd ,org-cmd))
+ (add-text-properties
+ (point-min) (point-max)
+ `(org-agenda-type tags
+ org-last-args (,org--matcher-tags-todo-only ,match)
+ org-redo-cmd ,org-agenda-redo-command
+ org-series-cmd ,org-cmd))
(org-agenda-finalize)
(setq buffer-read-only t))))
@@ -5102,12 +5108,12 @@ of what a project is and how to check if it stuck, customize the variable
(tags (nth 2 org-stuck-projects))
(tags-re (if (member "*" tags)
(concat org-outline-regexp-bol
- (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$"))
+ ".*:[[:alnum:]_@#%]+:[ \t]*$")
(if tags
(concat org-outline-regexp-bol
".*:\\("
- (mapconcat 'identity tags "\\|")
- (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$")))))
+ (mapconcat #'identity tags "\\|")
+ "\\):[[:alnum:]_@#%:]*[ \t]*$"))))
(gen-re (nth 3 org-stuck-projects))
(re-list
(delq nil
@@ -5202,7 +5208,7 @@ date. It also removes lines that contain only whitespace."
(while (re-search-forward "^ +\n" nil t)
(replace-match ""))
(goto-char (point-min))
- (if (re-search-forward "^Org-mode dummy\n?" nil t)
+ (if (re-search-forward "^Org mode dummy\n?" nil t)
(replace-match ""))
(run-hooks 'org-agenda-cleanup-fancy-diary-hook))
@@ -5220,7 +5226,7 @@ date. It also removes lines that contain only whitespace."
(setq string (org-modify-diary-entry-string string))))))
(defun org-modify-diary-entry-string (string)
- "Add text properties to string, allowing org-mode to act on it."
+ "Add text properties to string, allowing Org to act on it."
(org-add-props string nil
'mouse-face 'highlight
'help-echo (if buffer-file-name
@@ -5236,9 +5242,9 @@ Needed to avoid empty dates which mess up holiday display."
;; Catch the error if dealing with the new add-to-diary-alist
(when org-disable-agenda-to-diary
(condition-case nil
- (org-add-to-diary-list original-date "Org-mode dummy" "")
+ (org-add-to-diary-list original-date "Org mode dummy" "")
(error
- (org-add-to-diary-list original-date "Org-mode dummy" "" nil)))))
+ (org-add-to-diary-list original-date "Org mode dummy" "" nil)))))
(defun org-add-to-diary-list (&rest args)
(if (fboundp 'diary-add-to-list)
@@ -5274,7 +5280,7 @@ So the example above may also be written as
The function expects the lisp variables `entry' and `date' to be provided
by the caller, because this is how the calendar works. Don't use this
function from a program - use `org-agenda-get-day-entries' instead."
- (when (> (- (org-float-time)
+ (when (> (- (float-time)
org-agenda-last-marker-time)
5)
;; I am not sure if this works with sticky agendas, because the marker
@@ -5286,7 +5292,7 @@ function from a program - use `org-agenda-get-day-entries' instead."
(let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
(list entry)
(org-agenda-files t)))
- (time (org-float-time))
+ (time (float-time))
file rtn results)
(when (or (not org-diary-last-run-time)
(> (- time
@@ -5308,67 +5314,77 @@ function from a program - use `org-agenda-get-day-entries' instead."
;;; Agenda entry finders
+(defun org-agenda--timestamp-to-absolute (&rest args)
+ "Call `org-time-string-to-absolute' with ARGS.
+However, throw `:skip' whenever an error is raised."
+ (condition-case e
+ (apply #'org-time-string-to-absolute args)
+ (org-diary-sexp-no-match (throw :skip nil))
+ (error
+ (message "%s; Skipping entry" (error-message-string e))
+ (throw :skip nil))))
+
(defun org-agenda-get-day-entries (file date &rest args)
"Does the work for `org-diary' and `org-agenda'.
FILE is the path to a file to be checked for entries. DATE is date like
the one returned by `calendar-current-date'. ARGS are symbols indicating
which kind of entries should be extracted. For details about these, see
the documentation of `org-diary'."
- (setq args (or args org-agenda-entry-types))
(let* ((org-startup-folded nil)
(org-startup-align-all-tables nil)
- (buffer (if (file-exists-p file)
- (org-get-agenda-file-buffer file)
- (error "No such file %s" file)))
- arg results rtn deadline-results)
+ (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file)
+ (error "No such file %s" file))))
(if (not buffer)
- ;; If file does not exist, make sure an error message ends up in diary
+ ;; If file does not exist, signal it in diary nonetheless.
(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
(with-current-buffer buffer
(unless (derived-mode-p 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(setq org-agenda-buffer (or org-agenda-buffer buffer))
- (let ((case-fold-search nil))
- (save-excursion
- (save-restriction
- (if (eq buffer org-agenda-restrict)
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- ;; The way we repeatedly append to `results' makes it O(n^2) :-(
- (while (setq arg (pop args))
- (cond
- ((and (eq arg :todo)
- (equal date (calendar-gregorian-from-absolute
- (org-today))))
- (setq rtn (org-agenda-get-todos))
- (setq results (append results rtn)))
- ((eq arg :timestamp)
- (setq rtn (org-agenda-get-blocks))
- (setq results (append results rtn))
- (setq rtn (org-agenda-get-timestamps deadline-results))
- (setq results (append results rtn)))
- ((eq arg :sexp)
- (setq rtn (org-agenda-get-sexps))
- (setq results (append results rtn)))
- ((eq arg :scheduled)
- (setq rtn (org-agenda-get-scheduled deadline-results))
- (setq results (append results rtn)))
- ((eq arg :scheduled*)
- (setq rtn (org-agenda-get-scheduled deadline-results t))
- (setq results (append results rtn)))
- ((eq arg :closed)
- (setq rtn (org-agenda-get-progress))
- (setq results (append results rtn)))
- ((eq arg :deadline)
- (setq rtn (org-agenda-get-deadlines))
- (setq deadline-results (copy-sequence rtn))
- (setq results (append results rtn)))
- ((eq arg :deadline*)
- (setq rtn (org-agenda-get-deadlines t))
- (setq deadline-results (copy-sequence rtn))
- (setq results (append results rtn))))))))
- results))))
+ (setf org-agenda-current-date date)
+ (save-excursion
+ (save-restriction
+ (if (eq buffer org-agenda-restrict)
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end)
+ (widen))
+ ;; Rationalize ARGS. Also make sure `:deadline' comes
+ ;; first in order to populate DEADLINES before passing it.
+ ;;
+ ;; We use `delq' since `org-uniquify' duplicates ARGS,
+ ;; guarding us from modifying `org-agenda-entry-types'.
+ (setf args (org-uniquify (or args org-agenda-entry-types)))
+ (when (and (memq :scheduled args) (memq :scheduled* args))
+ (setf args (delq :scheduled* args)))
+ (cond
+ ((memq :deadline args)
+ (setf args (cons :deadline
+ (delq :deadline (delq :deadline* args)))))
+ ((memq :deadline* args)
+ (setf args (cons :deadline* (delq :deadline* args)))))
+ ;; Collect list of headlines. Return them flattened.
+ (let ((case-fold-search nil) results deadlines)
+ (dolist (arg args (apply #'nconc (nreverse results)))
+ (pcase arg
+ ((and :todo (guard (org-agenda-today-p date)))
+ (push (org-agenda-get-todos) results))
+ (:timestamp
+ (push (org-agenda-get-blocks) results)
+ (push (org-agenda-get-timestamps deadlines) results))
+ (:sexp
+ (push (org-agenda-get-sexps) results))
+ (:scheduled
+ (push (org-agenda-get-scheduled deadlines) results))
+ (:scheduled*
+ (push (org-agenda-get-scheduled deadlines t) results))
+ (:closed
+ (push (org-agenda-get-progress) results))
+ (:deadline
+ (setf deadlines (org-agenda-get-deadlines))
+ (push deadlines results))
+ (:deadline*
+ (setf deadlines (org-agenda-get-deadlines t))
+ (push deadlines results)))))))))))
(defsubst org-em (x y list)
"Is X or Y a member of LIST?"
@@ -5524,7 +5540,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(cond
((memq org-agenda-todo-ignore-deadlines '(t all)) t)
((eq org-agenda-todo-ignore-deadlines 'far)
- (not (org-deadline-close (match-string 1))))
+ (not (org-deadline-close-p (match-string 1))))
((eq org-agenda-todo-ignore-deadlines 'future)
(> (org-time-stamp-to-now
(match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
@@ -5534,7 +5550,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
((numberp org-agenda-todo-ignore-deadlines)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-deadlines))
- (t (org-deadline-close (match-string 1)))))
+ (t (org-deadline-close-p (match-string 1)))))
(and org-agenda-todo-ignore-timestamp
(let ((buffer (current-buffer))
(regexp
@@ -5610,7 +5626,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(and (org-at-date-range-p) (throw :skip nil))
(org-agenda-skip)
(if (and (match-end 1)
- (not (= d1 (org-time-string-to-absolute
+ (not (= d1 (org-agenda--timestamp-to-absolute
(match-string 1) d1 nil show-all
(current-buffer) b0))))
(throw :skip nil))
@@ -5656,8 +5672,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(memq 'agenda org-agenda-use-tag-inheritance))))
tags (org-get-tags-at nil (not inherited-tags))
level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
- (setq head (or (match-string 1) ""))
+ (looking-at "\\*+[ \t]+\\(.*\\)")
+ (setq head (match-string 1))
(setq txt (org-agenda-format-item
(if inactivep org-agenda-inactive-leader nil)
head level category tags timestr
@@ -5737,29 +5753,26 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
;; Calendar sanity: define some functions that are independent of
;; `calendar-date-style'.
-;; Normally I would like to use ISO format when calling the diary functions,
-;; but to make sure we still have Emacs 22 compatibility we bind
-;; also `european-calendar-style' and use european format
(defun org-anniversary (year month day &optional mark)
"Like `diary-anniversary', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-anniversary day month year mark))))
+ (with-no-warnings
+ (let ((calendar-date-style 'iso))
+ (diary-anniversary year month day mark))))
(defun org-cyclic (N year month day &optional mark)
"Like `diary-cyclic', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-cyclic N day month year mark))))
+ (with-no-warnings
+ (let ((calendar-date-style 'iso))
+ (diary-cyclic N year month day mark))))
(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
"Like `diary-block', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-block D1 M1 Y1 D2 M2 Y2 mark))))
+ (with-no-warnings
+ (let ((calendar-date-style 'iso))
+ (diary-block Y1 M1 D1 Y2 M2 D2 mark))))
(defun org-date (year month day &optional mark)
"Like `diary-date', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-date day month year mark))))
+ (with-no-warnings
+ (let ((calendar-date-style 'iso))
+ (diary-date year month day mark))))
;; Define the `org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
@@ -5786,26 +5799,6 @@ then those holidays will be skipped."
(delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
entry)))
-(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
- "Like `org-class', but honor `calendar-date-style'.
-The order of the first 2 times 3 arguments depends on the variable
-`calendar-date-style' or, if that is not defined, on `european-calendar-style'.
-So for American calendars, give this as MONTH DAY YEAR, for European as
-DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
-DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
-is any number of ISO weeks in the block period for which the item should
-be skipped.
-
-This function is here only for backward compatibility and it is deprecated,
-please use `org-class' instead."
- (let* ((date1 (org-order-calendar-date-args m1 d1 y1))
- (date2 (org-order-calendar-date-args m2 d2 y2)))
- (org-class
- (nth 2 date1) (car date1) (nth 1 date1)
- (nth 2 date2) (car date2) (nth 1 date2)
- dayname skip-weeks)))
-(make-obsolete 'org-diary-class 'org-class "")
-
(defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display."
@@ -5919,7 +5912,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
(re (concat "^[ \t]*"
org-clock-string
"[ \t]+"
- "\\(\\[.*?\\]\\)" ; group 1 is first stamp
+ "\\(\\[.*?\\]\\)" ; group 1 is first stamp
"\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
(tlstart 0.)
(tlend 0.)
@@ -5955,10 +5948,10 @@ See also the user option `org-agenda-clock-consistency-checks'."
(throw 'next t))
(setq ts (match-string 1)
te (match-string 3)
- ts (org-float-time
- (apply 'encode-time (org-parse-time-string ts)))
- te (org-float-time
- (apply 'encode-time (org-parse-time-string te)))
+ ts (float-time
+ (apply #'encode-time (org-parse-time-string ts)))
+ te (float-time
+ (apply #'encode-time (org-parse-time-string te)))
dt (- te ts))))
(cond
((> dt (* 60 maxtime))
@@ -6044,123 +6037,124 @@ specification like [h]h:mm."
(regexp (if with-hour
org-deadline-time-hour-regexp
org-deadline-time-regexp))
- (todayp (org-agenda-todayp date)) ; DATE bound by calendar
- (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- (dl0 (car org-agenda-deadline-leaders))
- (dl1 (nth 1 org-agenda-deadline-leaders))
- (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1))
- d2 diff dfrac wdays pos pos1 category level
- tags suppress-prewarning ee txt head face s todo-state
- show-all upcomingp donep timestr warntime inherited-tags ts-date)
+ (todayp (org-agenda-today-p date)) ; DATE bound by calendar.
+ (current (calendar-absolute-from-gregorian date))
+ deadline-items)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
+ (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
(org-agenda-skip)
- (setq s (match-string 1)
- txt nil
- pos (1- (match-beginning 1))
- todo-state (save-match-data (org-get-todo-state))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all))
- d2 (org-time-string-to-absolute
- s d1 'past show-all (current-buffer) pos)
- diff (- d2 d1))
- (setq suppress-prewarning
- (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled
- (let ((item (buffer-substring (point-at-bol)
- (point-at-eol))))
- (save-match-data
- (and (string-match
- org-scheduled-time-regexp item)
- (match-string 1 item)))))))
- (cond
- ((not ds) nil)
- ;; The current item has a scheduled date (in ds), so
- ;; evaluate its prewarning lead time.
- ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
- ;; Use global prewarning-restart lead time.
- org-agenda-skip-deadline-prewarning-if-scheduled)
- ((eq org-agenda-skip-deadline-prewarning-if-scheduled
- 'pre-scheduled)
- ;; Set prewarning to no earlier than scheduled.
- (min (- d2 (org-time-string-to-absolute
- ds d1 'past show-all (current-buffer) pos))
- org-deadline-warning-days))
- ;; Set prewarning to deadline.
- (t 0))))
- (setq wdays (if suppress-prewarning
- (let ((org-deadline-warning-days suppress-prewarning))
- (org-get-wdays s))
- (org-get-wdays s))
- dfrac (- 1 (/ (* 1.0 diff) (max wdays 1)))
- upcomingp (and todayp (> diff 0)))
- ;; When to show a deadline in the calendar:
- ;; If the expiration is within wdays warning time.
- ;; Past-due deadlines are only shown on the current date
- (if (and (or (and (<= diff wdays)
- (and todayp (not org-agenda-only-exact-dates)))
- (= diff 0)))
- (save-excursion
- ;; (setq todo-state (org-get-todo-state))
- (setq donep (member todo-state org-done-keywords))
- (if (and donep
- (or org-agenda-skip-deadline-if-done
- (not (= diff 0))))
- (setq txt nil)
- (setq category (org-get-category)
- warntime (get-text-property (point) 'org-appt-warntime))
- (if (not (re-search-backward "^\\*+[ \t]+" nil t))
- (throw :skip nil)
- (goto-char (match-end 0))
- (setq pos1 (match-beginning 0))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (setq inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at pos1 (not inherited-tags)))
- (setq head (buffer-substring
- (point)
- (progn (skip-chars-forward "^\r\n")
- (point))))
- (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (setq timestr
- (concat (substring s (match-beginning 1)) " "))
- (setq timestr 'time))
- (setq txt (org-agenda-format-item
- (cond ((= diff 0) dl0)
- ((> diff 0)
- (if (functionp dl1)
- (funcall dl1 diff date)
- (format dl1 diff)))
- (t
- (if (functionp dl2)
- (funcall dl2 diff date)
- (format dl2 (if (string= dl2 dl1)
- diff (abs diff))))))
- head level category tags
- (if (not (= diff 0)) nil timestr)))))
- (when txt
- (setq face (org-agenda-deadline-face dfrac))
- (org-add-props txt props
- 'org-marker (org-agenda-new-marker pos)
- 'warntime warntime
- 'level level
- 'ts-date d2
- 'org-hd-marker (org-agenda-new-marker pos1)
- 'priority (+ (- diff)
- (org-get-priority txt))
- 'todo-state todo-state
- 'type (if upcomingp "upcoming-deadline" "deadline")
- 'date (if upcomingp date d2)
- 'face (if donep 'org-agenda-done face)
- 'undone-face face 'done-face 'org-agenda-done)
- (push txt ee))))))
- (nreverse ee)))
+ (let* ((s (match-string 1))
+ (pos (1- (match-beginning 1)))
+ (todo-state (save-match-data (org-get-todo-state)))
+ (donep (member todo-state org-done-keywords))
+ (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
+ (member todo-state
+ org-agenda-repeating-timestamp-show-all)))
+ ;; DEADLINE is the current scheduled date. When it
+ ;; contains a repeater and SHOW-ALL is non-nil,
+ ;; LAST-REPEAT is the repeat closest to CURRENT.
+ ;; Otherwise, LAST-REPEAT is equal to DEADLINE.
+ (last-repeat (org-agenda--timestamp-to-absolute
+ s current 'past show-all (current-buffer) pos))
+ (deadline (org-agenda--timestamp-to-absolute s current))
+ (diff (- last-repeat current))
+ (suppress-prewarning
+ (let ((scheduled
+ (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (org-entry-get nil "SCHEDULED"))))
+ (cond
+ ((not scheduled) nil)
+ ;; The current item has a scheduled date, so
+ ;; evaluate its prewarning lead time.
+ ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
+ ;; Use global prewarning-restart lead time.
+ org-agenda-skip-deadline-prewarning-if-scheduled)
+ ((eq org-agenda-skip-deadline-prewarning-if-scheduled
+ 'pre-scheduled)
+ ;; Set pre-warning to no earlier than SCHEDULED.
+ (min (- last-repeat
+ (org-agenda--timestamp-to-absolute
+ scheduled current 'past show-all
+ (current-buffer)
+ (save-excursion
+ (beginning-of-line)
+ (1+ (search-forward org-deadline-string)))))
+ org-deadline-warning-days))
+ ;; Set pre-warning to deadline.
+ (t 0))))
+ (wdays (if suppress-prewarning
+ (let ((org-deadline-warning-days suppress-prewarning))
+ (org-get-wdays s))
+ (org-get-wdays s))))
+ ;; When to show a deadline in the calendar: if the
+ ;; expiration is within WDAYS warning time. Past-due
+ ;; deadlines are only shown on the current date
+ (unless (or (and (<= diff wdays)
+ (and todayp (not org-agenda-only-exact-dates)))
+ (= diff 0))
+ (throw :skip nil))
+ ;; Skip done tasks if `org-agenda-skip-deadline-if-done' is
+ ;; non-nil or if it isn't applicable to CURRENT deadline.
+ (when (and donep
+ (or org-agenda-skip-deadline-if-done
+ (/= deadline current)))
+ (throw :skip nil))
+ (save-excursion
+ (re-search-backward "^\\*+[ \t]+" nil t)
+ (goto-char (match-end 0))
+ (let* ((category (org-get-category))
+ (level
+ (make-string (org-reduced-level (org-outline-level)) ?\s))
+ (head (buffer-substring (point) (line-end-position)))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'agenda
+ org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags-at nil (not inherited-tags)))
+ (timestr
+ (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " ")
+ 'time))
+ (item
+ (org-agenda-format-item
+ ;; For past deadlines, make sure to report time
+ ;; difference since date S, not since closest
+ ;; repeater.
+ (let ((diff (if (< (org-today) current) diff
+ (- deadline current))))
+ (if (= diff 0) (car org-agenda-deadline-leaders)
+ (let ((future (nth 1 org-agenda-deadline-leaders))
+ (past (nth 2 org-agenda-deadline-leaders)))
+ (cond ((> diff 0) (format future diff))
+ ((string= future past) (format past diff))
+ (t (format past (abs diff)))))))
+ head level category tags
+ (and (= diff 0) timestr)))
+ (face (org-agenda-deadline-face
+ (- 1 (/ (float (- deadline current)) (max wdays 1)))))
+ (upcomingp (and todayp (> diff 0)))
+ (warntime (get-text-property (point) 'org-appt-warntime)))
+ (org-add-props item props
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
+ 'warntime warntime
+ 'level level
+ 'ts-date deadline
+ 'priority (- (org-get-priority item) diff)
+ 'todo-state todo-state
+ 'type (if upcomingp "upcoming-deadline" "deadline")
+ 'date (if upcomingp date deadline)
+ 'face (if donep 'org-agenda-done face)
+ 'undone-face face
+ 'done-face 'org-agenda-done)
+ (push item deadline-items))))))
+ (nreverse deadline-items)))
(defun org-agenda-deadline-face (fraction)
"Return the face to displaying a deadline item.
@@ -6170,10 +6164,11 @@ FRACTION is what fraction of the head-warning time has passed."
(while (setq f (pop faces))
(if (>= fraction (car f)) (throw 'exit (cdr f)))))))
-(defun org-agenda-get-scheduled (&optional deadline-results with-hour)
+(defun org-agenda-get-scheduled (&optional deadlines with-hour)
"Return the scheduled information for agenda display.
-When WITH-HOUR is non-nil, only return scheduled items with
-an hour specification like [h]h:mm."
+Optional argument DEADLINES is a list of deadline items to be
+displayed in agenda view. When WITH-HOUR is non-nil, only return
+scheduled items with an hour specification like [h]h:mm."
(let* ((props (list 'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
@@ -6185,165 +6180,167 @@ an hour specification like [h]h:mm."
(regexp (if with-hour
org-scheduled-time-hour-regexp
org-scheduled-time-regexp))
- (todayp (org-agenda-todayp date)) ; DATE bound by calendar
- (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- mm
- (deadline-position-alist
- (mapcar (lambda (a) (and (setq mm (get-text-property
- 0 'org-hd-marker a))
- (cons (marker-position mm) a)))
- deadline-results))
- d2 diff pos pos1 category level tags donep
- ee txt head pastschedp todo-state face timestr s habitp show-all
- did-habit-check-p warntime inherited-tags ts-date suppress-delay
- ddays)
+ (todayp (org-agenda-today-p date)) ; DATE bound by calendar.
+ (current (calendar-absolute-from-gregorian date))
+ (deadline-pos
+ (mapcar (lambda (d)
+ (let ((m (get-text-property 0 'org-hd-marker d)))
+ (and m (marker-position m))))
+ deadlines))
+ scheduled-items)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
+ (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
(org-agenda-skip)
- (setq s (match-string 1)
- txt nil
- pos (1- (match-beginning 1))
- todo-state (save-match-data (org-get-todo-state))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all))
- d2 (org-time-string-to-absolute
- s d1 'past show-all (current-buffer) pos)
- diff (- d2 d1)
- warntime (get-text-property (point) 'org-appt-warntime))
- (setq pastschedp (and todayp (< diff 0)))
- (setq did-habit-check-p nil)
- (setq suppress-delay
- (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline
- (let ((item (buffer-substring (point-at-bol) (point-at-eol))))
- (save-match-data
- (and (string-match
- org-deadline-time-regexp item)
- (match-string 1 item)))))))
+ (let* ((s (match-string 1))
+ (pos (1- (match-beginning 1)))
+ (todo-state (save-match-data (org-get-todo-state)))
+ (donep (member todo-state org-done-keywords))
+ (show-all (or (eq org-agenda-repeating-timestamp-show-all t)
+ (member todo-state
+ org-agenda-repeating-timestamp-show-all)))
+ ;; SCHEDULE is the current scheduled date. When it
+ ;; contains a repeater and SHOW-ALL is non-nil,
+ ;; LAST-REPEAT is the repeat closest to CURRENT.
+ ;; Otherwise, LAST-REPEAT is equal to SCHEDULE.
+ (last-repeat (org-agenda--timestamp-to-absolute
+ s current 'past show-all (current-buffer) pos))
+ (schedule (org-agenda--timestamp-to-absolute s current))
+ (diff (- last-repeat current))
+ (warntime (get-text-property (point) 'org-appt-warntime))
+ (pastschedp (< schedule (org-today)))
+ (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
+ (suppress-delay
+ (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
+ (org-entry-get nil "DEADLINE"))))
+ (cond
+ ((not deadline) nil)
+ ;; The current item has a deadline date, so
+ ;; evaluate its delay time.
+ ((integerp org-agenda-skip-scheduled-delay-if-deadline)
+ ;; Use global delay time.
+ (- org-agenda-skip-scheduled-delay-if-deadline))
+ ((eq org-agenda-skip-scheduled-delay-if-deadline
+ 'post-deadline)
+ ;; Set delay to no later than DEADLINE. If
+ ;; DEADLINE has a repeater, compare last schedule
+ ;; repeat and last deadline repeat.
+ (min (- last-repeat
+ (org-agenda--timestamp-to-absolute
+ deadline current 'past show-all
+ (current-buffer)
+ (save-excursion
+ (beginning-of-line)
+ (1+ (search-forward org-deadline-string)))))
+ org-scheduled-delay-days))
+ (t 0))))
+ (ddays
(cond
- ((not ds) nil)
- ;; The current item has a deadline date (in ds), so
- ;; evaluate its delay time.
- ((integerp org-agenda-skip-scheduled-delay-if-deadline)
- ;; Use global delay time.
- (- org-agenda-skip-scheduled-delay-if-deadline))
- ((eq org-agenda-skip-scheduled-delay-if-deadline
- 'post-deadline)
- ;; Set delay to no later than deadline.
- (min (- d2 (org-time-string-to-absolute
- ds d1 'past show-all (current-buffer) pos))
- org-scheduled-delay-days))
- (t 0))))
- (setq ddays (if suppress-delay
- (let ((org-scheduled-delay-days suppress-delay))
- (org-get-wdays s t t))
- (org-get-wdays s t)))
- ;; Use a delay of 0 when there is a repeater and the delay is
- ;; of the form --3d
- (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s))
- (< (org-time-string-to-absolute s)
- (org-time-string-to-absolute
- s d2 'past nil (current-buffer) pos)))
- (setq ddays 0))
- ;; When to show a scheduled item in the calendar:
- ;; If it is on or past the date.
- (when (or (and (> ddays 0) (= diff (- ddays)))
- (and (zerop ddays) (= diff 0))
- (and (< (+ diff ddays) 0)
- (< (abs diff) org-scheduled-past-days)
- (and todayp (not org-agenda-only-exact-dates)))
- ;; org-is-habit-p uses org-entry-get, which is expansive
- ;; so we go extra mile to only call it once
- (and todayp
- (boundp 'org-habit-show-all-today)
- org-habit-show-all-today
- (setq did-habit-check-p t)
- (setq habitp (and (functionp 'org-is-habit-p)
- (org-is-habit-p)))))
- (save-excursion
- (setq donep (member todo-state org-done-keywords))
- (if (and donep
+ ;; Nullify delay when a repeater triggered already
+ ;; and the delay is of the form --Xd.
+ ((and (string-match-p "--[0-9]+[hdwmy]" s)
+ (/= schedule last-repeat))
+ 0)
+ (suppress-delay
+ (let ((org-scheduled-delay-days suppress-delay))
+ (org-get-wdays s t t)))
+ (t (org-get-wdays s t)))))
+ ;; Only show a scheduled item in the calendar if it is on or
+ ;; past the current date. Skip it if it has been displayed
+ ;; for more than `org-scheduled-past-days'.
+ (unless (or (and (>= ddays 0) (= diff (- ddays)))
+ (and (< (+ diff ddays) 0)
+ (< (abs diff) org-scheduled-past-days)
+ (and todayp (not org-agenda-only-exact-dates)))
+ (and todayp
+ habitp
+ (bound-and-true-p org-habit-show-all-today)))
+ (throw :skip nil))
+ ;; Skip done habits, or tasks if
+ ;; `org-agenda-skip-deadline-if-done' is non-nil or if it
+ ;; was scheduled in the past anyway.
+ (when (and donep
(or org-agenda-skip-scheduled-if-done
- (not (= diff 0))
- (and (functionp 'org-is-habit-p)
- (org-is-habit-p))))
- (setq txt nil)
- (setq habitp (if did-habit-check-p habitp
- (and (functionp 'org-is-habit-p)
- (org-is-habit-p))))
- (setq category (org-get-category))
- (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
- 'repeated-after-deadline)
- (org-get-deadline-time (point))
- (<= 0 (- d2 (time-to-days (org-get-deadline-time (point))))))
- (throw :skip nil))
- (if (not (re-search-backward "^\\*+[ \t]+" nil t))
- (throw :skip nil)
- (goto-char (match-end 0))
- (setq pos1 (match-beginning 0))
- (if habitp
- (if (or (not org-habit-show-habits)
- (and (not todayp)
- (boundp 'org-habit-show-habits-only-for-today)
- org-habit-show-habits-only-for-today))
- (throw :skip nil))
- (if (and
- (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown)
- (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
- pastschedp))
- (setq mm (assoc pos1 deadline-position-alist)))
- (throw :skip nil)))
- (setq inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda org-agenda-use-tag-inheritance))))
-
- tags (org-get-tags-at nil (not inherited-tags)))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (setq head (buffer-substring
- (point)
- (progn (skip-chars-forward "^\r\n") (point))))
- (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (setq timestr
- (concat (substring s (match-beginning 1)) " "))
- (setq timestr 'time))
- (setq txt (org-agenda-format-item
- (if (= diff 0)
- (car org-agenda-scheduled-leaders)
- (format (nth 1 org-agenda-scheduled-leaders)
- (- 1 diff)))
- head level category tags
- (if (not (= diff 0)) nil timestr)
- nil habitp))))
- (when txt
- (setq face
- (cond
- ((and (not habitp) pastschedp)
- 'org-scheduled-previously)
- (todayp 'org-scheduled-today)
- (t 'org-scheduled))
- habitp (and habitp (org-habit-parse-todo)))
- (org-add-props txt props
+ (/= schedule current)
+ habitp))
+ (throw :skip nil))
+ ;; Skip entry if it already appears as a deadline, per
+ ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
+ ;; doesn't apply to habits.
+ (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
+ ((guard
+ (or (not (memq (line-beginning-position 0) deadline-pos))
+ habitp))
+ nil)
+ (`repeated-after-deadline
+ (>= last-repeat
+ (time-to-days (org-get-deadline-time (point)))))
+ (`not-today pastschedp)
+ (`t t)
+ (_ nil))
+ (throw :skip nil))
+ ;; Skip habits if `org-habit-show-habits' is nil, or if we
+ ;; only show them for today.
+ (when (and habitp
+ (or (not (bound-and-true-p org-habit-show-habits))
+ (and (not todayp)
+ (bound-and-true-p
+ org-habit-show-habits-only-for-today))))
+ (throw :skip nil))
+ (save-excursion
+ (re-search-backward "^\\*+[ \t]+" nil t)
+ (goto-char (match-end 0))
+ (let* ((category (org-get-category))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (and (eq org-agenda-show-inherited-tags t)
+ (or (eq org-agenda-use-tag-inheritance t)
+ (memq 'agenda
+ org-agenda-use-tag-inheritance)))))
+ (tags (org-get-tags-at nil (not inherited-tags)))
+ (level
+ (make-string (org-reduced-level (org-outline-level)) ?\s))
+ (head (buffer-substring (point) (line-end-position)))
+ (timestr
+ (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " ")
+ 'time))
+ (item (org-agenda-format-item
+ ;; For past scheduled dates, make sure to
+ ;; report time difference since SCHEDULE,
+ ;; not since closest repeater.
+ (let ((diff (if (< (org-today) current) diff
+ (- schedule current))))
+ (if (= diff 0) (car org-agenda-scheduled-leaders)
+ (format (nth 1 org-agenda-scheduled-leaders)
+ (- 1 diff))))
+ head level category tags
+ (and (= diff 0) timestr)
+ nil habitp))
+ (face (cond ((and (not habitp) pastschedp)
+ 'org-scheduled-previously)
+ (todayp 'org-scheduled-today)
+ (t 'org-scheduled)))
+ (habitp (and habitp (org-habit-parse-todo))))
+ (org-add-props item props
'undone-face face
'face (if donep 'org-agenda-done face)
'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker pos1)
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
'type (if pastschedp "past-scheduled" "scheduled")
- 'date (if pastschedp d2 date)
- 'ts-date d2
+ 'date (if pastschedp schedule date)
+ 'ts-date schedule
'warntime warntime
'level level
- 'priority (if habitp
- (org-habit-get-priority habitp)
- (+ 94 (- 5 diff) (org-get-priority txt)))
+ 'priority (if habitp (org-habit-get-priority habitp)
+ (+ 94 (- 5 diff) (org-get-priority item)))
'org-habit-p habitp
'todo-state todo-state)
- (push txt ee))))))
- (nreverse ee)))
+ (push item scheduled-items))))))
+ (nreverse scheduled-items)))
(defun org-agenda-get-blocks ()
"Return the date-range information for agenda display."
@@ -6394,7 +6391,7 @@ an hour specification like [h]h:mm."
tags (org-get-tags-at nil (not inherited-tags)))
(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
+ (looking-at "\\*+[ \t]+\\(.*\\)")
(setq head (match-string 1))
(let ((remove-re
(if org-agenda-remove-timeranges-from-blocks
@@ -6449,10 +6446,10 @@ The flag is set if the currently compiled format contains a `%b'.")
(defun org-agenda-get-category-icon (category)
"Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
(dolist (entry org-agenda-category-icon-alist)
- (when (org-string-match-p (car entry) category)
+ (when (string-match-p (car entry) category)
(if (listp (cadr entry))
- (return (cadr entry))
- (return (apply 'create-image (cdr entry)))))))
+ (cl-return (cadr entry))
+ (cl-return (apply #'create-image (cdr entry)))))))
(defun org-agenda-format-item (extra txt &optional level category tags dotime
remove-re habitp)
@@ -6479,8 +6476,8 @@ Any match of REMOVE-RE will be removed from TXT."
;; buffer
(let* ((bindings (car org-prefix-format-compiled))
(formatter (cadr org-prefix-format-compiled)))
- (loop for (var value) in bindings
- do (set var value))
+ (cl-loop for (var value) in bindings
+ do (set var value))
(save-match-data
;; Diary entries sometimes have extra whitespace at the beginning
(setq txt (org-trim txt))
@@ -6550,8 +6547,7 @@ Any match of REMOVE-RE will be removed from TXT."
(setq duration (- (org-hh:mm-string-to-minutes s2)
(org-hh:mm-string-to-minutes s1)))))
- (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
- txt)
+ (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
;; Tags are in the string
(if (or (eq org-agenda-remove-tags t)
(and org-agenda-remove-tags
@@ -6626,7 +6622,7 @@ Any match of REMOVE-RE will be removed from TXT."
The modified list may contain inherited tags, and tags matched by
`org-agenda-hide-tags-regexp' will be removed."
(when (or add-inherited hide-re)
- (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt)
+ (if (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
(setq txt (substring txt 0 (match-beginning 0))))
(setq tags
(delq nil
@@ -6731,12 +6727,12 @@ and stored in the variable `org-prefix-format-compiled'."
c (or (match-string 3 s) "")
opt (match-beginning 1)
start (1+ (match-beginning 0)))
- (if (equal var 'time) (setq org-prefix-has-time t))
- (if (equal var 'tag) (setq org-prefix-has-tag t))
- (if (equal var 'effort) (setq org-prefix-has-effort t))
- (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
+ (if (eq var 'time) (setq org-prefix-has-time t))
+ (if (eq var 'tag) (setq org-prefix-has-tag t))
+ (if (eq var 'effort) (setq org-prefix-has-effort t))
+ (if (eq var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
(setq f (concat "%" (match-string 2 s) "s"))
- (when (equal var 'category)
+ (when (eq var 'category)
(setq org-prefix-category-length
(floor (abs (string-to-number (match-string 2 s)))))
(setq org-prefix-category-max-length
@@ -6959,8 +6955,14 @@ The optional argument TYPE tells the agenda type."
(defsubst org-cmp-effort (a b)
"Compare the effort values of string A and B."
(let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
- (ea (or (get-text-property (1- (length a)) 'effort-minutes a) def))
- (eb (or (get-text-property (1- (length b)) 'effort-minutes b) def)))
+ ;; `effort-minutes' property is not directly accessible from
+ ;; the strings, but is stored as a property in `txt'.
+ (ea (or (get-text-property
+ 0 'effort-minutes (get-text-property 0 'txt a))
+ def))
+ (eb (or (get-text-property
+ 0 'effort-minutes (get-text-property 0 'txt b))
+ def)))
(cond ((> ea eb) +1)
((< ea eb) -1))))
@@ -7122,7 +7124,7 @@ their type."
'face 'org-agenda-restriction-lock)
(overlay-put org-agenda-restriction-lock-overlay
'help-echo "Agendas are currently limited to this subtree.")
-(org-detach-overlay org-agenda-restriction-lock-overlay)
+(delete-overlay org-agenda-restriction-lock-overlay)
;;;###autoload
(defun org-agenda-set-restriction-lock (&optional type)
@@ -7168,8 +7170,8 @@ in the file. Otherwise, restriction will be to the current subtree."
(defun org-agenda-remove-restriction-lock (&optional noupdate)
"Remove the agenda restriction lock."
(interactive "P")
- (org-detach-overlay org-agenda-restriction-lock-overlay)
- (org-detach-overlay org-speedbar-restriction-lock-overlay)
+ (delete-overlay org-agenda-restriction-lock-overlay)
+ (delete-overlay org-speedbar-restriction-lock-overlay)
(setq org-agenda-overriding-restriction nil)
(setq org-agenda-restrict nil)
(put 'org-agenda-files 'org-restrict nil)
@@ -7358,7 +7360,7 @@ in the agenda."
(when effort (org-agenda-filter-apply effort 'effort))
(when re (org-agenda-filter-apply re 'regexp)))
(and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
- (and cols (org-called-interactively-p 'any) (org-agenda-columns))
+ (and cols (called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(recenter window-line)))
@@ -7447,19 +7449,19 @@ With two prefix arguments, remove the effort filters."
effort-prompt op)
(while (not (member op '(?< ?> ?=)))
(setq op (read-char-exclusive "Effort operator? (> = or <)")))
- (loop for i from 0 to 9 do
- (setq effort-prompt
- (concat
- effort-prompt " ["
- (if (= i 9) "0" (int-to-string (1+ i)))
- "]" (nth i efforts))))
- (message "Effort %s%s" (char-to-string op) effort-prompt)
- (while (or (< eff 0) (> eff 9))
- (setq eff (string-to-number (char-to-string (read-char-exclusive)))))
- (setq org-agenda-effort-filter
- (list (concat (if strip "-" "+")
- (char-to-string op) (nth (1- eff) efforts))))
- (org-agenda-filter-apply org-agenda-effort-filter 'effort)))
+ (cl-loop for i from 0 to 9 do
+ (setq effort-prompt
+ (concat
+ effort-prompt " ["
+ (if (= i 9) "0" (int-to-string (1+ i)))
+ "]" (nth i efforts))))
+ (message "Effort %s%s" (char-to-string op) effort-prompt)
+ (while (or (< eff 0) (> eff 9))
+ (setq eff (string-to-number (char-to-string (read-char-exclusive)))))
+ (setq org-agenda-effort-filter
+ (list (concat (if strip "-" "+")
+ (char-to-string op) (nth (1- eff) efforts))))
+ (org-agenda-filter-apply org-agenda-effort-filter 'effort)))
(t (org-agenda-filter-show-all-effort)
(message "Effort filter removed"))))
@@ -7480,15 +7482,18 @@ With two prefix arguments, remove the effort filters."
(defun org-agenda-filter-by-tag (arg &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
-The tag is selected with its fast selection letter, as
-configured. With a single \\[universal-argument] prefix ARG,
-exclude the agenda search. With a double \\[universal-argument]
-prefix ARG, filter the literal tag. I.e. don't filter on all its
-group members.
-
-A lisp caller can specify CHAR. EXCLUDE means that the new tag should be
-used to exclude the search - the interactive user can also press `-' or `+'
-to switch between filtering and excluding."
+
+The tag is selected with its fast selection letter, as configured.
+
+With a `\\[universal-argument]' prefix, exclude the agenda search.
+
+With a `\\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \
+i.e. don't
+filter on all its group members.
+
+A lisp caller can specify CHAR. EXCLUDE means that the new tag
+should be used to exclude the search - the interactive user can
+also press `-' or `+' to switch between filtering and excluding."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(tag-chars (mapconcat
@@ -7517,10 +7522,10 @@ to switch between filtering and excluding."
((eq char ?+) (setq exclude nil)))))
(when (eq char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
- (org-set-local 'org-global-tags-completion-table
- (org-global-tags-completion-table)))
+ (setq-local org-global-tags-completion-table
+ (org-global-tags-completion-table)))
(let ((completion-ignore-case t))
- (setq tag (org-icompleting-read
+ (setq tag (completing-read
"Tag: " org-global-tags-completion-table))))
(cond
((eq char ?\r)
@@ -7565,12 +7570,6 @@ to switch between filtering and excluding."
(get-text-property (point) 'tags))))
tags))
-(defun org-agenda-filter-by-tag-refine (arg &optional char)
- "Refine the current filter. See `org-agenda-filter-by-tag'."
- (interactive "P")
- (org-agenda-filter-by-tag arg char))
-(make-obsolete 'org-agenda-filter-by-tag-refine
- "use `org-agenda-filter-by-tag' instead." "8.3.4")
(defun org-agenda-filter-make-matcher (filter type &optional expand)
"Create the form that tests a line for agenda filter. Optional
@@ -7623,30 +7622,22 @@ tags in the FILTER if any of the tags in FILTER are grouptags."
(cons 'and (nreverse f))))
(defun org-agenda-filter-make-matcher-tag-exp (tags op)
- "Create the form that tests a line for agenda filter for
-tag-expressions. Return a match-expression given TAGS. OP is an
-operator of type CHAR that allows the function to set the right
-switches in the returned form."
- (let (f f1) ;f = return expression. f1 = working-area
- (dolist (x tags)
+ "Return a form associated to tag-expression TAGS.
+Build a form testing a line for agenda filter for
+tag-expressions. OP is an operator of type CHAR that allows the
+function to set the right switches in the returned form."
+ (let (form)
+ ;; Any of the expressions can match if OP is +, all must match if
+ ;; the operator is -.
+ (dolist (x tags (cons (if (eq op ?-) 'and 'or) form))
(let* ((tag (substring x 1))
- (isregexp (and (equal "{" (substring tag 0 1))
- (equal "}" (substring tag -1))))
- regexp)
- (cond
- (isregexp
- (setq regexp (substring tag 1 -1))
- (setq f1 (list 'org-match-any-p regexp 'tags)))
- (t
- (setq f1 (list 'member (downcase tag) 'tags))))
- (when (eq op ?-)
- (setq f1 (list 'not f1))))
- (push f1 f))
- ;; Any of the expressions can match if op = +
- ;; all must match if the operator is -.
- (if (eq op ?-)
- (cons 'and f)
- (cons 'or f))))
+ (f (cond
+ ((string= "" tag) '(not tags))
+ ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
+ ;; TAG is a regexp.
+ (list 'org-match-any-p (substring tag 1 -1) 'tags))
+ (t (list 'member (downcase tag) 'tags)))))
+ (push (if (eq op ?-) (list 'not f) f) form)))))
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
@@ -7860,7 +7851,7 @@ Negative selection means regexp must not match for selection of an entry."
(tdpos (goto-char tdpos))
((eq org-agenda-type 'agenda)
(let* ((sd (org-agenda-compute-starting-span
- (org-today) (or curspan org-agenda-ndays org-agenda-span)))
+ (org-today) (or curspan org-agenda-span)))
(org-agenda-overriding-arguments args))
(setf (nth 1 org-agenda-overriding-arguments) sd)
(org-agenda-redo)
@@ -7960,36 +7951,35 @@ With prefix ARG, go backward that many times the current span."
(message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort
time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
[a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
- (let ((a (read-char-exclusive)))
- (case a
- (?\ (call-interactively 'org-agenda-reset-view))
- (?d (call-interactively 'org-agenda-day-view))
- (?w (call-interactively 'org-agenda-week-view))
- (?t (call-interactively 'org-agenda-fortnight-view))
- (?m (call-interactively 'org-agenda-month-view))
- (?y (call-interactively 'org-agenda-year-view))
- (?l (call-interactively 'org-agenda-log-mode))
- (?L (org-agenda-log-mode '(4)))
- (?c (org-agenda-log-mode 'clockcheck))
- ((?F ?f) (call-interactively 'org-agenda-follow-mode))
- (?a (call-interactively 'org-agenda-archives-mode))
- (?A (org-agenda-archives-mode 'files))
- ((?R ?r) (call-interactively 'org-agenda-clockreport-mode))
- ((?E ?e) (call-interactively 'org-agenda-entry-text-mode))
- (?G (call-interactively 'org-agenda-toggle-time-grid))
- (?D (call-interactively 'org-agenda-toggle-diary))
- (?\! (call-interactively 'org-agenda-toggle-deadlines))
- (?\[ (let ((org-agenda-include-inactive-timestamps t))
- (org-agenda-check-type t 'timeline 'agenda)
- (org-agenda-redo))
- (message "Display now includes inactive timestamps as well"))
- (?q (message "Abort"))
- (otherwise (error "Invalid key" )))))
+ (pcase (read-char-exclusive)
+ (?\ (call-interactively 'org-agenda-reset-view))
+ (?d (call-interactively 'org-agenda-day-view))
+ (?w (call-interactively 'org-agenda-week-view))
+ (?t (call-interactively 'org-agenda-fortnight-view))
+ (?m (call-interactively 'org-agenda-month-view))
+ (?y (call-interactively 'org-agenda-year-view))
+ (?l (call-interactively 'org-agenda-log-mode))
+ (?L (org-agenda-log-mode '(4)))
+ (?c (org-agenda-log-mode 'clockcheck))
+ ((or ?F ?f) (call-interactively 'org-agenda-follow-mode))
+ (?a (call-interactively 'org-agenda-archives-mode))
+ (?A (org-agenda-archives-mode 'files))
+ ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode))
+ ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode))
+ (?G (call-interactively 'org-agenda-toggle-time-grid))
+ (?D (call-interactively 'org-agenda-toggle-diary))
+ (?\! (call-interactively 'org-agenda-toggle-deadlines))
+ (?\[ (let ((org-agenda-include-inactive-timestamps t))
+ (org-agenda-check-type t 'timeline 'agenda)
+ (org-agenda-redo))
+ (message "Display now includes inactive timestamps as well"))
+ (?q (message "Abort"))
+ (key (user-error "Invalid key: %s" key))))
(defun org-agenda-reset-view ()
"Switch to default view for agenda."
(interactive)
- (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span)))
+ (org-agenda-change-time-span org-agenda-span))
(defun org-agenda-day-view (&optional day-of-month)
"Switch to daily view for agenda.
With argument DAY-OF-MONTH, switch to that day of the month."
@@ -8128,7 +8118,7 @@ so that the date SD will be in that range."
(defun org-unhighlight ()
"Detach overlay INDEX."
- (org-detach-overlay org-hl))
+ (delete-overlay org-hl))
(defun org-unhighlight-once ()
"Remove the highlight from its position, and this function from the hook."
@@ -8185,9 +8175,11 @@ so that the date SD will be in that range."
(defun org-agenda-log-mode (&optional special)
"Toggle log mode in an agenda buffer.
+
With argument SPECIAL, show all possible log items, not only the ones
configured in `org-agenda-log-mode-items'.
-With a double \\[universal-argument] prefix arg, show *only* \
+
+With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
log items, nothing else."
(interactive "P")
(org-agenda-check-type t 'agenda 'timeline)
@@ -8202,8 +8194,7 @@ log items, nothing else."
(setq org-agenda-start-with-log-mode org-agenda-show-log)
(org-agenda-set-mode-name)
(org-agenda-redo)
- (message "Log mode is %s"
- (if org-agenda-show-log "on" "off")))
+ (message "Log mode is %s" (if org-agenda-show-log "on" "off")))
(defun org-agenda-archives-mode (&optional with-files)
"Toggle inclusion of items in trees marked with :ARCHIVE:.
@@ -8275,7 +8266,7 @@ When called with a prefix argument, include all archive files as well."
(t ""))
(if (or org-agenda-category-filter
(get 'org-agenda-category-filter :preset-filter))
- '(:eval (org-propertize
+ '(:eval (propertize
(concat " <"
(mapconcat
'identity
@@ -8288,7 +8279,7 @@ When called with a prefix argument, include all archive files as well."
'help-echo "Category used in filtering")) "")
(if (or org-agenda-tag-filter
(get 'org-agenda-tag-filter :preset-filter))
- '(:eval (org-propertize
+ '(:eval (propertize
(concat " {"
(mapconcat
'identity
@@ -8301,7 +8292,7 @@ When called with a prefix argument, include all archive files as well."
'help-echo "Tags used in filtering")) "")
(if (or org-agenda-effort-filter
(get 'org-agenda-effort-filter :preset-filter))
- '(:eval (org-propertize
+ '(:eval (propertize
(concat " {"
(mapconcat
'identity
@@ -8314,7 +8305,7 @@ When called with a prefix argument, include all archive files as well."
'help-echo "Effort conditions used in filtering")) "")
(if (or org-agenda-regexp-filter
(get 'org-agenda-regexp-filter :preset-filter))
- '(:eval (org-propertize
+ '(:eval (propertize
(concat " ["
(mapconcat
'identity
@@ -8333,9 +8324,6 @@ When called with a prefix argument, include all archive files as well."
(if org-agenda-clockreport-mode " Clock" "")))
(force-mode-line-update))
-(define-obsolete-function-alias
- 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3")
-
(defun org-agenda-update-agenda-type ()
"Update the agenda type after each command."
(setq org-agenda-type
@@ -8398,7 +8386,7 @@ When called with a prefix argument, include all archive files as well."
(message "No tags associated with this line"))))
(defun org-agenda-goto (&optional highlight)
- "Go to the entry at point in the corresponding Org-mode file."
+ "Go to the entry at point in the corresponding Org file."
(interactive)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
@@ -8410,15 +8398,11 @@ When called with a prefix argument, include all archive files as well."
(goto-char pos)
(when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (when (outline-invisible-p)
- (outline-show-entry)) ; display invisible text
(recenter (/ (window-height) 2))
(org-back-to-heading t)
- (if (re-search-forward org-complex-heading-regexp nil t)
- (goto-char (match-beginning 4))))
+ (let ((case-fold-search nil))
+ (when (re-search-forward org-complex-heading-regexp nil t)
+ (goto-char (match-beginning 4)))))
(run-hooks 'org-agenda-after-show-hook)
(and highlight (org-highlight (point-at-bol) (point-at-eol)))))
@@ -8505,7 +8489,7 @@ Point is in the buffer where the item originated.")
(org-remove-subtree-entries-from-agenda))
(org-back-to-heading t)
(funcall cmd)))
- (error "Archiving works only in Org-mode files"))))))
+ (error "Archiving works only in Org files"))))))
(defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
"Remove all lines in the agenda that correspond to a given subtree.
@@ -8535,11 +8519,16 @@ If this information is not given, the function uses the tree at point."
(defun org-agenda-refile (&optional goto rfloc no-update)
"Refile the item at point.
-When GOTO is 0 or \\='(64) or a triple \\[universal-argument] prefix argument,
-clear the refile cache.
-When GOTO is \\='(16) or a double \\[universal-argument] prefix argument,
-go to the location of the last refiled item.
+When called with `\\[universal-argument] \\[universal-argument]', \
+go to the location of the last
+refiled item.
+
+When called with `\\[universal-argument] \\[universal-argument] \
+\\[universal-argument]' prefix or when GOTO is 0, clear
+the refile cache.
+
RFLOC can be a refile location obtained in a different way.
+
When NO-UPDATE is non-nil, don't redo the agenda buffer."
(interactive "P")
(cond
@@ -8558,13 +8547,11 @@ When NO-UPDATE is non-nil, don't redo the agenda buffer."
(if goto "Goto" "Refile to") buffer
org-refile-allow-creating-parent-nodes))))
(with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (let ((org-agenda-buffer-name buffer-orig))
- (org-remove-subtree-entries-from-agenda))
- (org-refile goto buffer rfloc)))))
+ (org-with-wide-buffer
+ (goto-char marker)
+ (let ((org-agenda-buffer-name buffer-orig))
+ (org-remove-subtree-entries-from-agenda))
+ (org-refile goto buffer rfloc))))
(unless no-update (org-agenda-redo)))))
(defun org-agenda-open-link (&optional arg)
@@ -8589,13 +8576,11 @@ It also looks at the text of the entry itself."
(setq trg (and (string-match org-bracket-link-regexp l)
(match-string 1 l)))
(if (or (not trg) (string-match org-any-link-re trg))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (when (search-forward l nil lkend)
- (goto-char (match-beginning 0))
- (org-open-at-point))))
+ (org-with-wide-buffer
+ (goto-char marker)
+ (when (search-forward l nil lkend)
+ (goto-char (match-beginning 0))
+ (org-open-at-point)))
;; This is an internal link, widen the buffer
(switch-to-buffer-other-window buffer)
(widen)
@@ -8615,8 +8600,9 @@ It also looks at the text of the entry itself."
"Get a variable from a referenced buffer and install it here."
(let ((m (org-get-at-bol 'org-marker)))
(when (and m (buffer-live-p (marker-buffer m)))
- (org-set-local var (with-current-buffer (marker-buffer m)
- (symbol-value var))))))
+ (set (make-local-variable var)
+ (with-current-buffer (marker-buffer m)
+ (symbol-value var))))))
(defun org-agenda-switch-to (&optional delete-other-windows)
"Go to the Org mode file which contains the item at point.
@@ -8632,7 +8618,7 @@ displayed Org file fills the frame."
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(unless buffer (user-error "Trying to switch to non-existent buffer"))
- (org-pop-to-buffer-same-window buffer)
+ (pop-to-buffer-same-window buffer)
(when delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
@@ -8641,13 +8627,13 @@ displayed Org file fills the frame."
(run-hooks 'org-agenda-after-show-hook)))))
(defun org-agenda-goto-mouse (ev)
- "Go to the Org-mode file which contains the item at the mouse click."
+ "Go to the Org file which contains the item at the mouse click."
(interactive "e")
(mouse-set-point ev)
(org-agenda-goto))
(defun org-agenda-show (&optional full-entry)
- "Display the Org-mode file which contains the item at point.
+ "Display the Org file which contains the item at point.
With prefix argument FULL-ENTRY, make the entire entry visible
if it was hidden in the outline."
(interactive "P")
@@ -8658,11 +8644,13 @@ if it was hidden in the outline."
(defvar org-agenda-show-window nil)
(defun org-agenda-show-and-scroll-up (&optional arg)
- "Display the Org-mode file which contains the item at point.
+ "Display the Org file which contains the item at point.
+
When called repeatedly, scroll the window that is displaying the buffer.
-With a \\[universal-argument] prefix, use `org-show-entry' instead of
-`show-subtree' to display the item, so that drawers and logbooks stay
-folded."
+
+With a `\\[universal-argument]' prefix, use `org-show-entry' instead of \
+`outline-show-subtree'
+to display the item, so that drawers and logbooks stay folded."
(interactive "P")
(let ((win (selected-window)))
(if (and (window-live-p org-agenda-show-window)
@@ -8685,7 +8673,7 @@ folded."
(select-window win))))
(defun org-agenda-show-1 (&optional more)
- "Display the Org-mode file which contains the item at point.
+ "Display the Org file which contains the item at point.
The prefix arg selects the amount of information to display:
0 hide the subtree
@@ -8708,11 +8696,11 @@ if it was hidden in the outline."
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'folded))
(message "Remote: FOLDED"))
- ((and (org-called-interactively-p 'any) (= more 1))
+ ((and (called-interactively-p 'any) (= more 1))
(message "Remote: show with default settings"))
((= more 2)
(outline-show-entry)
- (outline-show-children)
+ (org-show-children)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'children))
@@ -8760,7 +8748,7 @@ docstring of `org-agenda-show-1'."
(org-agenda-show-1 org-agenda-cycle-counter))
(defun org-agenda-recenter (arg)
- "Display the Org-mode file which contains the item at point and recenter."
+ "Display the Org file which contains the item at point and recenter."
(interactive "P")
(let ((win (selected-window)))
(org-agenda-goto t)
@@ -8768,7 +8756,7 @@ docstring of `org-agenda-show-1'."
(select-window win)))
(defun org-agenda-show-mouse (ev)
- "Display the Org-mode file which contains the item at the mouse click."
+ "Display the Org file which contains the item at the mouse click."
(interactive "e")
(mouse-set-point ev)
(org-agenda-show))
@@ -8788,8 +8776,10 @@ This calls the command `org-tree-to-indirect-buffer' from the original buffer.
With a numerical prefix ARG, go up to this level and then take that tree.
With a negative numeric ARG, go up by this number of levels.
-With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't
-use the dedicated frame)."
+
+With a `\\[universal-argument]' prefix, make a separate frame for this tree, \
+i.e. don't use
+the dedicated frame."
(interactive "P")
(if current-prefix-arg
(org-agenda-do-tree-to-indirect-buffer arg)
@@ -8837,9 +8827,9 @@ by a remote command from the agenda.")
(org-agenda-todo 'previousset))
(defun org-agenda-todo (&optional arg)
- "Cycle TODO state of line at point, also in Org-mode file.
+ "Cycle TODO state of line at point, also in Org file.
This changes the line at point, all other lines in the agenda referring to
-the same tree node, and the headline of the tree node in the Org-mode file."
+the same tree node, and the headline of the tree node in the Org file."
(interactive "P")
(org-agenda-check-no-diary)
(let* ((col (current-column))
@@ -8848,7 +8838,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(buffer (marker-buffer marker))
(pos (marker-position marker))
(hdmarker (org-get-at-bol 'org-hd-marker))
- (todayp (org-agenda-todayp (org-get-at-bol 'day)))
+ (todayp (org-agenda-today-p (org-get-at-bol 'day)))
(inhibit-read-only t)
org-agenda-headline-snapshot-before-repeat newhead just-one)
(org-with-remote-undo buffer
@@ -8856,14 +8846,11 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
(let ((current-prefix-arg arg))
(call-interactively 'org-todo))
(and (bolp) (forward-char 1))
(setq newhead (org-get-heading))
- (when (and (org-bound-and-true-p
+ (when (and (bound-and-true-p
org-agenda-headline-snapshot-before-repeat)
(not (equal org-agenda-headline-snapshot-before-repeat
newhead))
@@ -8876,7 +8863,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(beginning-of-line 1)
(save-window-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
- (when (org-bound-and-true-p org-clock-out-when-done)
+ (when (bound-and-true-p org-clock-out-when-done)
(string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
newhead)
(org-agenda-unmark-clocking-task))
@@ -8897,9 +8884,6 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
(org-add-note))))
(defun org-agenda-change-all-lines (newhead hdmarker
@@ -8916,9 +8900,9 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(line (org-current-line))
(org-agenda-buffer (current-buffer))
(thetags (with-current-buffer (marker-buffer hdmarker)
- (save-excursion (save-restriction (widen)
- (goto-char hdmarker)
- (org-get-tags-at)))))
+ (org-with-wide-buffer
+ (goto-char hdmarker)
+ (org-get-tags-at))))
props m pl undone-face done-face finish new dotime level cat tags)
(save-excursion
(goto-char (point-max))
@@ -8939,20 +8923,25 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
org-prefix-format-compiled))
(extra (org-get-at-bol 'extra)))
(with-current-buffer (marker-buffer hdmarker)
- (save-excursion
- (save-restriction
- (widen)
- (org-agenda-format-item extra newhead level cat tags dotime)))))
+ (org-with-wide-buffer
+ (org-agenda-format-item extra newhead level cat tags dotime))))
pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
undone-face (org-get-at-bol 'undone-face)
done-face (org-get-at-bol 'done-face))
(beginning-of-line 1)
(cond
- ((equal new "")
- (and (looking-at ".*\n?") (replace-match "")))
+ ((equal new "") (delete-region (point) (line-beginning-position 2)))
((looking-at ".*")
- (replace-match new t t)
- (beginning-of-line 1)
+ ;; When replacing the whole line, preserve bulk mark
+ ;; overlay, if any.
+ (let ((mark (catch :overlay
+ (dolist (o (overlays-in (point) (+ 2 (point))))
+ (when (eq (overlay-get o 'type)
+ 'org-marked-entry-overlay)
+ (throw :overlay o))))))
+ (replace-match new t t)
+ (beginning-of-line)
+ (when mark (move-overlay mark (point) (+ 2 (point)))))
(add-text-properties (point-at-bol) (point-at-eol) props)
(when fixface
(add-text-properties
@@ -8973,7 +8962,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(let ((inhibit-read-only t) l c)
(save-excursion
(goto-char (if line (point-at-bol) (point-min)))
- (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(if line (point-at-eol) nil) t)
(add-text-properties
(match-beginning 2) (match-end 2)
@@ -8997,19 +8986,19 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(org-font-lock-add-tag-faces (point-max)))))
(defun org-agenda-priority-up ()
- "Increase the priority of line at point, also in Org-mode file."
+ "Increase the priority of line at point, also in Org file."
(interactive)
(org-agenda-priority 'up))
(defun org-agenda-priority-down ()
- "Decrease the priority of line at point, also in Org-mode file."
+ "Decrease the priority of line at point, also in Org file."
(interactive)
(org-agenda-priority 'down))
(defun org-agenda-priority (&optional force-direction)
- "Set the priority of line at point, also in Org-mode file.
+ "Set the priority of line at point, also in Org file.
This changes the line at point, all other lines in the agenda referring to
-the same tree node, and the headline of the tree node in the Org-mode file.
+the same tree node, and the headline of the tree node in the Org file.
Called with a universal prefix arg, show the priority instead of setting it."
(interactive "P")
(if (equal force-direction '(4))
@@ -9030,9 +9019,6 @@ Called with a universal prefix arg, show the priority instead of setting it."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
(funcall 'org-priority force-direction)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -9044,7 +9030,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
"Set tags for the current headline."
(interactive)
(org-agenda-check-no-diary)
- (if (and (org-region-active-p) (org-called-interactively-p 'any))
+ (if (and (org-region-active-p) (called-interactively-p 'any))
(call-interactively 'org-change-tag-in-region)
(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
@@ -9056,12 +9042,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
+ (org-show-context 'agenda)
(if tag
(org-toggle-tag tag onoff)
(call-interactively 'org-set-tags))
@@ -9084,12 +9065,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
+ (org-show-context 'agenda)
(call-interactively 'org-set-property)))))
(defun org-agenda-set-effort ()
@@ -9106,12 +9082,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
+ (org-show-context 'agenda)
(call-interactively 'org-set-effort)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -9132,9 +9103,6 @@ Called with a universal prefix arg, show the priority instead of setting it."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
(call-interactively 'org-toggle-archive-tag)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -9248,18 +9216,10 @@ Called with a universal prefix arg, show the priority instead of setting it."
(when (equal marker (org-get-at-bol 'org-marker))
(remove-text-properties (point-at-bol) (point-at-eol) '(display))
(org-move-to-column (- (window-width) (length stamp)) t)
- (if (featurep 'xemacs)
- ;; Use `duplicable' property to trigger undo recording
- (let ((ex (make-extent nil nil))
- (gl (make-glyph stamp)))
- (set-glyph-face gl 'secondary-selection)
- (set-extent-properties
- ex (list 'invisible t 'end-glyph gl 'duplicable t))
- (insert-extent ex (1- (point)) (point-at-eol)))
- (add-text-properties
- (1- (point)) (point-at-eol)
- (list 'display (org-add-props stamp nil
- 'face '(secondary-selection default)))))
+ (add-text-properties
+ (1- (point)) (point-at-eol)
+ (list 'display (org-add-props stamp nil
+ 'face '(secondary-selection default))))
(beginning-of-line 1))
(beginning-of-line 0)))))
@@ -9341,7 +9301,6 @@ ARG is passed through to `org-deadline'."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (org-show-entry)
(org-cycle-hide-drawers 'children)
(org-clock-in arg)
(setq newhead (org-get-heading)))
@@ -9356,14 +9315,12 @@ ARG is passed through to `org-deadline'."
(let ((marker (make-marker)) (col (current-column)) newhead)
(org-with-remote-undo (marker-buffer org-clock-marker)
(with-current-buffer (marker-buffer org-clock-marker)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char org-clock-marker)
- (org-back-to-heading t)
- (move-marker marker (point))
- (org-clock-out)
- (setq newhead (org-get-heading))))))
+ (org-with-wide-buffer
+ (goto-char org-clock-marker)
+ (org-back-to-heading t)
+ (move-marker marker (point))
+ (org-clock-out)
+ (setq newhead (org-get-heading)))))
(org-agenda-change-all-lines newhead marker)
(move-marker marker nil)
(org-move-to-column col)
@@ -9390,7 +9347,7 @@ buffer, display it in another window."
(cond (pos (goto-char pos))
;; If the currently clocked entry is not in the agenda
;; buffer, we visit it in another window:
- (org-clock-current-task
+ ((bound-and-true-p org-clock-current-task)
(org-switch-to-buffer-other-window (org-clock-goto)))
(t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
@@ -9440,11 +9397,13 @@ buffer, display it in another window."
"Where in `org-agenda-diary-file' should new entries be added?
Valid values:
-date-tree in the date tree, as child of the date
-top-level as top-level entries at the end of the file."
+date-tree in the date tree, as first child of the date
+date-tree-last in the date tree, as last child of the date
+top-level as top-level entries at the end of the file."
:group 'org-agenda
:type '(choice
- (const :tag "in a date tree" date-tree)
+ (const :tag "first in a date tree" date-tree)
+ (const :tag "last in a date tree" date-tree-last)
(const :tag "as top level at end of file" top-level)))
(defcustom org-agenda-insert-diary-extract-time nil
@@ -9545,24 +9504,30 @@ a timestamp can be added there."
(insert text)
(org-end-of-meta-data)
(unless (bolp) (insert "\n"))
- (when org-adapt-indentation (org-indent-to-column 2)))
+ (when org-adapt-indentation (indent-to-column 2)))
(defun org-agenda-insert-diary-make-new-entry (text)
- "Make a new entry with TEXT as the first child of the current subtree.
+ "Make a new entry with TEXT as a child of the current subtree.
Position the point in the heading's first body line so that
a timestamp can be added there."
- (outline-next-heading)
- (org-back-over-empty-lines)
- (unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
- (org-insert-heading nil t)
- (org-do-demote)
+ (cond
+ ((eq org-agenda-insert-diary-strategy 'date-tree-last)
+ (end-of-line)
+ (org-insert-heading '(4) t)
+ (org-do-demote))
+ (t
+ (outline-next-heading)
+ (org-back-over-empty-lines)
+ (unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
+ (org-insert-heading nil t)
+ (org-do-demote)))
(let ((col (current-column)))
(insert text)
(org-end-of-meta-data)
;; Ensure point is left on a blank line, at proper indentation.
(unless (bolp) (insert "\n"))
- (unless (org-looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
- (when org-adapt-indentation (org-indent-to-column col)))
+ (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
+ (when org-adapt-indentation (indent-to-column col)))
(org-show-set-visibility 'lineage))
(defun org-agenda-diary-entry ()
@@ -9570,7 +9535,7 @@ a timestamp can be added there."
All the standard commands work: block, weekly etc.
When `org-agenda-diary-file' points to a file,
`org-agenda-diary-entry-in-org-file' is called instead to create
-entries in that Org-mode file."
+entries in that Org file."
(interactive)
(if (not (eq org-agenda-diary-file 'diary-file))
(org-agenda-diary-entry-in-org-file)
@@ -9675,7 +9640,7 @@ argument, latitude and longitude will be prompted for."
;;;###autoload
(defun org-calendar-goto-agenda ()
- "Compute the Org-mode agenda for the calendar date displayed at the cursor.
+ "Compute the Org agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'."
(interactive)
;; Temporarily disable sticky agenda since user clearly wants to
@@ -9717,6 +9682,7 @@ This is a command that has to be installed in `calendar-mode-map'."
;;; Bulk commands
(defun org-agenda-bulk-marked-p ()
+ "Non-nil when current entry is marked for bulk action."
(eq (get-char-property (point-at-bol) 'type)
'org-marked-entry-overlay))
@@ -9758,9 +9724,12 @@ This is a command that has to be installed in `calendar-mode-map'."
(goto-char (next-single-property-change (point) 'org-hd-marker))
(while (and (re-search-forward regexp nil t)
(setq txt-at-point (get-text-property (point) 'txt)))
- (when (string-match regexp txt-at-point)
- (setq entries-marked (1+ entries-marked))
- (call-interactively 'org-agenda-bulk-mark))))
+ (if (get-char-property (point) 'invisible)
+ (beginning-of-line 2)
+ (when (string-match regexp txt-at-point)
+ (setq entries-marked (1+ entries-marked))
+ (call-interactively 'org-agenda-bulk-mark)))))
+
(if (not entries-marked)
(message "No entry matching this regexp."))))
@@ -9893,21 +9862,21 @@ The prefix arg is passed through to the command if possible."
redo-at-end t))
((equal action ?t)
- (setq state (org-icompleting-read
+ (setq state (completing-read
"Todo state: "
(with-current-buffer (marker-buffer (car entries))
- (mapcar 'list org-todo-keywords-1))))
+ (mapcar #'list org-todo-keywords-1))))
(setq cmd `(let ((org-inhibit-blocking t)
(org-inhibit-logging 'note))
(org-agenda-todo ,state))))
((memq action '(?- ?+))
- (setq tag (org-icompleting-read
+ (setq tag (completing-read
(format "Tag to %s: " (if (eq action ?+) "add" "remove"))
(with-current-buffer (marker-buffer (car entries))
(delq nil
- (mapcar (lambda (x)
- (if (stringp (car x)) x)) org-tag-alist)))))
+ (mapcar (lambda (x) (and (stringp (car x)) x))
+ org-current-tag-alist)))))
(setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
((memq action '(?s ?d))
@@ -9917,8 +9886,15 @@ The prefix arg is passed through to the command if possible."
nil nil nil
(if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to")
org-overriding-default-time)))
- (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline)))
- (setq cmd `(eval '(,c1 arg ,time)))))
+ (c1 (if (eq action ?s) 'org-agenda-schedule
+ 'org-agenda-deadline)))
+ ;; Make sure to not prompt for a note when bulk
+ ;; rescheduling as Org cannot cope with simultaneous Org.
+ ;; Besides, it could be annoying depending on the number
+ ;; of items re-scheduled.
+ (setq cmd `(eval '(let ((org-log-reschedule
+ (and org-log-reschedule 'time)))
+ (,c1 arg ,time))))))
((equal action ?S)
(if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
@@ -9935,13 +9911,13 @@ The prefix arg is passed through to the command if possible."
(calendar-gregorian-from-absolute (org-today)))))
(dotimes (i (1+ dist))
(while (member day-of-week org-agenda-weekend-days)
- (incf distance)
- (incf day-of-week)
- (if (= day-of-week 7)
- (setq day-of-week 0)))
- (incf day-of-week)
- (if (= day-of-week 7)
- (setq day-of-week 0)))))
+ (cl-incf distance)
+ (cl-incf day-of-week)
+ (when (= day-of-week 7)
+ (setq day-of-week 0)))
+ (cl-incf day-of-week)
+ (when (= day-of-week 7)
+ (setq day-of-week 0)))))
;; silently fail when try to replan a sexp entry
(condition-case nil
(let* ((date (calendar-gregorian-from-absolute
@@ -9957,8 +9933,8 @@ The prefix arg is passed through to the command if possible."
((equal action ?f)
(setq cmd (list (intern
- (org-icompleting-read "Function: "
- obarray 'fboundp t nil nil)))))
+ (completing-read "Function: "
+ obarray 'fboundp t nil nil)))))
(t (user-error "Invalid bulk action")))
@@ -10083,8 +10059,9 @@ tag and (if present) the flagging note."
(replace-match "\n" t t))
(goto-char (point-min))
(select-window win)
- (message (substitute-command-keys "Flagging note pushed to kill ring. \
-Press \\[org-agenda-show-the-flagging-note] again to remove tag and note")))))
+ (message "%s" (substitute-command-keys "Flagging note pushed to \
+kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \
+tag and note")))))
(defun org-agenda-remove-flag (marker)
"Remove the FLAGGED tag and any flagging note in the entry."
@@ -10107,7 +10084,8 @@ Press \\[org-agenda-show-the-flagging-note] again to remove tag and note")))))
;;;###autoload
(defun org-agenda-to-appt (&optional refresh filter &rest args)
"Activate appointments found in `org-agenda-files'.
-With a \\[universal-argument] prefix, refresh the list of
+
+With a `\\[universal-argument]' prefix, refresh the list of \
appointments.
If FILTER is t, interactively prompt the user for a regular
@@ -10141,76 +10119,78 @@ to override `appt-message-warning-time'."
(if refresh (setq appt-time-msg-list nil))
(if (eq filter t)
(setq filter (read-from-minibuffer "Regexp filter: ")))
- (let* ((cnt 0) ; count added events
- (scope (or args '(:deadline* :scheduled* :timestamp)))
- (org-agenda-new-buffers nil)
- (org-deadline-warning-days 0)
- ;; Do not use `org-today' here because appt only takes
- ;; time and without date as argument, so it may pass wrong
- ;; information otherwise
- (today (org-date-to-gregorian
- (time-to-days (current-time))))
- (org-agenda-restrict nil)
- (files (org-agenda-files 'unrestricted)) entries file
- (org-agenda-buffer nil))
+ (let* ((cnt 0) ; count added events
+ (scope (or args '(:deadline* :scheduled* :timestamp)))
+ (org-agenda-new-buffers nil)
+ (org-deadline-warning-days 0)
+ ;; Do not use `org-today' here because appt only takes
+ ;; time and without date as argument, so it may pass wrong
+ ;; information otherwise
+ (today (org-date-to-gregorian
+ (time-to-days (current-time))))
+ (org-agenda-restrict nil)
+ (files (org-agenda-files 'unrestricted)) entries file
+ (org-agenda-buffer nil))
;; Get all entries which may contain an appt
(org-agenda-prepare-buffers files)
(while (setq file (pop files))
(setq entries
- (delq nil
- (append entries
- (apply 'org-agenda-get-day-entries
- file today scope)))))
+ (delq nil
+ (append entries
+ (apply 'org-agenda-get-day-entries
+ file today scope)))))
;; Map thru entries and find if we should filter them out
(mapc
- (lambda(x)
+ (lambda (x)
(let* ((evt (org-trim
- (replace-regexp-in-string
- org-bracket-link-regexp "\\3"
- (or (get-text-property 1 'txt x) ""))))
- (cat (get-text-property (1- (length x)) 'org-category x))
- (tod (get-text-property 1 'time-of-day x))
- (ok (or (null filter)
- (and (stringp filter) (string-match filter evt))
- (and (functionp filter) (funcall filter x))
- (and (listp filter)
- (let ((cat-filter (cadr (assoc 'category filter)))
- (evt-filter (cadr (assoc 'headline filter))))
- (or (and (stringp cat-filter)
- (string-match cat-filter cat))
- (and (stringp evt-filter)
- (string-match evt-filter evt)))))))
- (wrn (get-text-property 1 'warntime x)))
- ;; FIXME: Shall we remove text-properties for the appt text?
- ;; (setq evt (set-text-properties 0 (length evt) nil evt))
- (when (and ok tod)
- (setq tod (concat "00" (number-to-string tod))
- tod (when (string-match
- "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
- (concat (match-string 1 tod) ":"
- (match-string 2 tod))))
- (if (version< emacs-version "23.3")
- (appt-add tod evt)
- (appt-add tod evt wrn))
- (setq cnt (1+ cnt))))) entries)
+ (replace-regexp-in-string
+ org-bracket-link-regexp "\\3"
+ (or (get-text-property 1 'txt x) ""))))
+ (cat (get-text-property (1- (length x)) 'org-category x))
+ (tod (get-text-property 1 'time-of-day x))
+ (ok (or (null filter)
+ (and (stringp filter) (string-match filter evt))
+ (and (functionp filter) (funcall filter x))
+ (and (listp filter)
+ (let ((cat-filter (cadr (assq 'category filter)))
+ (evt-filter (cadr (assq 'headline filter))))
+ (or (and (stringp cat-filter)
+ (string-match cat-filter cat))
+ (and (stringp evt-filter)
+ (string-match evt-filter evt)))))))
+ (wrn (get-text-property 1 'warntime x)))
+ ;; FIXME: Shall we remove text-properties for the appt text?
+ ;; (setq evt (set-text-properties 0 (length evt) nil evt))
+ (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt)))
+ (setq tod (concat "00" (number-to-string tod)))
+ (setq tod (when (string-match
+ "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
+ (concat (match-string 1 tod) ":"
+ (match-string 2 tod))))
+ (when (if (version< emacs-version "23.3")
+ (appt-add tod evt)
+ (appt-add tod evt wrn))
+ (setq cnt (1+ cnt))))))
+ entries)
(org-release-buffers org-agenda-new-buffers)
(if (eq cnt 0)
- (message "No event to add")
+ (message "No event to add")
(message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
-(defun org-agenda-todayp (date)
- "Does DATE mean today, when considering `org-extend-today-until'?"
- (let ((today (org-today))
- (date (if (and date (listp date)) (calendar-absolute-from-gregorian date)
- date)))
- (eq date today)))
+(defun org-agenda-today-p (date)
+ "Non nil when DATE means today.
+DATE is either a list of the form (month day year) or a number of
+days as returned by `calendar-absolute-from-gregorian' or
+`org-today'. This function considers `org-extend-today-until'
+when defining today."
+ (eq (org-today)
+ (if (consp date) (calendar-absolute-from-gregorian date) date)))
(defun org-agenda-todo-yesterday (&optional arg)
"Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
(interactive "P")
(let* ((org-use-effective-time t)
- (hour (third (decode-time
- (org-current-time))))
+ (hour (nth 2 (decode-time (org-current-time))))
(org-extend-today-until (1+ hour)))
(org-agenda-todo arg)))
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
index 4c6a8c3..6daed74 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -1,4 +1,4 @@
-;;; org-archive.el --- Archiving for Org-mode
+;;; org-archive.el --- Archiving for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -30,8 +30,9 @@
(require 'org)
-(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+(declare-function org-element-type "org-element" (element))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
(defcustom org-archive-default-command 'org-archive-subtree
"The default archiving command."
@@ -56,7 +57,7 @@ See `org-archive-to-archive-sibling' for more information."
(defcustom org-archive-mark-done nil
"Non-nil means mark entries as DONE when they are moved to the archive file.
-This can be a string to set the keyword to use. When t, Org-mode will
+This can be a string to set the keyword to use. When non-nil, Org will
use the first keyword in its list that means done."
:group 'org-archive
:type '(choice
@@ -159,21 +160,24 @@ archive file is."
(defun org-all-archive-files ()
"Get a list of all archive files used in the current buffer."
- (let (file files)
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)"
- nil t)
- (setq file (org-extract-archive-file
- (org-match-string-no-properties 2)))
- (and file (> (length file) 0) (file-exists-p file)
- (add-to-list 'files file)))))
+ (let ((case-fold-search t)
+ files)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)"
+ nil t)
+ (when (save-match-data
+ (if (eq (match-string 1) ":") (org-at-property-p)
+ (eq (org-element-type (org-element-at-point)) 'keyword)))
+ (let ((file (org-extract-archive-file
+ (match-string-no-properties 2))))
+ (when (and (org-string-nw-p file) (file-exists-p file))
+ (push file files))))))
(setq files (nreverse files))
- (setq file (org-extract-archive-file))
- (and file (> (length file) 0) (file-exists-p file)
- (add-to-list 'files file))
+ (let ((file (org-extract-archive-file)))
+ (when (and (org-string-nw-p file) (file-exists-p file))
+ (push file files)))
files))
(defun org-extract-archive-file (&optional location)
@@ -226,42 +230,30 @@ this heading."
((equal find-done '(16)) (org-archive-all-old))
(t
;; Save all relevant TODO keyword-relatex variables
- (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
- (tr-org-todo-keywords-1 org-todo-keywords-1)
- (tr-org-todo-kwd-alist org-todo-kwd-alist)
- (tr-org-done-keywords org-done-keywords)
- (tr-org-todo-regexp org-todo-regexp)
- (tr-org-todo-line-regexp org-todo-line-regexp)
- (tr-org-odd-levels-only org-odd-levels-only)
- (this-buffer (current-buffer))
- ;; start of variables that will be used for saving context
- ;; The compiler complains about them - keep them anyway!
- (file (abbreviate-file-name
- (or (buffer-file-name (buffer-base-buffer))
- (error "No file associated to buffer"))))
- (olpath (mapconcat 'identity (org-get-outline-path) "/"))
- (time (format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)))
- category todo priority ltags itags atags
- ;; end of variables that will be used for saving context
- location afile heading buffer level newfile-p infile-p visiting
- datetree-date datetree-subheading-p)
-
- ;; Find the local archive location
- (setq location (org-get-local-archive-location)
- afile (org-extract-archive-file location)
- heading (org-extract-archive-heading location)
- infile-p (equal file (abbreviate-file-name (or afile ""))))
- (unless afile
- (error "Invalid `org-archive-location'"))
-
- (if (> (length afile) 0)
- (setq newfile-p (not (file-exists-p afile))
- visiting (find-buffer-visiting afile)
- buffer (or visiting (find-file-noselect afile)))
- (setq buffer (current-buffer)))
- (unless buffer
- (error "Cannot access file \"%s\"" afile))
+ (let* ((tr-org-todo-keywords-1 org-todo-keywords-1)
+ (tr-org-todo-kwd-alist org-todo-kwd-alist)
+ (tr-org-done-keywords org-done-keywords)
+ (tr-org-todo-regexp org-todo-regexp)
+ (tr-org-todo-line-regexp org-todo-line-regexp)
+ (tr-org-odd-levels-only org-odd-levels-only)
+ (this-buffer (current-buffer))
+ (time (format-time-string
+ (substring (cdr org-time-stamp-formats) 1 -1)))
+ (file (abbreviate-file-name
+ (or (buffer-file-name (buffer-base-buffer))
+ (error "No file associated to buffer"))))
+ (location (org-get-local-archive-location))
+ (afile (or (org-extract-archive-file location)
+ (error "Invalid `org-archive-location'")))
+ (heading (org-extract-archive-heading location))
+ (infile-p (equal file (abbreviate-file-name (or afile ""))))
+ (newfile-p (and (org-string-nw-p afile)
+ (not (file-exists-p afile))))
+ (buffer (cond ((not (org-string-nw-p afile)) this-buffer)
+ ((find-buffer-visiting afile))
+ ((find-file-noselect afile))
+ (t (error "Cannot access file \"%s\"" afile))))
+ level datetree-date datetree-subheading-p)
(when (string-match "\\`datetree/" heading)
;; Replace with ***, to represent the 3 levels of headings the
;; datetree has.
@@ -275,106 +267,115 @@ this heading."
(setq heading nil level 0))
(save-excursion
(org-back-to-heading t)
- ;; Get context information that will be lost by moving the tree
- (setq category (org-get-category nil 'force-refresh)
- todo (and (looking-at org-todo-line-regexp)
- (match-string 2))
- priority (org-get-priority
- (if (match-end 3) (match-string 3) ""))
- ltags (org-get-tags)
- itags (org-delete-all ltags (org-get-tags-at))
- atags (org-get-tags-at))
- (setq ltags (mapconcat 'identity ltags " ")
- itags (mapconcat 'identity itags " "))
- ;; We first only copy, in case something goes wrong
- ;; we need to protect `this-command', to avoid kill-region sets it,
- ;; which would lead to duplication of subtrees
- (let (this-command) (org-copy-subtree 1 nil t))
- (set-buffer buffer)
- ;; Enforce org-mode for the archive buffer
- (if (not (derived-mode-p 'org-mode))
- ;; Force the mode for future visits.
- (let ((org-insert-mode-line-in-empty-file t)
- (org-inhibit-startup t))
- (call-interactively 'org-mode)))
- (when (and newfile-p org-archive-file-header-format)
- (goto-char (point-max))
- (insert (format org-archive-file-header-format
- (buffer-file-name this-buffer))))
- (when datetree-date
- (require 'org-datetree)
- (org-datetree-find-date-create datetree-date)
- (org-narrow-to-subtree))
- ;; Force the TODO keywords of the original buffer
- (let ((org-todo-line-regexp tr-org-todo-line-regexp)
- (org-todo-keywords-1 tr-org-todo-keywords-1)
- (org-todo-kwd-alist tr-org-todo-kwd-alist)
- (org-done-keywords tr-org-done-keywords)
- (org-todo-regexp tr-org-todo-regexp)
- (org-todo-line-regexp tr-org-todo-line-regexp)
- (org-odd-levels-only
- (if (local-variable-p 'org-odd-levels-only (current-buffer))
- org-odd-levels-only
- tr-org-odd-levels-only)))
- (goto-char (point-min))
- (outline-show-all)
- (if (and heading (not (and datetree-date (not datetree-subheading-p))))
- (progn
- (if (re-search-forward
- (concat "^" (regexp-quote heading)
- (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
- nil t)
- (goto-char (match-end 0))
- ;; Heading not found, just insert it at the end
- (goto-char (point-max))
- (or (bolp) (insert "\n"))
- ;; datetrees don't need too much spacing
- (insert (if datetree-date "" "\n") heading "\n")
- (end-of-line 0))
- ;; Make the subtree visible
- (outline-show-subtree)
- (if org-archive-reversed-order
- (progn
- (org-back-to-heading t)
- (outline-next-heading))
- (org-end-of-subtree t))
- (skip-chars-backward " \t\r\n")
- (and (looking-at "[ \t\r\n]*")
- ;; datetree archives don't need so much spacing.
- (replace-match (if datetree-date "\n" "\n\n"))))
- ;; No specific heading, just go to end of file.
- (goto-char (point-max)) (unless datetree-date (insert "\n")))
- ;; Paste
- (org-paste-subtree (org-get-valid-level level (and heading 1)))
- ;; Shall we append inherited tags?
- (and itags
- (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
- infile-p)
- (eq org-archive-subtree-add-inherited-tags t))
- (org-set-tags-to atags))
- ;; Mark the entry as done
- (when (and org-archive-mark-done
- (looking-at org-todo-line-regexp)
- (or (not (match-end 2))
- (not (member (match-string 2) org-done-keywords))))
- (let (org-log-done org-todo-log-states)
- (org-todo
- (car (or (member org-archive-mark-done org-done-keywords)
- org-done-keywords)))))
-
- ;; Add the context info
- (when org-archive-save-context-info
- (let ((l org-archive-save-context-info) e n v)
- (while (setq e (pop l))
- (when (and (setq v (symbol-value e))
- (stringp v) (string-match "\\S-" v))
- (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
- (org-entry-put (point) n v)))))
-
- (widen)
- ;; Save and kill the buffer, if it is not the same buffer.
- (when (not (eq this-buffer buffer))
- (save-buffer))))
+ ;; Get context information that will be lost by moving the
+ ;; tree. See `org-archive-save-context-info'.
+ (let* ((all-tags (org-get-tags-at))
+ (local-tags (org-get-tags))
+ (inherited-tags (org-delete-all local-tags all-tags))
+ (context
+ `((category . ,(org-get-category nil 'force-refresh))
+ (file . ,file)
+ (itags . ,(mapconcat #'identity inherited-tags " "))
+ (ltags . ,(mapconcat #'identity local-tags " "))
+ (olpath . ,(mapconcat #'identity
+ (org-get-outline-path)
+ "/"))
+ (time . ,time)
+ (todo . ,(org-entry-get (point) "TODO")))))
+ ;; We first only copy, in case something goes wrong
+ ;; we need to protect `this-command', to avoid kill-region sets it,
+ ;; which would lead to duplication of subtrees
+ (let (this-command) (org-copy-subtree 1 nil t))
+ (set-buffer buffer)
+ ;; Enforce Org mode for the archive buffer
+ (if (not (derived-mode-p 'org-mode))
+ ;; Force the mode for future visits.
+ (let ((org-insert-mode-line-in-empty-file t)
+ (org-inhibit-startup t))
+ (call-interactively 'org-mode)))
+ (when (and newfile-p org-archive-file-header-format)
+ (goto-char (point-max))
+ (insert (format org-archive-file-header-format
+ (buffer-file-name this-buffer))))
+ (when datetree-date
+ (require 'org-datetree)
+ (org-datetree-find-date-create datetree-date)
+ (org-narrow-to-subtree))
+ ;; Force the TODO keywords of the original buffer
+ (let ((org-todo-line-regexp tr-org-todo-line-regexp)
+ (org-todo-keywords-1 tr-org-todo-keywords-1)
+ (org-todo-kwd-alist tr-org-todo-kwd-alist)
+ (org-done-keywords tr-org-done-keywords)
+ (org-todo-regexp tr-org-todo-regexp)
+ (org-todo-line-regexp tr-org-todo-line-regexp)
+ (org-odd-levels-only
+ (if (local-variable-p 'org-odd-levels-only (current-buffer))
+ org-odd-levels-only
+ tr-org-odd-levels-only)))
+ (goto-char (point-min))
+ (outline-show-all)
+ (if (and heading (not (and datetree-date (not datetree-subheading-p))))
+ (progn
+ (if (re-search-forward
+ (concat "^" (regexp-quote heading)
+ "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")
+ nil t)
+ (goto-char (match-end 0))
+ ;; Heading not found, just insert it at the end
+ (goto-char (point-max))
+ (or (bolp) (insert "\n"))
+ ;; datetrees don't need too much spacing
+ (insert (if datetree-date "" "\n") heading "\n")
+ (end-of-line 0))
+ ;; Make the subtree visible
+ (outline-show-subtree)
+ (if org-archive-reversed-order
+ (progn
+ (org-back-to-heading t)
+ (outline-next-heading))
+ (org-end-of-subtree t))
+ (skip-chars-backward " \t\r\n")
+ (and (looking-at "[ \t\r\n]*")
+ ;; datetree archives don't need so much spacing.
+ (replace-match (if datetree-date "\n" "\n\n"))))
+ ;; No specific heading, just go to end of file.
+ (goto-char (point-max))
+ ;; Subtree narrowing can let the buffer end on
+ ;; a headline. `org-paste-subtree' then deletes it.
+ ;; To prevent this, make sure visible part of buffer
+ ;; always terminates on a new line, while limiting
+ ;; number of blank lines in a date tree.
+ (unless (and datetree-date (bolp)) (insert "\n")))
+ ;; Paste
+ (org-paste-subtree (org-get-valid-level level (and heading 1)))
+ ;; Shall we append inherited tags?
+ (and inherited-tags
+ (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
+ infile-p)
+ (eq org-archive-subtree-add-inherited-tags t))
+ (org-set-tags-to all-tags))
+ ;; Mark the entry as done
+ (when (and org-archive-mark-done
+ (looking-at org-todo-line-regexp)
+ (or (not (match-end 2))
+ (not (member (match-string 2) org-done-keywords))))
+ (let (org-log-done org-todo-log-states)
+ (org-todo
+ (car (or (member org-archive-mark-done org-done-keywords)
+ org-done-keywords)))))
+
+ ;; Add the context info.
+ (dolist (item org-archive-save-context-info)
+ (let ((value (cdr (assq item context))))
+ (when (org-string-nw-p value)
+ (org-entry-put
+ (point)
+ (concat "ARCHIVE_" (upcase (symbol-name item)))
+ value))))
+ (widen)
+ ;; Save and kill the buffer, if it is not the same
+ ;; buffer.
+ (unless (eq this-buffer buffer) (save-buffer)))))
;; Here we are back in the original buffer. Everything seems
;; to have worked. So now run hooks, cut the tree and finish
;; up.
@@ -467,7 +468,7 @@ If the cursor is not on a headline, try all level 1 trees. If
it is on a headline, try all direct children.
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(org-archive-all-matches
- (lambda (beg end)
+ (lambda (_beg end)
(unless (re-search-forward org-not-done-heading-regexp end t)
"no open TODO items"))
tag))
@@ -478,7 +479,7 @@ If the cursor is not on a headline, try all level 1 trees. If
it is on a headline, try all direct children.
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(org-archive-all-matches
- (lambda (beg end)
+ (lambda (_beg end)
(let (ts)
(and (re-search-forward org-ts-regexp end t)
(setq ts (match-string 0))
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index e237b2c..d6e587d 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -1,4 +1,4 @@
-;;; org-attach.el --- Manage file attachments to org-mode tasks
+;;; org-attach.el --- Manage file attachments to Org tasks -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
@@ -22,7 +22,7 @@
;;; Commentary:
-;; See the Org-mode manual for information on how to use it.
+;; See the Org manual for information on how to use it.
;;
;; Attachments are managed in a special directory called "data", which
;; lives in the same directory as the org file itself. If this data
@@ -37,14 +37,13 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-(require 'org-id)
+(require 'cl-lib)
(require 'org)
+(require 'org-id)
(require 'vc-git)
(defgroup org-attach nil
- "Options concerning entry attachments in Org-mode."
+ "Options concerning entry attachments in Org mode."
:tag "Org Attach"
:group 'org)
@@ -55,6 +54,14 @@ where the Org file lives."
:group 'org-attach
:type 'directory)
+(defcustom org-attach-commit t
+ "If non-nil commit attachments with git.
+This is only done if the Org file is in a git repository."
+ :group 'org-attach
+ :type 'boolean
+ :version "25.2"
+ :package-version '(Org . "9.0"))
+
(defcustom org-attach-git-annex-cutoff (* 32 1024)
"If non-nil, files larger than this will be annexed instead of stored."
:group 'org-attach
@@ -124,13 +131,24 @@ lns create a symbol link. Note that this is not supported
"Non-nil means attachments are deleted upon archiving a subtree.
When set to `query', ask the user instead."
:group 'org-attach
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "Never delete attachments" nil)
(const :tag "Always delete attachments" t)
(const :tag "Query the user" query)))
+(defcustom org-attach-annex-auto-get 'ask
+ "Confirmation preference for automatically getting annex files.
+If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
+ :group 'org-attach
+ :package-version '(Org . "9")
+ :version "25.2"
+ :type '(choice
+ (const :tag "confirm with `y-or-n-p'" ask)
+ (const :tag "always get from annex if necessary" t)
+ (const :tag "never get from annex" nil)))
+
;;;###autoload
(defun org-attach ()
"The dispatcher for attachment commands.
@@ -208,25 +226,23 @@ using the entry ID will be invoked to access the unique directory for the
current entry.
If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil,
the directory and (if necessary) the corresponding ID will be created."
- (let (attach-dir uuid inherit)
+ (let (attach-dir uuid)
(setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT"))
(cond
((setq attach-dir (org-entry-get nil "ATTACH_DIR"))
(org-attach-check-absolute-path attach-dir))
((and org-attach-allow-inheritance
- (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t)))
+ (org-entry-get nil "ATTACH_DIR_INHERIT" t))
(setq attach-dir
- (save-excursion
- (save-restriction
- (widen)
- (if (marker-position org-entry-property-inherited-from)
- (goto-char org-entry-property-inherited-from)
- (org-back-to-heading t))
- (let (org-attach-allow-inheritance)
- (org-attach-dir create-if-not-exists-p)))))
+ (org-with-wide-buffer
+ (if (marker-position org-entry-property-inherited-from)
+ (goto-char org-entry-property-inherited-from)
+ (org-back-to-heading t))
+ (let (org-attach-allow-inheritance)
+ (org-attach-dir create-if-not-exists-p))))
(org-attach-check-absolute-path attach-dir)
(setq org-attach-inherited t))
- (t ; use the ID
+ (t ; use the ID
(org-attach-check-absolute-path nil)
(setq uuid (org-id-get (point) create-if-not-exists-p))
(when (or uuid create-if-not-exists-p)
@@ -272,34 +288,59 @@ the ATTACH_DIR property) their own attachment directory."
(org-entry-put nil "ATTACH_DIR_INHERIT" "t")
(message "Children will inherit attachment directory"))
+(defun org-attach-use-annex ()
+ "Return non-nil if git annex can be used."
+ (let ((git-dir (vc-git-root (expand-file-name org-attach-directory))))
+ (and org-attach-git-annex-cutoff
+ (or (file-exists-p (expand-file-name "annex" git-dir))
+ (file-exists-p (expand-file-name ".git/annex" git-dir))))))
+
+(defun org-attach-annex-get-maybe (path)
+ "Call git annex get PATH (via shell) if using git annex.
+Signals an error if the file content is not available and it was not retrieved."
+ (let ((path-relative (file-relative-name path)))
+ (when (and (org-attach-use-annex)
+ (not
+ (string-equal
+ "found"
+ (shell-command-to-string
+ (format "git annex find --format=found --in=here %s"
+ (shell-quote-argument path-relative))))))
+ (let ((should-get
+ (if (eq org-attach-annex-auto-get 'ask)
+ (y-or-n-p (format "Run git annex get %s? " path-relative))
+ org-attach-annex-auto-get)))
+ (if should-get
+ (progn (message "Running git annex get \"%s\"." path-relative)
+ (call-process "git" nil nil nil "annex" "get" path-relative))
+ (error "File %s stored in git annex but it is not available, and was not retrieved"
+ path))))))
+
(defun org-attach-commit ()
"Commit changes to git if `org-attach-directory' is properly initialized.
This checks for the existence of a \".git\" directory in that directory."
(let* ((dir (expand-file-name org-attach-directory))
(git-dir (vc-git-root dir))
+ (use-annex (org-attach-use-annex))
(changes 0))
(when (and git-dir (executable-find "git"))
(with-temp-buffer
(cd dir)
- (let ((have-annex
- (and org-attach-git-annex-cutoff
- (or (file-exists-p (expand-file-name "annex" git-dir))
- (file-exists-p (expand-file-name ".git/annex" git-dir))))))
- (dolist (new-or-modified
- (split-string
- (shell-command-to-string
- "git ls-files -zmo --exclude-standard") "\0" t))
- (if (and have-annex
- (>= (nth 7 (file-attributes new-or-modified))
- org-attach-git-annex-cutoff))
- (call-process "git" nil nil nil "annex" "add" new-or-modified)
- (call-process "git" nil nil nil "add" new-or-modified))
- (incf changes)))
+ (dolist (new-or-modified
+ (split-string
+ (shell-command-to-string
+ "git ls-files -zmo --exclude-standard") "\0" t))
+ (if (and use-annex
+ (>= (nth 7 (file-attributes new-or-modified))
+ org-attach-git-annex-cutoff))
+ (call-process "git" nil nil nil "annex" "add" new-or-modified)
+ (call-process "git" nil nil nil "add" new-or-modified))
+ (cl-incf changes))
(dolist (deleted
(split-string
(shell-command-to-string "git ls-files -z --deleted") "\0" t))
(call-process "git" nil nil nil "rm" deleted)
- (incf changes))
+ (cl-incf changes))
(when (> changes 0)
(shell-command "git commit -m 'Synchronized attachments'"))))))
@@ -340,7 +381,8 @@ METHOD may be `cp', `mv', `ln', or `lns' default taken from
((eq method 'cp) (copy-file file fname))
((eq method 'ln) (add-name-to-file file fname))
((eq method 'lns) (make-symbolic-link file fname)))
- (org-attach-commit)
+ (when org-attach-commit
+ (org-attach-commit))
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
(org-attach-store-link fname))
@@ -390,7 +432,7 @@ The attachment is created as an Emacs buffer."
(let* ((attach-dir (org-attach-dir t))
(files (org-attach-file-list attach-dir))
(file (or file
- (org-icompleting-read
+ (completing-read
"Delete attachment: "
(mapcar (lambda (f)
(list (file-name-nondirectory f)))
@@ -466,9 +508,11 @@ If IN-EMACS is non-nil, force opening in Emacs."
(files (org-attach-file-list attach-dir))
(file (if (= (length files) 1)
(car files)
- (org-icompleting-read "Open attachment: "
- (mapcar 'list files) nil t))))
- (org-open-file (expand-file-name file attach-dir) in-emacs)))
+ (completing-read "Open attachment: "
+ (mapcar #'list files) nil t)))
+ (path (expand-file-name file attach-dir)))
+ (org-attach-annex-get-maybe path)
+ (org-open-file path in-emacs)))
(defun org-attach-open-in-emacs ()
"Open attachment, force opening in Emacs.
diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el
index aeee35f..dd9ef26 100644
--- a/lisp/org-bbdb.el
+++ b/lisp/org-bbdb.el
@@ -1,4 +1,4 @@
-;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
+;;; org-bbdb.el --- Support for links to BBDB entries -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -25,12 +25,12 @@
;;
;;; Commentary:
-;; This file implements links to BBDB database entries from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to BBDB database entries from within Org.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;; It also implements an interface (based on Ivar Rummelhoff's
-;; bbdb-anniv.el) for those org-mode users, who do not use the diary
+;; bbdb-anniv.el) for those Org users, who do not use the diary
;; but who do want to include the anniversaries stored in the BBDB
;; into the org-agenda. If you already include the `diary' into the
;; agenda, you might want to prefer to include the anniversaries in
@@ -94,8 +94,7 @@
;;; Code:
(require 'org)
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
;; Declare external functions and variables
@@ -106,6 +105,7 @@
(declare-function bbdb-name "ext:bbdb-com" (string elidep))
(declare-function bbdb-completing-read-record "ext:bbdb-com"
(prompt &optional omit-records))
+(declare-function bbdb-record-field "ext:bbdb" (recond field))
(declare-function bbdb-record-getprop "ext:bbdb" (record property))
(declare-function bbdb-record-name "ext:bbdb" (record))
(declare-function bbdb-records "ext:bbdb"
@@ -124,7 +124,7 @@
(declare-function calendar-leap-year-p "calendar" (year))
(declare-function diary-ordinal-suffix "diary-lib" (n))
-(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
+(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
;; Customization
@@ -194,10 +194,12 @@ date year)."
:group 'org-bbdb-anniversaries
:require 'bbdb)
-
;; Install the link type
-(org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export)
-(add-hook 'org-store-link-functions 'org-bbdb-store-link)
+(org-link-set-parameters "bbdb"
+ :follow #'org-bbdb-open
+ :export #'org-bbdb-export
+ :complete #'org-bbdb-complete-link
+ :store #'org-bbdb-store-link)
;; Implementation
(defun org-bbdb-store-link ()
@@ -208,7 +210,7 @@ date year)."
(name (bbdb-record-name rec))
(company (if (fboundp 'bbdb-record-getprop)
(bbdb-record-getprop rec 'company)
- (car (bbdb-record-get-field rec 'organization))))
+ (car (bbdb-record-field rec 'organization))))
(link (concat "bbdb:" name)))
(org-store-link-props :type "bbdb" :name name :company company
:link link :description name)
@@ -230,10 +232,9 @@ italicized, in all other cases it is left unchanged."
(defun org-bbdb-open (name)
"Follow a BBDB link to NAME."
(require 'bbdb-com)
- (let ((inhibit-redisplay (not debug-on-error))
- (bbdb-electric-p nil))
+ (let ((inhibit-redisplay (not debug-on-error)))
(if (fboundp 'bbdb-name)
- (org-bbdb-open-old name)
+ (org-bbdb-open-old name)
(org-bbdb-open-new name))))
(defun org-bbdb-open-old (name)
@@ -280,14 +281,11 @@ italicized, in all other cases it is left unchanged."
"Convert YYYY-MM-DD to (month date year).
Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted
it will be considered unknown."
- (multiple-value-bind (a b c) (values-list (org-split-string time-str "-"))
- (if (eq c nil)
- (list (string-to-number a)
- (string-to-number b)
- nil)
- (list (string-to-number b)
- (string-to-number c)
- (string-to-number a)))))
+ (pcase (org-split-string time-str "-")
+ (`(,a ,b nil) (list (string-to-number a) (string-to-number b) nil))
+ (`(,a ,b ,c) (list (string-to-number b)
+ (string-to-number c)
+ (string-to-number a)))))
(defun org-bbdb-anniv-split (str)
"Split multiple entries in the BBDB anniversary field.
@@ -325,9 +323,9 @@ The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
(bbdb-split "\n" annivs)))
(while annivs
(setq split (org-bbdb-anniv-split (pop annivs)))
- (multiple-value-bind (m d y)
- (values-list (funcall org-bbdb-extract-date-fun (car split)))
- (setq tmp (gethash (list m d) org-bbdb-anniv-hash))
+ (pcase-let ((`(,m ,d ,y) (funcall org-bbdb-extract-date-fun
+ (car split))))
+ (setq tmp (gethash (list m d) org-bbdb-anniv-hash))
(puthash (list m d) (cons (list y
(bbdb-record-name rec)
(cadr split))
@@ -335,7 +333,7 @@ The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
org-bbdb-anniv-hash))))))
(setq org-bbdb-updated-p nil))
-(defun org-bbdb-updated (rec)
+(defun org-bbdb-updated (_rec)
"Record the fact that BBDB has been updated.
This is used by Org to re-create the anniversary hash table."
(setq org-bbdb-updated-p t))
@@ -397,6 +395,66 @@ This is used by Org to re-create the anniversary hash table."
))
text))
+;;; Return list of anniversaries for today and the next n-1 (default: n=7) days.
+;;; This is meant to be used in an org file instead of org-bbdb-anniversaries:
+;;;
+;;; %%(org-bbdb-anniversaries-future)
+;;;
+;;; or
+;;;
+;;; %%(org-bbdb-anniversaries-future 3)
+;;;
+;;; to override the 7-day default.
+
+(defun org-bbdb-date-list (d n)
+ "Return a list of dates in (m d y) format from the given date D to n-1 days hence."
+ (let ((abs (calendar-absolute-from-gregorian d)))
+ (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i)))
+ (number-sequence 0 (1- n)))))
+
+;;;###autoload
+(defun org-bbdb-anniversaries-future (&optional n)
+ "Return list of anniversaries for today and the next n-1 days (default n=7)."
+ (let ((n (or n 7)))
+ (when (<= n 0)
+ (error "The (optional) argument of `org-bbdb-anniversaries-future' \
+must be positive"))
+ (let (
+ ;; List of relevant dates.
+ (dates (org-bbdb-date-list date n))
+ ;; Function to annotate text of each element of l with the
+ ;; anniversary date d.
+ (annotate-descriptions
+ (lambda (d l)
+ (mapcar (lambda (x)
+ ;; The assumption here is that x is a bbdb link
+ ;; of the form [[bbdb:name][description]].
+ ;; This function rather arbitrarily modifies
+ ;; the description by adding the date to it in
+ ;; a fixed format.
+ (string-match "]]" x)
+ (replace-match (format " -- %d-%02d-%02d\\&"
+ (nth 2 d)
+ (nth 0 d)
+ (nth 1 d))
+ nil nil x))
+ l))))
+ ;; Map a function that generates anniversaries for each date
+ ;; over the dates and nconc the results into a single list. When
+ ;; it is no longer necessary to support older versions of Emacs,
+ ;; this can be done with a cl-mapcan; for now, we use the (apply
+ ;; #'nconc ...) method for compatibility.
+ (apply #'nconc
+ (mapcar
+ (lambda (d)
+ (let ((date d))
+ ;; Rebind 'date' so that org-bbdb-anniversaries will
+ ;; be fooled into giving us the list for the given
+ ;; date and then annotate the descriptions for that
+ ;; date.
+ (funcall annotate-descriptions d (org-bbdb-anniversaries))))
+ dates)))))
+
(defun org-bbdb-complete-link ()
"Read a bbdb link with name completion."
(require 'bbdb-com)
diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el
index a1cd8b0..db5d97b 100644
--- a/lisp/org-bibtex.el
+++ b/lisp/org-bibtex.el
@@ -1,4 +1,4 @@
-;;; org-bibtex.el --- Org links to BibTeX entries
+;;; org-bibtex.el --- Org links to BibTeX entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
;;
@@ -73,7 +73,7 @@
;; =====================================================================
;;
;; Additionally, the following functions are now available for storing
-;; bibtex entries within Org-mode documents.
+;; bibtex entries within Org documents.
;;
;; - Run `org-bibtex' to export the current file to a .bib.
;;
@@ -92,27 +92,28 @@
;;
;;; History:
;;
-;; The link creation part has been part of Org-mode for a long time.
+;; The link creation part has been part of Org for a long time.
;;
;; Creating better capture template information was inspired by a request
;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112
;; and then implemented by Bastien Guerry.
;;
;; Eric Schulte eventually added the functions for translating between
-;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex
-;; fields of existing Org-mode headlines.
+;; Org headlines and Bibtex entries, and for fleshing out the Bibtex
+;; fields of existing Org headlines.
;;
-;; Org-mode loads this module by default - if this is not what you want,
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
(require 'org)
(require 'bibtex)
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org-compat)
+(defvar org-agenda-overriding-header)
+(defvar org-agenda-search-view-always-boolean)
(defvar org-bibtex-description nil) ; dynamically scoped from org.el
(defvar org-id-locations)
@@ -120,7 +121,6 @@
(declare-function bibtex-generate-autokey "bibtex" ())
(declare-function bibtex-parse-entry "bibtex" (&optional content))
(declare-function bibtex-url "bibtex" (&optional pos no-browse))
-(declare-function org-babel-trim "ob" (string &optional regexp))
;;; Bibtex data
@@ -293,7 +293,7 @@ It is relevant only if `org-bibtex-tags-are-keywords' is non-nil.
Tag inheritence itself is controlled by `org-use-tag-inheritence'
and `org-exclude-tags-from-inheritence'."
:group 'org-bibtex
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'boolean)
@@ -312,7 +312,7 @@ and `org-exclude-tags-from-inheritence'."
(org-entry-get (point) (upcase property))
(org-entry-get (point) (concat org-bibtex-prefix
(upcase property)))))))
- (when it (org-babel-trim it))))
+ (when it (org-trim it))))
(defun org-bibtex-put (property value)
(let ((prop (upcase (if (keywordp property)
@@ -325,29 +325,27 @@ and `org-exclude-tags-from-inheritence'."
(defun org-bibtex-headline ()
"Return a bibtex entry of the given headline as a string."
- (let* ((val (lambda (key lst) (cdr (assoc key lst))))
- (to (lambda (string) (intern (concat ":" string))))
- (from (lambda (key) (substring (symbol-name key) 1)))
- flatten ; silent compiler warning
- (flatten (lambda (&rest lsts)
- (apply #'append (mapcar
- (lambda (e)
- (if (listp e) (apply flatten e) (list e)))
- lsts))))
- (notes (buffer-string))
- (id (org-bibtex-get org-bibtex-key-property))
- (type (org-bibtex-get org-bibtex-type-property-name))
- (tags (when org-bibtex-tags-are-keywords
- (delq nil
- (mapcar
- (lambda (tag)
- (unless (member tag
- (append org-bibtex-tags
- org-bibtex-no-export-tags))
- tag))
- (if org-bibtex-inherit-tags
- (org-get-tags-at)
- (org-get-local-tags-at)))))))
+ (letrec ((val (lambda (key lst) (cdr (assoc key lst))))
+ (to (lambda (string) (intern (concat ":" string))))
+ (from (lambda (key) (substring (symbol-name key) 1)))
+ (flatten (lambda (&rest lsts)
+ (apply #'append (mapcar
+ (lambda (e)
+ (if (listp e) (apply flatten e) (list e)))
+ lsts))))
+ (id (org-bibtex-get org-bibtex-key-property))
+ (type (org-bibtex-get org-bibtex-type-property-name))
+ (tags (when org-bibtex-tags-are-keywords
+ (delq nil
+ (mapcar
+ (lambda (tag)
+ (unless (member tag
+ (append org-bibtex-tags
+ org-bibtex-no-export-tags))
+ tag))
+ (if org-bibtex-inherit-tags
+ (org-get-tags-at)
+ (org-get-local-tags-at)))))))
(when type
(let ((entry (format
"@%s{%s,\n%s\n}\n" type id
@@ -373,7 +371,7 @@ and `org-exclude-tags-from-inheritence'."
(mapcar
(lambda (field)
(let ((value (or (org-bibtex-get (funcall from field))
- (and (equal :title field)
+ (and (eq :title field)
(nth 4 (org-heading-components))))))
(when value (cons (funcall from field) value))))
(funcall flatten
@@ -436,13 +434,14 @@ With optional argument OPTIONAL, also prompt for optional fields."
(funcall val :required (funcall val type org-bibtex-types)))
(when optional (funcall val :optional (funcall val type org-bibtex-types)))))
(when (consp field) ; or'd pair of fields e.g., (:editor :author)
- (let ((present (first (remove
+ (let ((present (nth 0 (remove
nil
(mapcar
- (lambda (f) (when (org-bibtex-get (funcall name f)) f))
+ (lambda (f)
+ (when (org-bibtex-get (funcall name f)) f))
field)))))
(setf field (or present (funcall keyword
- (org-icompleting-read
+ (completing-read
"Field: " (mapcar name field)))))))
(let ((name (funcall name field)))
(unless (org-bibtex-get name)
@@ -454,8 +453,9 @@ With optional argument OPTIONAL, also prompt for optional fields."
;;; Bibtex link functions
-(org-add-link-type "bibtex" 'org-bibtex-open)
-(add-hook 'org-store-link-functions 'org-bibtex-store-link)
+(org-link-set-parameters "bibtex"
+ :follow #'org-bibtex-open
+ :store #'org-bibtex-store-link)
(defun org-bibtex-open (path)
"Visit the bibliography entry on PATH."
@@ -548,7 +548,7 @@ With optional argument OPTIONAL, also prompt for optional fields."
(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
-;;; Bibtex <-> Org-mode headline translation functions
+;;; Bibtex <-> Org headline translation functions
(defun org-bibtex (filename)
"Export each headline in the current file to a bibtex entry.
Headlines are exported using `org-bibtex-headline'."
@@ -564,7 +564,7 @@ Headlines are exported using `org-bibtex-headline'."
(let ((bibtex-entries
(remove nil (org-map-entries
(lambda ()
- (condition-case foo
+ (condition-case nil
(org-bibtex-headline)
(error (throw 'bib (point)))))))))
(with-temp-file filename
@@ -595,7 +595,7 @@ With prefix argument OPTIONAL also prompt for optional fields."
With a prefix arg, query for optional fields as well.
If nonew is t, add data to the headline of the entry at point."
(interactive "P")
- (let* ((type (org-icompleting-read
+ (let* ((type (completing-read
"Type: " (mapcar (lambda (type)
(substring (symbol-name (car type)) 1))
org-bibtex-types)
@@ -614,7 +614,7 @@ If nonew is t, add data to the headline of the entry at point."
(org-bibtex-put org-bibtex-type-property-name
(substring (symbol-name type) 1))
(org-bibtex-fleshout type arg)
- (mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags)))
+ (dolist (tag org-bibtex-tags) (org-toggle-tag tag 'on))))
(defun org-bibtex-create-in-current-entry (&optional arg)
"Add bibliographical data to the current entry.
@@ -628,10 +628,10 @@ This uses `bibtex-parse-entry'."
(interactive)
(let ((keyword (lambda (str) (intern (concat ":" (downcase str)))))
(clean-space (lambda (str) (replace-regexp-in-string
- "[[:space:]\n\r]+" " " str)))
+ "[[:space:]\n\r]+" " " str)))
(strip-delim
- (lambda (str) ; strip enclosing "..." and {...}
- (dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
+ (lambda (str) ; strip enclosing "..." and {...}
+ (dolist (pair '((34 . 34) (123 . 125)))
(when (and (> (length str) 1)
(= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair)))
@@ -639,10 +639,10 @@ This uses `bibtex-parse-entry'."
(push (mapcar
(lambda (pair)
(cons (let ((field (funcall keyword (car pair))))
- (case field
+ (pcase field
(:=type= :type)
(:=key= :key)
- (otherwise field)))
+ (_ field)))
(funcall clean-space (funcall strip-delim (cdr pair)))))
(save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
org-bibtex-entries)))
@@ -683,25 +683,23 @@ Return the number of saved entries."
(org-bibtex-put org-bibtex-type-property-name
(downcase (funcall val :type)))
(dolist (pair entry)
- (case (car pair)
+ (pcase (car pair)
(:title nil)
(:type nil)
(:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
(:keywords (if org-bibtex-tags-are-keywords
- (mapc
- (lambda (kw)
- (funcall
- togtag
- (replace-regexp-in-string
- "[^[:alnum:]_@#%]" ""
- (replace-regexp-in-string "[ \t]+" "_" kw))))
- (split-string (cdr pair) ", *"))
+ (dolist (kw (split-string (cdr pair) ", *"))
+ (funcall
+ togtag
+ (replace-regexp-in-string
+ "[^[:alnum:]_@#%]" ""
+ (replace-regexp-in-string "[ \t]+" "_" kw))))
(org-bibtex-put (car pair) (cdr pair))))
- (otherwise (org-bibtex-put (car pair) (cdr pair)))))
+ (_ (org-bibtex-put (car pair) (cdr pair)))))
(mapc togtag org-bibtex-tags)))
(defun org-bibtex-yank ()
- "If kill ring holds a bibtex entry yank it as an Org-mode headline."
+ "If kill ring holds a bibtex entry yank it as an Org headline."
(interactive)
(let (entry)
(with-temp-buffer (yank 1) (setf entry (org-bibtex-read)))
@@ -710,7 +708,7 @@ Return the number of saved entries."
(error "Yanked text does not appear to contain a BibTeX entry"))))
(defun org-bibtex-import-from-file (file)
- "Read bibtex entries from FILE and insert as Org-mode headlines after point."
+ "Read bibtex entries from FILE and insert as Org headlines after point."
(interactive "fFile: ")
(dotimes (_ (org-bibtex-read-file file))
(save-excursion (org-bibtex-write))
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 5052ad8..ced8399 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1,4 +1,4 @@
-;;; org-capture.el --- Fast note taking in Org-mode
+;;; org-capture.el --- Fast note taking in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -47,20 +47,18 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org)
+(declare-function org-at-encrypted-entry-p "org-crypt" ())
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
+(declare-function org-decrypt-entry "org-crypt" ())
+(declare-function org-encrypt-entry "org-crypt" ())
(declare-function org-table-analyze "org-table" ())
(declare-function org-table-goto-line "org-table" (N))
-(declare-function org-pop-to-buffer-same-window "org-compat"
- (&optional buffer-or-name norecord label))
-(declare-function org-at-encrypted-entry-p "org-crypt" ())
-(declare-function org-encrypt-entry "org-crypt" ())
-(declare-function org-decrypt-entry "org-crypt" ())
+(defvar org-end-time-was-given)
(defvar org-remember-default-headline)
(defvar org-remember-templates)
(defvar org-table-hlines)
@@ -77,6 +75,9 @@
;; to indicate that the link properties have already been stored
(defvar org-capture-link-is-already-stored nil)
+(defvar org-capture-is-refiling nil
+ "Non-nil when capture process is refiling an entry.")
+
(defgroup org-capture nil
"Options concerning capturing new entries."
:tag "Org Capture"
@@ -104,9 +105,9 @@ description A short string describing the template, will be shown during
selection.
type The type of entry. Valid types are:
- entry an Org-mode node, with a headline. Will be
- filed as the child of the target entry or as
- a top-level entry.
+ entry an Org node, with a headline. Will be filed
+ as the child of the target entry or as a
+ top-level entry.
item a plain list item, will be placed in the
first plain list at the target
location.
@@ -117,7 +118,7 @@ type The type of entry. Valid types are:
plain text to be inserted as it is.
target Specification of where the captured item should be placed.
- In Org-mode files, targets usually define a node. Entries will
+ In Org files, targets usually define a node. Entries will
become children of this node, other types will be added to the
table or list in the body of this node.
@@ -150,6 +151,12 @@ target Specification of where the captured item should be placed.
(file+datetree+prompt \"path/to/file\")
Will create a heading in a date tree, prompts for date
+ (file+weektree \"path/to/file\")
+ Will create a heading in a week tree for today's date
+
+ (file+weektree+prompt \"path/to/file\")
+ Will create a heading in a week tree, prompts for date
+
(file+function \"path/to/file\" function-finding-location)
A function to find the right location in the file
@@ -157,8 +164,8 @@ target Specification of where the captured item should be placed.
File to the entry that is currently being clocked
(function function-finding-location)
- Most general way, write your own function to find both
- file and location
+ Most general way: write your own function which both visits
+ the file and moves point to the right location
template The template for creating the capture item. If you leave this
empty, an appropriate default template will be used. See below
@@ -220,15 +227,20 @@ properties are:
is finalized.
The template defines the text to be inserted. Often this is an
-org-mode entry (so the first line should start with a star) that
+Org mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
-be replaced with content and expanded in this order:
+be replaced with content and expanded:
- %[pathname] Insert the contents of the file given by `pathname'.
+ %[pathname] Insert the contents of the file given by
+ `pathname'. These placeholders are expanded at the very
+ beginning of the process so they can be used to extend the
+ current template.
%(sexp) Evaluate elisp `(sexp)' and replace it with the results.
- For convenience, %:keyword (see below) placeholders within
- the expression will be expanded prior to this.
+ Only placeholders pre-existing within the template, or
+ introduced with %[pathname] are expanded this way. Since this
+ happens after expanding non-interactive %-escapes, those can
+ be used to fill the expression.
%<...> The result of format-time-string on the ... format specification.
%t Time stamp, date only.
%T Time stamp with date and time.
@@ -257,8 +269,8 @@ be replaced with content and expanded in this order:
A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
- %\\n Insert the text entered at the nth %^{prompt}, where `n' is
- a number, starting from 1.
+ %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N
+ is a number, starting from 1.
Apart from these general escapes, you can access information specific to
the link type that is created. For example, calling `org-capture' in emails
@@ -276,13 +288,21 @@ gnus | %:from %:fromname %:fromaddress
| %:date %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
-w3, w3m | %:type %:url
+eww, w3, w3m | %:type %:url
info | %:type %:file %:node
-calendar | %:type %:date"
+calendar | %:type %:date
+
+When you need to insert a literal percent sign in the template,
+you can escape ambiguous cases with a backward slash, e.g., \\%i."
:group 'org-capture
:version "24.1"
:type
- '(repeat
+ (let ((file-variants '(choice :tag "Filename "
+ (file :tag "Literal")
+ (function :tag "Function")
+ (variable :tag "Variable")
+ (sexp :tag "Form"))))
+ `(repeat
(choice :value ("" "" entry (file "~/org/notes.org") "")
(list :tag "Multikey description"
(string :tag "Keys ")
@@ -299,39 +319,45 @@ calendar | %:type %:date"
(choice :tag "Target location"
(list :tag "File"
(const :format "" file)
- (file :tag " File"))
+ ,file-variants)
(list :tag "ID"
(const :format "" id)
(string :tag " ID"))
(list :tag "File & Headline"
(const :format "" file+headline)
- (file :tag " File ")
+ ,file-variants
(string :tag " Headline"))
(list :tag "File & Outline path"
(const :format "" file+olp)
- (file :tag " File ")
+ ,file-variants
(repeat :tag "Outline path" :inline t
(string :tag "Headline")))
(list :tag "File & Regexp"
(const :format "" file+regexp)
- (file :tag " File ")
+ ,file-variants
(regexp :tag " Regexp"))
(list :tag "File & Date tree"
(const :format "" file+datetree)
- (file :tag " File"))
+ ,file-variants)
(list :tag "File & Date tree, prompt for date"
(const :format "" file+datetree+prompt)
- (file :tag " File"))
+ ,file-variants)
+ (list :tag "File & Week tree"
+ (const :format "" file+weektree)
+ ,file-variants)
+ (list :tag "File & Week tree, prompt for date"
+ (const :format "" file+weektree+prompt)
+ ,file-variants)
(list :tag "File & function"
(const :format "" file+function)
- (file :tag " File ")
+ ,file-variants
(sexp :tag " Function"))
(list :tag "Current clocking task"
(const :format "" clock))
(list :tag "Function"
(const :format "" function)
(sexp :tag " Function")))
- (choice :tag "Template"
+ (choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
@@ -352,7 +378,7 @@ calendar | %:type %:date"
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (const t))
- ((const :format "%v " :kill-buffer) (const t))))))))
+ ((const :format "%v " :kill-buffer) (const t)))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a capture process is finalized.
@@ -423,7 +449,7 @@ to avoid conflicts with other active capture processes."
(defvar org-capture-mode-map (make-sparse-keymap)
"Keymap for `org-capture-mode', a minor mode.
-Use this map to set additional keybindings for when Org-mode is used
+Use this map to set additional keybindings for when Org mode is used
for a capture buffer.")
(defvar org-capture-mode-hook nil
@@ -434,11 +460,12 @@ for a capture buffer.")
Turning on this mode runs the normal hook `org-capture-mode-hook'."
nil " Rem" org-capture-mode-map
- (org-set-local
- 'header-line-format
+ (setq-local
+ header-line-format
(substitute-command-keys
- "\\<org-capture-mode-map>Capture buffer. Finish \\[org-capture-finalize], \
-refile \\[org-capture-refile], abort \\[org-capture-kill].")))
+ "\\<org-capture-mode-map>Capture buffer. Finish \
+`\\[org-capture-finalize]', refile `\\[org-capture-refile]', \
+abort `\\[org-capture-kill]'.")))
(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize)
(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill)
(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile)
@@ -507,7 +534,8 @@ to avoid duplicates.)"
(defcustom org-capture-use-agenda-date nil
"Non-nil means use the date at point when capturing from agendas.
-When nil, you can still capture using the date at point with \\[org-agenda-capture]."
+When nil, you can still capture using the date at point with
+`\\[org-agenda-capture]'."
:group 'org-capture
:version "24.3"
:type 'boolean)
@@ -516,17 +544,20 @@ When nil, you can still capture using the date at point with \\[org-agenda-captu
(defun org-capture (&optional goto keys)
"Capture something.
\\<org-capture-mode-map>
-This will let you select a template from `org-capture-templates', and then
-file the newly captured information. The text is immediately inserted
-at the target location, and an indirect buffer is shown where you can
-edit it. Pressing \\[org-capture-finalize] brings you back to the previous state
-of Emacs, so that you can continue your work.
-
-When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture
-anything, just go to the file/headline where the selected template
-stores its notes. With a double prefix argument \
-\\[universal-argument] \\[universal-argument], go to the last note
-stored.
+This will let you select a template from `org-capture-templates', and
+then file the newly captured information. The text is immediately
+inserted at the target location, and an indirect buffer is shown where
+you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the \
+previous
+state of Emacs, so that you can continue your work.
+
+When called interactively with a `\\[universal-argument]' prefix argument \
+GOTO, don't
+capture anything, just go to the file/headline where the selected
+template stores its notes.
+
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to \
+the last note stored.
When called with a `C-0' (zero) prefix, insert a template at point.
@@ -567,7 +598,7 @@ of the day at point (if any) or the current HH:MM time."
((equal entry "C")
(customize-variable 'org-capture-templates))
((equal entry "q")
- (error "Abort"))
+ (user-error "Abort"))
(t
(org-capture-set-plist entry)
(org-capture-get-template)
@@ -599,10 +630,10 @@ of the day at point (if any) or the current HH:MM time."
(org-capture-insert-template-here)
(condition-case error
(org-capture-place-template
- (equal (car (org-capture-get :target)) 'function))
+ (eq (car (org-capture-get :target)) 'function))
((error quit)
(if (and (buffer-base-buffer (current-buffer))
- (string-match "\\`CAPTURE-" (buffer-name)))
+ (string-prefix-p "CAPTURE-" (buffer-name)))
(kill-buffer (current-buffer)))
(set-window-configuration (org-capture-get :return-to-wconf))
(error "Capture template `%s': %s"
@@ -616,7 +647,7 @@ of the day at point (if any) or the current HH:MM time."
(org-capture-put :interrupted-clock
(copy-marker org-clock-marker)))
(org-clock-in)
- (org-set-local 'org-capture-clock-was-started t))
+ (setq-local org-capture-clock-was-started t))
(error
"Could not start the clock in this capture buffer")))
(if (org-capture-get :immediate-finish)
@@ -649,7 +680,7 @@ captured item after finalizing."
(setq stay-with-capture t))
(unless (and org-capture-mode
(buffer-base-buffer (current-buffer)))
- (error "This does not seem to be a capture buffer for Org-mode"))
+ (error "This does not seem to be a capture buffer for Org mode"))
(run-hooks 'org-capture-prepare-finalize-hook)
@@ -685,7 +716,7 @@ captured item after finalizing."
(m2 (org-capture-get :end-marker 'local)))
(if (and m1 m2 (= m1 beg) (= m2 end))
(progn
- (setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry))
+ (setq m2 (if (cdr (assq 'heading org-blank-before-new-entry))
m2 (1+ m2))
m2 (if (< (point-max) m2) (point-max) m2))
(setq abort-note 'clean)
@@ -773,11 +804,12 @@ captured item after finalizing."
;; Special cases
(cond
(abort-note
- (cond
- ((equal abort-note 'clean)
- (message "Capture process aborted and target buffer cleaned up"))
- ((equal abort-note 'dirty)
- (error "Capture process aborted, but target buffer could not be cleaned up correctly"))))
+ (cl-case abort-note
+ (clean
+ (message "Capture process aborted and target buffer cleaned up"))
+ (dirty
+ (error "Capture process aborted, but target buffer could not be \
+cleaned up correctly"))))
(stay-with-capture
(org-capture-goto-last-stored)))
;; Return if we did store something
@@ -793,17 +825,15 @@ already gone. Any prefix argument will be passed to the refile command."
"Refiling from a capture buffer makes only sense for `entry'-type templates"))
(let ((pos (point))
(base (buffer-base-buffer (current-buffer)))
- (org-refile-for-capture t)
+ (org-capture-is-refiling t)
(kill-buffer (org-capture-get :kill-buffer 'local)))
(org-capture-put :kill-buffer nil)
(org-capture-finalize)
(save-window-excursion
(with-current-buffer (or base (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (call-interactively 'org-refile)))))
+ (org-with-wide-buffer
+ (goto-char pos)
+ (call-interactively 'org-refile))))
(when kill-buffer (kill-buffer base))))
(defun org-capture-kill ()
@@ -899,21 +929,25 @@ Store them in the capture property list."
(setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
(error "No match for target regexp in file %s" (nth 1 target))))
- ((memq (car target) '(file+datetree file+datetree+prompt))
+ ((memq (car target) '(file+datetree file+datetree+prompt file+weektree file+weektree+prompt))
(require 'org-datetree)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
- ;; Make a date tree entry, with the current date (or yesterday,
- ;; if we are extending dates for a couple of hours)
- (org-datetree-find-date-create
+ ;; Make a date/week tree entry, with the current date (or
+ ;; yesterday, if we are extending dates for a couple of hours)
+ (funcall
+ (cond
+ ((memq (car target) '(file+weektree file+weektree+prompt))
+ #'org-datetree-find-iso-week-create)
+ (t #'org-datetree-find-date-create))
(calendar-gregorian-from-absolute
(cond
(org-overriding-default-time
;; use the overriding default time
(time-to-days org-overriding-default-time))
- ((eq (car target) 'file+datetree+prompt)
+ ((memq (car target) '(file+datetree+prompt file+weektree+prompt))
;; prompt for date
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
@@ -924,7 +958,9 @@ Store them in the capture property list."
(not org-time-was-given))
(not (= (time-to-days prompt-time) (org-today))))
;; Use 00:00 when no time is given for another date than today?
- (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time)))))
+ (apply #'encode-time
+ (append '(0 0 0)
+ (cl-cdddr (decode-time prompt-time)))))
((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer)
;; Replace any time range by its start
(apply 'encode-time
@@ -972,16 +1008,13 @@ Store them in the capture property list."
(defun org-capture-expand-file (file)
"Expand functions and symbols for FILE.
-When FILE is a function, call it. When it is a form, evaluate
-it. When it is a variable, retrieve the value. When it is
-a string, return it. However, if it is the empty string, return
-`org-default-notes-file' instead."
+When FILE is a function, call it. When it is a variable,
+retrieve its value. When it is the empty string, return
+`org-default-notes-file'. In any other case, return FILE as-is."
(cond
((equal file "") org-default-notes-file)
- ((org-string-nw-p file) file)
((functionp file) (funcall file))
((and (symbolp file) (boundp file)) (symbol-value file))
- ((consp file) (eval file))
(t file)))
(defun org-capture-target-buffer (file)
@@ -994,12 +1027,6 @@ a string, return it. However, if it is the empty string, return
(progn (org-capture-put :new-buffer t)
(find-file-noselect (expand-file-name file org-directory)))))
-(defun org-capture-steal-local-variables (buffer)
- "Install Org-mode local variables of BUFFER."
- (mapc (lambda (v)
- (ignore-errors (org-set-local (car v) (cdr v))))
- (buffer-local-variables buffer)))
-
(defun org-capture-place-template (&optional inhibit-wconf-store)
"Insert the template at the target location, and display the buffer.
When `inhibit-wconf-store', don't store the window configuration, as it
@@ -1012,32 +1039,29 @@ may have been stored before."
(widen)
(outline-show-all)
(goto-char (org-capture-get :pos))
- (org-set-local 'org-capture-target-marker
- (point-marker))
- (org-set-local 'outline-level 'org-outline-level)
- (let* ((template (org-capture-get :template))
- (type (org-capture-get :type)))
- (case type
- ((nil entry) (org-capture-place-entry))
- (table-line (org-capture-place-table-line))
- (plain (org-capture-place-plain-text))
- (item (org-capture-place-item))
- (checkitem (org-capture-place-item))))
+ (setq-local outline-level 'org-outline-level)
+ (pcase (org-capture-get :type)
+ ((or `nil `entry) (org-capture-place-entry))
+ (`table-line (org-capture-place-table-line))
+ (`plain (org-capture-place-plain-text))
+ (`item (org-capture-place-item))
+ (`checkitem (org-capture-place-item)))
(org-capture-mode 1)
- (org-set-local 'org-capture-current-plist org-capture-plist))
+ (setq-local org-capture-current-plist org-capture-plist))
(defun org-capture-place-entry ()
"Place the template as a new Org entry."
(let* ((txt (org-capture-get :template))
(reversed (org-capture-get :prepend))
(target-entry-p (org-capture-get :target-entry-p))
- level beg end file)
+ level beg end)
(and (org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
(cond
((not target-entry-p)
- ;; Insert as top-level entry, either at beginning or at end of file
+ ;; Insert as top-level entry, either at beginning or at end of
+ ;; file.
(setq level 1)
(if reversed
(progn (goto-char (point-min))
@@ -1136,7 +1160,7 @@ may have been stored before."
(let* ((txt (org-capture-get :template))
(target-entry-p (org-capture-get :target-entry-p))
(table-line-pos (org-capture-get :table-line-pos))
- ind beg end)
+ beg end)
(cond
((org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
@@ -1167,6 +1191,7 @@ may have been stored before."
(cond
((and table-line-pos
(string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos))
+ (goto-char (point-min))
;; we have a complex line specification
(let ((ll (ignore-errors
(save-match-data (org-table-analyze))
@@ -1284,16 +1309,14 @@ Of course, if exact position has been required, just put it there."
(point-at-bol))
(point))))))
(with-current-buffer (buffer-base-buffer (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-capture)))
- (when bookmark-name
- (with-demoted-errors
- (bookmark-set bookmark-name))))
- (move-marker org-capture-last-stored-marker (point)))))))
+ (org-with-wide-buffer
+ (goto-char pos)
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
+ (move-marker org-capture-last-stored-marker (point))))))
(defun org-capture-narrow (beg end)
"Narrow, unless configuration says not to narrow."
@@ -1379,13 +1402,11 @@ Point will remain at the first line after the inserted text."
"Go to the target location of a capture template.
The user is queried for the template."
(interactive)
- (let* (org-select-template-temp-major-mode
- (entry (org-capture-select-template template-key)))
- (unless entry
- (error "No capture template selected"))
+ (let ((entry (org-capture-select-template template-key)))
+ (unless entry (error "No capture template selected"))
(org-capture-set-plist entry)
(org-capture-set-target-location)
- (org-pop-to-buffer-same-window (org-capture-get :buffer))
+ (pop-to-buffer-same-window (org-capture-get :buffer))
(goto-char (org-capture-get :pos))))
(defun org-capture-get-indirect-buffer (&optional buffer prefix)
@@ -1395,7 +1416,7 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(let ((n 1) (base (buffer-name buffer)) bname)
(setq bname (concat prefix "-" base))
(while (buffer-live-p (get-buffer bname))
- (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base)))
+ (setq bname (concat prefix "-" (number-to-string (cl-incf n)) "-" base)))
(condition-case nil
(make-indirect-buffer buffer bname 'clone)
(error
@@ -1450,7 +1471,7 @@ only the bare key is returned."
(cond
((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1))
;; This is a description on this level
- (setq dkey (caar tbl) ddesc (cadar tbl))
+ (setq dkey (caar tbl) ddesc (cl-cadar tbl))
(pop tbl)
(push dkey des-keys)
(push dkey allowed-keys)
@@ -1487,7 +1508,7 @@ only the bare key is returned."
(setq pressed (char-to-string (read-char-exclusive))))
(when (equal pressed "\C-g")
(kill-buffer buffer)
- (error "Abort"))
+ (user-error "Abort"))
(when (and (not (assoc pressed table))
(not (member pressed des-keys))
(assoc pressed specials))
@@ -1528,43 +1549,35 @@ Lisp programs can force the template by setting KEYS to a string."
(defun org-capture-fill-template (&optional template initial annotation)
"Fill a template and return the filled template as a string.
The template may still contain \"%?\" for cursor positioning."
- (setq template (or template (org-capture-get :template)))
- (when (stringp initial)
- (setq initial (org-no-properties initial)))
- (let* ((buffer (org-capture-get :buffer))
+ (let* ((template (or template (org-capture-get :template)))
+ (buffer (org-capture-get :buffer))
(file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
- (ct (org-capture-get :default-time))
- (dct (decode-time ct))
- (ct1
- (if (< (nth 2 dct) org-extend-today-until)
- (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
- ct))
- (plist-p (if org-store-link-plist t nil))
- (v-c (and (> (length kill-ring) 0) (current-kill 0)))
+ (time (let* ((c (or (org-capture-get :default-time) (current-time)))
+ (d (decode-time c)))
+ (if (< (nth 2 d) org-extend-today-until)
+ (encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d))
+ c)))
+ (v-t (format-time-string (org-time-stamp-format nil) time))
+ (v-T (format-time-string (org-time-stamp-format t) time))
+ (v-u (format-time-string (org-time-stamp-format nil t) time))
+ (v-U (format-time-string (org-time-stamp-format t t) time))
+ (v-c (and kill-ring (current-kill 0)))
(v-x (or (org-get-x-clipboard 'PRIMARY)
(org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY)))
- (v-t (format-time-string (car org-time-stamp-formats) ct1))
- (v-T (format-time-string (cdr org-time-stamp-formats) ct1))
- (v-u (concat "[" (substring v-t 1 -1) "]"))
- (v-U (concat "[" (substring v-T 1 -1) "]"))
- ;; `initial' and `annotation' might habe been passed.
- ;; But if the property list has them, we prefer those values
+ ;; `initial' and `annotation' might have been passed. But if
+ ;; the property list has them, we prefer those values.
(v-i (or (plist-get org-store-link-plist :initial)
- initial
+ (and (stringp initial) (org-no-properties initial))
(org-capture-get :initial)
""))
- (v-a (or (plist-get org-store-link-plist :annotation)
- annotation
- (org-capture-get :annotation)
- ""))
- ;; Is the link empty? Then we do not want it...
- (v-a (if (equal v-a "[[]]") "" v-a))
- (clipboards (remove nil (list v-i
- (org-get-x-clipboard 'PRIMARY)
- (org-get-x-clipboard 'CLIPBOARD)
- (org-get-x-clipboard 'SECONDARY)
- v-c)))
+ (v-a
+ (let ((a (or (plist-get org-store-link-plist :annotation)
+ annotation
+ (org-capture-get :annotation)
+ "")))
+ ;; Is the link empty? Then we do not want it...
+ (if (equal a "[[]]") "" a)))
(l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]")
(v-A (if (and v-a (string-match l-re v-a))
(replace-match "[[\\1][%^{Link description}]]" nil nil v-a)
@@ -1573,203 +1586,256 @@ The template may still contain \"%?\" for cursor positioning."
(replace-match "\\1" nil nil v-a)
v-a))
(v-n user-full-name)
- (v-k (if (marker-buffer org-clock-marker)
- (org-no-properties org-clock-heading)))
+ (v-k (and (marker-buffer org-clock-marker)
+ (org-no-properties org-clock-heading)))
(v-K (if (marker-buffer org-clock-marker)
(org-make-link-string
(buffer-file-name (marker-buffer org-clock-marker))
org-clock-heading)))
(v-f (or (org-capture-get :original-file-nondirectory) ""))
(v-F (or (org-capture-get :original-file) ""))
- v-I
- (org-startup-folded nil)
- (org-inhibit-startup t)
- org-time-was-given org-end-time-was-given x
- prompt completions char time pos default histvar strings)
-
- (setq org-store-link-plist
- (plist-put org-store-link-plist :annotation v-a)
- org-store-link-plist
- (plist-put org-store-link-plist :initial v-i))
- (setq initial v-i)
-
- (unless template (setq template "") (message "No template") (ding)
- (sit-for 1))
+ (clipboards (delq nil
+ (list v-i
+ (org-get-x-clipboard 'PRIMARY)
+ (org-get-x-clipboard 'CLIPBOARD)
+ (org-get-x-clipboard 'SECONDARY)
+ v-c))))
+
+ (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a))
+ (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i))
+
+ (unless template
+ (setq template "")
+ (message "no template") (ding)
+ (sit-for 1))
(save-window-excursion
(org-switch-to-buffer-other-window (get-buffer-create "*Capture*"))
(erase-buffer)
+ (setq buffer-file-name nil)
+ (setq mark-active nil)
(insert template)
(goto-char (point-min))
- (org-capture-steal-local-variables buffer)
- (setq buffer-file-name nil mark-active nil)
- ;; %[] Insert contents of a file.
- (goto-char (point-min))
- (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
- (unless (org-capture-escaped-%)
- (let ((start (match-beginning 0))
- (end (match-end 0))
- (filename (expand-file-name (match-string 1))))
- (goto-char start)
- (delete-region start end)
- (condition-case error
- (insert-file-contents filename)
- (error (insert (format "%%![Couldn not insert %s: %s]"
- filename error)))))))
-
- ;; The current time
- (goto-char (point-min))
- (while (re-search-forward "%<\\([^>\n]+\\)>" nil t)
- (replace-match (format-time-string (match-string 1)) t t))
+ ;; %[] insert contents of a file.
+ (save-excursion
+ (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
+ (let ((filename (expand-file-name (match-string 1)))
+ (beg (copy-marker (match-beginning 0)))
+ (end (copy-marker (match-end 0))))
+ (unless (org-capture-escaped-%)
+ (delete-region beg end)
+ (set-marker beg nil)
+ (set-marker end nil)
+ (condition-case error
+ (insert-file-contents filename)
+ (error
+ (insert (format "%%![couldn not insert %s: %s]"
+ filename
+ error))))))))
- ;; Simple %-escapes
- (goto-char (point-min))
- (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t)
- (unless (org-capture-escaped-%)
- (when (and initial (equal (match-string 0) "%i"))
- (save-match-data
- (let* ((lead (buffer-substring
- (point-at-bol) (match-beginning 0))))
- (setq v-i (mapconcat 'identity
- (org-split-string initial "\n")
- (concat "\n" lead))))))
- (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "")
- t t)))
-
- ;; From the property list
- (when plist-p
- (goto-char (point-min))
- (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
- (unless (org-capture-escaped-%)
- (and (setq x (or (plist-get org-store-link-plist
- (intern (match-string 1))) ""))
- (replace-match x t t)))))
+ ;; Mark %() embedded elisp for later evaluation.
+ (org-capture-expand-embedded-elisp 'mark)
- ;; %() embedded elisp
- (goto-char (point-min))
+ ;; Expand non-interactive templates.
+ (let ((regexp "%\\(:[-a-za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlntTuUx]\\)"))
+ (save-excursion
+ (while (re-search-forward regexp nil t)
+ ;; `org-capture-escaped-%' may modify buffer and cripple
+ ;; match-data. Use markers instead. Ditto for other
+ ;; templates.
+ (let ((pos (copy-marker (match-beginning 0)))
+ (end (copy-marker (match-end 0)))
+ (value (match-string 1))
+ (time-string (match-string 2)))
+ (unless (org-capture-escaped-%)
+ (delete-region pos end)
+ (set-marker pos nil)
+ (set-marker end nil)
+ (let ((replacement
+ (pcase (string-to-char value)
+ (?< (format-time-string time-string))
+ (?:
+ (or (plist-get org-store-link-plist (intern value))
+ ""))
+ (?i (let ((lead (buffer-substring-no-properties
+ (line-beginning-position) (point))))
+ (mapconcat #'identity
+ (split-string v-i "\n")
+ (concat "\n" lead))))
+ (?a v-a)
+ (?A v-A)
+ (?c v-c)
+ (?f v-f)
+ (?F v-F)
+ (?k v-k)
+ (?K v-K)
+ (?l v-l)
+ (?n v-n)
+ (?t v-t)
+ (?T v-T)
+ (?u v-u)
+ (?U v-U)
+ (?x v-x))))
+ (insert
+ (if (org-capture-inside-embedded-elisp-p)
+ (replace-regexp-in-string "\"" "\\\\\"" replacement)
+ replacement))))))))
+
+ ;; Expand %() embedded Elisp. Limit to Sexp originally marked.
(org-capture-expand-embedded-elisp)
- ;; Turn on org-mode in temp buffer, set local variables
- ;; This is to support completion in interactive prompts
+ ;; Expand interactive templates. This is the last step so that
+ ;; template is mostly expanded when prompting happens. Turn on
+ ;; Org mode and set local variables. This is to support
+ ;; completion in interactive prompts.
(let ((org-inhibit-startup t)) (org-mode))
- ;; Interactive template entries
- (goto-char (point-min))
- (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
- (unless (org-capture-escaped-%)
- (setq char (if (match-end 3) (match-string-no-properties 3))
- prompt (if (match-end 2) (match-string-no-properties 2)))
- (goto-char (match-beginning 0))
- (replace-match "")
- (setq completions nil default nil)
- (when prompt
- (setq completions (org-split-string prompt "|")
- prompt (pop completions)
- default (car completions)
- histvar (intern (concat
- "org-capture-template-prompt-history::"
- (or prompt "")))
- completions (mapcar 'list completions)))
- (unless (boundp histvar) (set histvar nil))
- (cond
- ((member char '("G" "g"))
- (let* ((org-last-tags-completion-table
- (org-global-tags-completion-table
- (if (equal char "G")
- (org-agenda-files)
- (and file (list file)))))
- (org-add-colon-after-tag-completion t)
- (ins (org-icompleting-read
- (if prompt (concat prompt ": ") "Tags: ")
- 'org-tags-completion-function nil nil nil
- 'org-tags-history)))
- (setq ins (mapconcat 'identity
- (org-split-string
- ins (org-re "[^[:alnum:]_@#%]+"))
- ":"))
- (when (string-match "\\S-" ins)
- (or (equal (char-before) ?:) (insert ":"))
- (insert ins)
- (or (equal (char-after) ?:) (insert ":"))
- (and (org-at-heading-p)
- (let ((org-ignore-region t))
- (org-set-tags nil 'align))))))
- ((equal char "C")
- (cond ((= (length clipboards) 1) (insert (car clipboards)))
- ((> (length clipboards) 1)
- (insert (read-string "Clipboard/kill value: "
- (car clipboards) '(clipboards . 1)
- (car clipboards))))))
- ((equal char "L")
- (cond ((= (length clipboards) 1)
- (org-insert-link 0 (car clipboards)))
- ((> (length clipboards) 1)
- (org-insert-link 0 (read-string "Clipboard/kill value: "
- (car clipboards)
- '(clipboards . 1)
- (car clipboards))))))
- ((equal char "p")
- (org-set-property (org-no-properties prompt) nil))
- (char
- ;; These are the date/time related ones
- (setq org-time-was-given (equal (upcase char) char))
- (setq time (org-read-date (equal (upcase char) char) t nil
- prompt))
- (if (equal (upcase char) char) (setq org-time-was-given t))
- (org-insert-time-stamp time org-time-was-given
- (member char '("u" "U"))
- nil nil (list org-end-time-was-given)))
- (t
- (let (org-completion-use-ido)
- (push (org-completing-read-no-i
- (concat (if prompt prompt "Enter string")
- (if default (concat " [" default "]"))
- ": ")
- completions nil nil nil histvar default)
- strings)
- (insert (car strings)))))))
- ;; Replace %n escapes with nth %^{...} string
- (setq strings (nreverse strings))
- (goto-char (point-min))
- (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
- (unless (org-capture-escaped-%)
- (replace-match
- (nth (1- (string-to-number (match-string 1))) strings)
- nil t)))
+ (org-clone-local-variables buffer "\\`org-")
+ (let (strings) ; Stores interactive answers.
+ (save-excursion
+ (let ((regexp "%\\^\\(?:{\\([^}]*\\)}\\)?\\([CgGLptTuU]\\)?"))
+ (while (re-search-forward regexp nil t)
+ (let* ((items (and (match-end 1)
+ (save-match-data
+ (split-string (match-string-no-properties 1)
+ "|"))))
+ (key (match-string 2))
+ (beg (copy-marker (match-beginning 0)))
+ (end (copy-marker (match-end 0)))
+ (prompt (nth 0 items))
+ (default (nth 1 items))
+ (completions (nthcdr 2 items)))
+ (unless (org-capture-escaped-%)
+ (delete-region beg end)
+ (set-marker beg nil)
+ (set-marker end nil)
+ (pcase key
+ ((or "G" "g")
+ (let* ((org-last-tags-completion-table
+ (org-global-tags-completion-table
+ (cond ((equal key "G") (org-agenda-files))
+ (file (list file))
+ (t nil))))
+ (org-add-colon-after-tag-completion t)
+ (ins (mapconcat
+ #'identity
+ (org-split-string
+ (completing-read
+ (if prompt (concat prompt ": ") "Tags: ")
+ 'org-tags-completion-function nil nil nil
+ 'org-tags-history)
+ "[^[:alnum:]_@#%]+")
+ ":")))
+ (when (org-string-nw-p ins)
+ (unless (eq (char-before) ?:) (insert ":"))
+ (insert ins)
+ (unless (eq (char-after) ?:) (insert ":"))
+ (and (org-at-heading-p)
+ (let ((org-ignore-region t))
+ (org-set-tags nil 'align))))))
+ ("C"
+ (cond
+ ((= (length clipboards) 1) (insert (car clipboards)))
+ ((> (length clipboards) 1)
+ (insert (read-string "Clipboard/kill value: "
+ (car clipboards)
+ '(clipboards . 1)
+ (car clipboards))))))
+ ("L"
+ (cond ((= (length clipboards) 1)
+ (org-insert-link 0 (car clipboards)))
+ ((> (length clipboards) 1)
+ (org-insert-link
+ 0
+ (read-string "Clipboard/kill value: "
+ (car clipboards)
+ '(clipboards . 1)
+ (car clipboards))))))
+ ("p" (org-set-property prompt nil))
+ ((guard key)
+ ;; These are the date/time related ones.
+ (let* ((upcase? (equal (upcase key) key))
+ (org-time-was-given upcase?)
+ (org-end-time-was-given)
+ (time (org-read-date upcase? t nil prompt)))
+ (org-insert-time-stamp
+ time org-time-was-given
+ (member key '("u" "U"))
+ nil nil (list org-end-time-was-given))))
+ (_
+ (push (org-completing-read
+ (concat (or prompt "Enter string")
+ (and default (format " [%s]" default))
+ ": ")
+ completions nil nil nil nil default)
+ strings)
+ (insert (car strings)))))))))
+
+ ;; Replace %n escapes with nth %^{...} string.
+ (setq strings (nreverse strings))
+ (save-excursion
+ (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
+ (unless (org-capture-escaped-%)
+ (replace-match
+ (nth (1- (string-to-number (match-string 1))) strings)
+ nil t)))))
+
;; Make sure there are no empty lines before the text, and that
- ;; it ends with a newline character
- (goto-char (point-min))
- (while (looking-at "[ \t]*\n") (replace-match ""))
- (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n"))
- ;; Return the expanded template and kill the temporary buffer
+ ;; it ends with a newline character.
+ (skip-chars-forward " \t\n")
+ (delete-region (point-min) (line-beginning-position))
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (delete-region (point) (point-max))
+ (insert "\n")
+
+ ;; Return the expanded template and kill the capture buffer.
(untabify (point-min) (point-max))
(set-buffer-modified-p nil)
- (prog1 (buffer-string) (kill-buffer (current-buffer))))))
+ (prog1 (buffer-substring-no-properties (point-min) (point-max))
+ (kill-buffer (current-buffer))))))
(defun org-capture-escaped-% ()
- "Check if % was escaped - if yes, unescape it now."
- (if (equal (char-before (match-beginning 0)) ?\\)
- (progn
- (delete-region (1- (match-beginning 0)) (match-beginning 0))
- t)
- nil))
-
-(defun org-capture-expand-embedded-elisp ()
- "Evaluate embedded elisp %(sexp) and replace with the result."
- (goto-char (point-min))
- (while (re-search-forward "%(" nil t)
- (unless (org-capture-escaped-%)
- (goto-char (match-beginning 0))
- (let ((template-start (point)))
- (forward-char 1)
- (let* ((sexp (read (current-buffer)))
- (result (org-eval
- (org-capture--expand-keyword-in-embedded-elisp sexp))))
- (delete-region template-start (point))
- (when result
- (if (stringp result)
- (insert result)
- (error "Capture template sexp `%s' must evaluate to string or nil"
- sexp))))))))
+ "Non-nil if % was escaped.
+If yes, unescape it now. Assume match-data contains the
+placeholder to check."
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (let ((n (abs (skip-chars-backward "\\\\"))))
+ (delete-char (/ (1+ n) 2))
+ (= (% n 2) 1))))
+
+(defun org-capture-expand-embedded-elisp (&optional mark)
+ "Evaluate embedded elisp %(sexp) and replace with the result.
+When optional MARK argument is non-nil, mark Sexp with a text
+property (`org-embedded-elisp') for later evaluation. Only
+marked Sexp are evaluated when this argument is nil."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "%(" nil t)
+ (cond
+ ((get-text-property (match-beginning 0) 'org-embedded-elisp)
+ (goto-char (match-beginning 0))
+ (let ((template-start (point)))
+ (forward-char 1)
+ (let* ((sexp (read (current-buffer)))
+ (result (org-eval
+ (org-capture--expand-keyword-in-embedded-elisp
+ sexp))))
+ (delete-region template-start (point))
+ (cond
+ ((not result) nil)
+ ((stringp result) (insert result))
+ (t (error
+ "Capture template sexp `%s' must evaluate to string or nil"
+ sexp))))))
+ ((not mark) nil)
+ ;; Only mark valid and non-escaped sexp.
+ ((org-capture-escaped-%) nil)
+ (t
+ (let ((end (with-syntax-table emacs-lisp-mode-syntax-table
+ (ignore-errors (scan-sexps (1- (point)) 1)))))
+ (when end
+ (put-text-property (- (point) 2) end 'org-embedded-elisp t))))))))
(defun org-capture--expand-keyword-in-embedded-elisp (attr)
"Recursively replace capture link keywords in ATTR sexp.
@@ -1786,20 +1852,10 @@ Such keywords are prefixed with \"%:\". See
(t attr)))
(defun org-capture-inside-embedded-elisp-p ()
- "Return non-nil if point is inside of embedded elisp %(sexp)."
- (let (beg end)
- (with-syntax-table emacs-lisp-mode-syntax-table
- (save-excursion
- ;; `looking-at' and `search-backward' below do not match the "%(" if
- ;; point is in its middle
- (when (equal (char-before) ?%)
- (backward-char))
- (save-match-data
- (when (or (looking-at "%(") (search-backward "%(" nil t))
- (setq beg (point))
- (setq end (progn (forward-char) (forward-sexp) (1- (point)))))))
- (when (and beg end)
- (and (<= (point) end) (>= (point) beg))))))
+ "Non-nil if point is inside of embedded elisp %(sexp).
+Assume sexps have been marked with
+`org-capture-expand-embedded-elisp' beforehand."
+ (get-text-property (point) 'org-embedded-elisp))
;;;###autoload
(defun org-capture-import-remember-templates ()
@@ -1843,6 +1899,9 @@ Such keywords are prefixed with \"%:\". See
(if jump-to-captured '(:jump-to-captured t)))))
org-remember-templates))))
+;;; The function was made obsolete by commit 65399674d5 of
+;;; 2013-02-22. This make-obsolete call was added 2016-09-01.
+(make-obsolete 'org-capture-import-remember-templates "use the `org-capture-templates' variable instead." "Org 9.0")
(provide 'org-capture)
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 143f749..b148a08 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -1,4 +1,4 @@
-;;; org-clock.el --- The time clocking code for Org-mode
+;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -24,26 +24,28 @@
;;
;;; Commentary:
-;; This file contains the time clocking code for Org-mode
+;; This file contains the time clocking code for Org mode
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org)
-(declare-function calendar-iso-to-absolute "cal-iso" (&optional date))
+(declare-function calendar-iso-to-absolute "cal-iso" (date))
(declare-function notifications-notify "notifications" (&rest params))
-(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-table-goto-line "org-table" (n))
+
+(defvar org-clock-stored-history nil
+ "Clock history, populated by `org-clock-load', which see.")
+(defvar org-frame-title-format-backup frame-title-format)
(defvar org-time-stamp-formats)
(defvar org-ts-what)
-(defvar org-frame-title-format-backup frame-title-format)
+
(defgroup org-clock nil
- "Options concerning clocking working time in Org-mode."
+ "Options concerning clocking working time in Org mode."
:tag "Org Clock"
:group 'org-progress)
@@ -65,7 +67,7 @@ Do not check directly this variable in a Lisp program. Call
function `org-clock-into-drawer' instead."
:group 'org-todo
:group 'org-clock
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "Always" t)
@@ -85,7 +87,7 @@ Return value is either a string, an integer, or nil."
(cond ((equal p "nil") nil)
((equal p "t") (or (org-log-into-drawer) "LOGBOOK"))
((org-string-nw-p p)
- (if (org-string-match-p "\\`[0-9]+\\'" p) (string-to-number p) p))
+ (if (string-match-p "\\`[0-9]+\\'" p) (string-to-number p) p))
((org-string-nw-p org-clock-into-drawer))
((integerp org-clock-into-drawer) org-clock-into-drawer)
((not org-clock-into-drawer) nil)
@@ -235,9 +237,6 @@ file name Play this sound file, fall back to beep"
(const :tag "Standard beep" t)
(file :tag "Play sound file")))
-(define-obsolete-variable-alias 'org-clock-modeline-total
- 'org-clock-mode-line-total "24.3")
-
(defcustom org-clock-mode-line-total 'auto
"Default setting for the time included for the mode line clock.
This can be overruled locally using the CLOCK_MODELINE_TOTAL property.
@@ -256,7 +255,7 @@ auto Automatically, either `all', or `repeat' for repeating tasks"
(const :tag "All task time" all)
(const :tag "Automatically, `all' or since `repeat'" auto)))
-(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
+(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
(defcustom org-clock-task-overrun-text nil
"Extra mode line text to indicate that the clock is overrun.
The can be nil to indicate that instead of adding text, the clock time
@@ -280,14 +279,14 @@ string as argument."
(function :tag "Function")))
(defgroup org-clocktable nil
- "Options concerning the clock table in Org-mode."
+ "Options concerning the clock table in Org mode."
:tag "Org Clock Table"
:group 'org-clock)
(defcustom org-clocktable-defaults
(list
:maxlevel 2
- :lang (or (org-bound-and-true-p org-export-default-language) "en")
+ :lang (or (bound-and-true-p org-export-default-language) "en")
:scope 'file
:block nil
:wstart 1
@@ -383,7 +382,7 @@ play with them."
:type 'string)
(defcustom org-clock-clocked-in-display 'mode-line
- "When clocked in for a task, org-mode can display the current
+ "When clocked in for a task, Org can display the current
task and accumulated time in the mode line and/or frame title.
Allowed values are:
@@ -466,7 +465,7 @@ to add an effort property.")
(let* ((dichotomy
(lambda (min max pred)
(if (funcall pred min) min
- (incf min)
+ (cl-incf min)
(while (> (- max min) 1)
(let ((mean (+ (ash min -1) (ash max -1) (logand min max 1))))
(if (funcall pred mean) (setq max mean) (setq min mean)))))
@@ -554,13 +553,15 @@ of a different task.")
(org-check-and-save-marker org-clock-hd-marker beg end)
(org-check-and-save-marker org-clock-default-task beg end)
(org-check-and-save-marker org-clock-interrupted-task beg end)
- (mapc (lambda (m) (org-check-and-save-marker m beg end))
- org-clock-history))
+ (dolist (m org-clock-history)
+ (org-check-and-save-marker m beg end)))
(defun org-clock-drawer-name ()
"Return clock drawer's name for current entry, or nil."
(let ((drawer (org-clock-into-drawer)))
- (cond ((integerp drawer) (org-log-into-drawer))
+ (cond ((integerp drawer)
+ (let ((log-drawer (org-log-into-drawer)))
+ (if (stringp log-drawer) log-drawer "LOGBOOK")))
((stringp drawer) drawer)
(t nil))))
@@ -580,8 +581,8 @@ of a different task.")
(interactive)
(let (och chl sel-list rpl (i 0) s)
;; Remove successive dups from the clock history to consider
- (mapc (lambda (c) (if (not (equal c (car och))) (push c och)))
- org-clock-history)
+ (dolist (c org-clock-history)
+ (unless (equal c (car och)) (push c och)))
(setq och (reverse och) chl (length och))
(if (zerop chl)
(user-error "No recent clock")
@@ -602,17 +603,15 @@ of a different task.")
(setq s (org-clock-insert-selection-line ?c org-clock-marker))
(push s sel-list))
(insert (org-add-props "Recent Tasks\n" nil 'face 'bold))
- (mapc
- (lambda (m)
- (when (marker-buffer m)
- (setq i (1+ i)
- s (org-clock-insert-selection-line
- (if (< i 10)
- (+ i ?0)
- (+ i (- ?A 10))) m))
- (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
- (push s sel-list)))
- och)
+ (dolist (m och)
+ (when (marker-buffer m)
+ (setq i (1+ i)
+ s (org-clock-insert-selection-line
+ (if (< i 10)
+ (+ i ?0)
+ (+ i (- ?A 10))) m))
+ (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
+ (push s sel-list)))
(run-hooks 'org-clock-before-select-task-hook)
(goto-char (point-min))
;; Set min-height relatively to circumvent a possible but in
@@ -632,25 +631,22 @@ of a different task.")
And return a cons cell with the selection character integer and the marker
pointing to it."
(when (marker-buffer marker)
- (let (file cat task heading prefix)
+ (let (cat task heading prefix)
(with-current-buffer (org-base-buffer (marker-buffer marker))
- (save-excursion
- (save-restriction
- (widen)
- (ignore-errors
- (goto-char marker)
- (setq file (buffer-file-name (marker-buffer marker))
- cat (org-get-category)
- heading (org-get-heading 'notags)
- prefix (save-excursion
- (org-back-to-heading t)
- (looking-at org-outline-regexp)
- (match-string 0))
- task (substring
- (org-fontify-like-in-org-mode
- (concat prefix heading)
- org-odd-levels-only)
- (length prefix)))))))
+ (org-with-wide-buffer
+ (ignore-errors
+ (goto-char marker)
+ (setq cat (org-get-category)
+ heading (org-get-heading 'notags)
+ prefix (save-excursion
+ (org-back-to-heading t)
+ (looking-at org-outline-regexp)
+ (match-string 0))
+ task (substring
+ (org-fontify-like-in-org-mode
+ (concat prefix heading)
+ org-odd-levels-only)
+ (length prefix))))))
(when (and cat task)
(insert (format "[%c] %-12s %s\n" i cat task))
(cons i marker)))))
@@ -670,19 +666,19 @@ If not, show simply the clocked time like 01:50."
(let* ((effort-in-minutes
(org-duration-string-to-minutes org-clock-effort))
(work-done-str
- (org-propertize
+ (propertize
(org-minutes-to-clocksum-string clocked-time)
'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text))
'org-mode-line-clock-overrun 'org-mode-line-clock)))
(effort-str (org-minutes-to-clocksum-string effort-in-minutes))
- (clockstr (org-propertize
+ (clockstr (propertize
(concat " [%s/" effort-str
"] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")")
'face 'org-mode-line-clock)))
(format clockstr work-done-str))
- (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time)
- (format " (%s)" org-clock-heading) "]")
- 'face 'org-mode-line-clock))))
+ (propertize (concat "[" (org-minutes-to-clocksum-string clocked-time)
+ "]" (format " (%s)" org-clock-heading))
+ 'face 'org-mode-line-clock))))
(defun org-clock-get-last-clock-out-time ()
"Get the last clock-out time for the current subtree."
@@ -697,20 +693,21 @@ If not, show simply the clocked time like 01:50."
(org-clock-notify-once-if-expired)
(setq org-clock-task-overrun nil))
(setq org-mode-line-string
- (org-propertize
+ (propertize
(let ((clock-string (org-clock-get-clock-string))
- (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task"))
+ (help-text "Org mode clock is running.\nmouse-1 shows a \
+menu\nmouse-2 will jump to task"))
(if (and (> org-clock-string-limit 0)
(> (length clock-string) org-clock-string-limit))
- (org-propertize
+ (propertize
(substring clock-string 0 org-clock-string-limit)
'help-echo (concat help-text ": " org-clock-heading))
- (org-propertize clock-string 'help-echo help-text)))
+ (propertize clock-string 'help-echo help-text)))
'local-map org-clock-mode-line-map
- 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)))
+ 'mouse-face 'mode-line-highlight))
(if (and org-clock-task-overrun org-clock-task-overrun-text)
(setq org-mode-line-string
- (concat (org-propertize
+ (concat (propertize
org-clock-task-overrun-text
'face 'org-mode-line-clock-overrun) org-mode-line-string)))
(force-mode-line-update))
@@ -720,8 +717,8 @@ If not, show simply the clocked time like 01:50."
The time returned includes the time spent on this task in
previous clocking intervals."
(let ((currently-clocked-time
- (floor (- (org-float-time)
- (org-float-time org-clock-start-time)) 60)))
+ (floor (- (float-time)
+ (float-time org-clock-start-time)) 60)))
(+ currently-clocked-time (or org-clock-total-time 0))))
(defun org-clock-modify-effort-estimate (&optional value)
@@ -801,7 +798,7 @@ use libnotify if available, or fall back on a message."
org-show-notification-handler notification))
((fboundp 'notifications-notify)
(notifications-notify
- :title "Org-mode message"
+ :title "Org mode message"
:body notification
;; FIXME how to link to the Org icon?
;; :app-icon "~/.emacs.d/icons/mail.png"
@@ -856,12 +853,10 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
(defmacro org-with-clock-position (clock &rest forms)
"Evaluate FORMS with CLOCK as the current active clock."
`(with-current-buffer (marker-buffer (car ,clock))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (car ,clock))
- (beginning-of-line)
- ,@forms))))
+ (org-with-wide-buffer
+ (goto-char (car ,clock))
+ (beginning-of-line)
+ ,@forms)))
(def-edebug-spec org-with-clock-position (form body))
(put 'org-with-clock-position 'lisp-indent-function 1)
@@ -970,7 +965,7 @@ If necessary, clock-out of the currently active clock."
(throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
- "Resolve an open org-mode clock.
+ "Resolve an open Org clock.
An open clock was found, with `dangling' possibly being non-nil.
If this function was invoked with a prefix argument, non-dangling
open clocks are ignored. The given clock requires some sort of
@@ -988,7 +983,7 @@ The format of clock is (CONS MARKER START-TIME), where MARKER
identifies the buffer and position the clock is open at (and
thus, the heading it's under), and START-TIME is when the clock
was started."
- (assert clock)
+ (cl-assert clock)
(let* ((ch
(save-window-excursion
(save-excursion
@@ -1021,10 +1016,6 @@ For all these options, using uppercase makes your final state
to be CLOCKED OUT."))))
(org-fit-window-to-buffer (get-buffer-window "*Org Clock*"))
(let (char-pressed)
- (when (featurep 'xemacs)
- (message (concat (funcall prompt-fn clock)
- " [jkKgGsScCiq]? "))
- (setq char-pressed (read-char-exclusive)))
(while (or (null char-pressed)
(and (not (memq char-pressed
'(?k ?K ?g ?G ?s ?S ?C
@@ -1036,7 +1027,7 @@ to be CLOCKED OUT."))))
nil 45)))
(and (not (memq char-pressed '(?i ?q))) char-pressed)))))
(default
- (floor (/ (org-float-time
+ (floor (/ (float-time
(time-subtract (current-time) last-valid)) 60)))
(keep
(and (memq ch '(?k ?K))
@@ -1045,8 +1036,8 @@ to be CLOCKED OUT."))))
(and (memq ch '(?g ?G))
(read-number "Got back how many minutes ago? " default)))
(subtractp (memq ch '(?s ?S)))
- (barely-started-p (< (- (org-float-time last-valid)
- (org-float-time (cdr clock))) 45))
+ (barely-started-p (< (- (float-time last-valid)
+ (float-time (cdr clock))) 45))
(start-over (and subtractp barely-started-p)))
(cond
((memq ch '(?j ?J))
@@ -1086,7 +1077,7 @@ to be CLOCKED OUT."))))
;;;###autoload
(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid)
- "Resolve all currently open org-mode clocks.
+ "Resolve all currently open Org clocks.
If `only-dangling-p' is non-nil, only ask to resolve dangling
\(i.e., not currently open and valid) clocks."
(interactive "P")
@@ -1105,8 +1096,8 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(lambda (clock)
(format
"Dangling clock started %d mins ago"
- (floor (- (org-float-time)
- (org-float-time (cdr clock)))
+ (floor (- (float-time)
+ (float-time (cdr clock)))
60)))))
(or last-valid
(cdr clock)))))))))))
@@ -1115,7 +1106,7 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
"Return the current Emacs idle time in seconds, or nil if not idle."
(let ((idle-time (current-idle-time)))
(if idle-time
- (org-float-time idle-time)
+ (float-time idle-time)
0)))
(defun org-mac-idle-seconds ()
@@ -1149,7 +1140,7 @@ This routine returns a floating point number."
(defvar org-clock-user-idle-seconds)
(defun org-resolve-clocks-if-idle ()
- "Resolve all currently open org-mode clocks.
+ "Resolve all currently open Org clocks.
This is performed after `org-clock-idle-time' minutes, to check
if the user really wants to stay clocked in after being idle for
so long."
@@ -1164,13 +1155,12 @@ so long."
(org-clock-resolve
(cons org-clock-marker
org-clock-start-time)
- (function
- (lambda (clock)
- (format "Clocked in & idle for %.1f mins"
- (/ (org-float-time
- (time-subtract (current-time)
- org-clock-user-idle-start))
- 60.0))))
+ (lambda (_)
+ (format "Clocked in & idle for %.1f mins"
+ (/ (float-time
+ (time-subtract (current-time)
+ org-clock-user-idle-start))
+ 60.0)))
org-clock-user-idle-start)))))
(defvar org-clock-current-task nil "Task currently clocked in.")
@@ -1180,15 +1170,22 @@ so long."
;;;###autoload
(defun org-clock-in (&optional select start-time)
"Start the clock on the current item.
+
If necessary, clock-out of the currently active clock.
-With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked
-tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task
-and mark it as the default task, a special task that will always be offered
-in the clocking selection, associated with the letter `d'.
-When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \
-clock in by using the last clock-out
-time as the start time \(see `org-clock-continuously' to
-make this the default behavior.)"
+
+With a `\\[universal-argument]' prefix argument SELECT, offer a list of \
+recently clocked
+tasks to clock into.
+
+When SELECT is `\\[universal-argument] \ \\[universal-argument]', \
+clock into the current task and mark it as
+the default task, a special task that will always be offered in the
+clocking selection, associated with the letter `d'.
+
+When SELECT is `\\[universal-argument] \\[universal-argument] \
+\\[universal-argument]', clock in by using the last clock-out
+time as the start time. See `org-clock-continuously' to make this
+the default behavior."
(interactive "P")
(setq org-clock-notification-was-shown nil)
(org-refresh-properties
@@ -1208,7 +1205,7 @@ make this the default behavior.)"
(not org-clock-resolving-clocks))
(setq org-clock-leftover-time nil)
(let ((org-clock-clocking-in t))
- (org-resolve-clocks))) ; check if any clocks are dangling
+ (org-resolve-clocks))) ; check if any clocks are dangling
(when (equal select '(64))
;; Set start-time to `org-clock-out-time'
@@ -1261,116 +1258,116 @@ make this the default behavior.)"
(set-buffer (org-base-buffer (marker-buffer selected-task)))
(setq target-pos (marker-position selected-task))
(move-marker selected-task nil))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char target-pos)
- (org-back-to-heading t)
- (or interrupting (move-marker org-clock-interrupted-task nil))
- (run-hooks 'org-clock-in-prepare-hook)
- (org-clock-history-push)
- (setq org-clock-current-task (nth 4 (org-heading-components)))
- (cond ((functionp org-clock-in-switch-to-state)
- (looking-at org-complex-heading-regexp)
- (let ((newstate (funcall org-clock-in-switch-to-state
- (match-string 2))))
- (if newstate (org-todo newstate))))
- ((and org-clock-in-switch-to-state
- (not (looking-at (concat org-outline-regexp "[ \t]*"
- org-clock-in-switch-to-state
- "\\>"))))
- (org-todo org-clock-in-switch-to-state)))
- (setq org-clock-heading
- (cond ((and org-clock-heading-function
- (functionp org-clock-heading-function))
- (funcall org-clock-heading-function))
- ((nth 4 (org-heading-components))
- (replace-regexp-in-string
- "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
- (match-string-no-properties 4)))
- (t "???")))
- (org-clock-find-position org-clock-in-resume)
- (cond
- ((and org-clock-in-resume
- (looking-at
- (concat "^[ \t]*" org-clock-string
- " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
- " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
- (message "Matched %s" (match-string 1))
- (setq ts (concat "[" (match-string 1) "]"))
- (goto-char (match-end 1))
- (setq org-clock-start-time
- (apply 'encode-time
- (org-parse-time-string (match-string 1))))
- (setq org-clock-effort (org-entry-get (point) org-effort-property))
- (setq org-clock-total-time (org-clock-sum-current-item
- (org-clock-get-sum-start))))
- ((eq org-clock-in-resume 'auto-restart)
- ;; called from org-clock-load during startup,
- ;; do not interrupt, but warn!
- (message "Cannot restart clock because task does not contain unfinished clock")
- (ding)
- (sit-for 2)
- (throw 'abort nil))
- (t
- (insert-before-markers "\n")
- (backward-char 1)
- (org-indent-line)
- (when (and (save-excursion
- (end-of-line 0)
- (org-in-item-p)))
- (beginning-of-line 1)
- (org-indent-line-to (- (org-get-indentation) 2)))
- (insert org-clock-string " ")
- (setq org-clock-effort (org-entry-get (point) org-effort-property))
- (setq org-clock-total-time (org-clock-sum-current-item
- (org-clock-get-sum-start)))
- (setq org-clock-start-time
- (or (and org-clock-continuously org-clock-out-time)
- (and leftover
- (y-or-n-p
- (format
- "You stopped another clock %d mins ago; start this one from then? "
- (/ (- (org-float-time
- (org-current-time org-clock-rounding-minutes t))
- (org-float-time leftover)) 60)))
- leftover)
- start-time
- (org-current-time org-clock-rounding-minutes t)))
- (setq ts (org-insert-time-stamp org-clock-start-time
- 'with-hm 'inactive))))
- (move-marker org-clock-marker (point) (buffer-base-buffer))
- (move-marker org-clock-hd-marker
- (save-excursion (org-back-to-heading t) (point))
- (buffer-base-buffer))
- (setq org-clock-has-been-used t)
- ;; add to mode line
- (when (or (eq org-clock-clocked-in-display 'mode-line)
- (eq org-clock-clocked-in-display 'both))
- (or global-mode-string (setq global-mode-string '("")))
- (or (memq 'org-mode-line-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(org-mode-line-string)))))
- ;; add to frame title
- (when (or (eq org-clock-clocked-in-display 'frame-title)
- (eq org-clock-clocked-in-display 'both))
- (setq frame-title-format org-clock-frame-title-format))
- (org-clock-update-mode-line)
- (when org-clock-mode-line-timer
- (cancel-timer org-clock-mode-line-timer)
- (setq org-clock-mode-line-timer nil))
- (when org-clock-clocked-in-display
- (setq org-clock-mode-line-timer
- (run-with-timer org-clock-update-period
- org-clock-update-period
- 'org-clock-update-mode-line)))
- (when org-clock-idle-timer
- (cancel-timer org-clock-idle-timer)
- (setq org-clock-idle-timer nil))
- (setq org-clock-idle-timer
- (run-with-timer 60 60 'org-resolve-clocks-if-idle))
- (message "Clock starts at %s - %s" ts org--msg-extra)
- (run-hooks 'org-clock-in-hook)))))))
+ (org-with-wide-buffer
+ (goto-char target-pos)
+ (org-back-to-heading t)
+ (or interrupting (move-marker org-clock-interrupted-task nil))
+ (run-hooks 'org-clock-in-prepare-hook)
+ (org-clock-history-push)
+ (setq org-clock-current-task (nth 4 (org-heading-components)))
+ (cond ((functionp org-clock-in-switch-to-state)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
+ (let ((newstate (funcall org-clock-in-switch-to-state
+ (match-string 2))))
+ (when newstate (org-todo newstate))))
+ ((and org-clock-in-switch-to-state
+ (not (looking-at (concat org-outline-regexp "[ \t]*"
+ org-clock-in-switch-to-state
+ "\\>"))))
+ (org-todo org-clock-in-switch-to-state)))
+ (setq org-clock-heading
+ (cond ((and org-clock-heading-function
+ (functionp org-clock-heading-function))
+ (funcall org-clock-heading-function))
+ ((nth 4 (org-heading-components))
+ (replace-regexp-in-string
+ "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
+ (match-string-no-properties 4)))
+ (t "???")))
+ (org-clock-find-position org-clock-in-resume)
+ (cond
+ ((and org-clock-in-resume
+ (looking-at
+ (concat "^[ \t]*" org-clock-string
+ " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
+ " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
+ (message "Matched %s" (match-string 1))
+ (setq ts (concat "[" (match-string 1) "]"))
+ (goto-char (match-end 1))
+ (setq org-clock-start-time
+ (apply 'encode-time
+ (org-parse-time-string (match-string 1))))
+ (setq org-clock-effort (org-entry-get (point) org-effort-property))
+ (setq org-clock-total-time (org-clock-sum-current-item
+ (org-clock-get-sum-start))))
+ ((eq org-clock-in-resume 'auto-restart)
+ ;; called from org-clock-load during startup,
+ ;; do not interrupt, but warn!
+ (message "Cannot restart clock because task does not contain unfinished clock")
+ (ding)
+ (sit-for 2)
+ (throw 'abort nil))
+ (t
+ (insert-before-markers "\n")
+ (backward-char 1)
+ (org-indent-line)
+ (when (and (save-excursion
+ (end-of-line 0)
+ (org-in-item-p)))
+ (beginning-of-line 1)
+ (indent-line-to (- (org-get-indentation) 2)))
+ (insert org-clock-string " ")
+ (setq org-clock-effort (org-entry-get (point) org-effort-property))
+ (setq org-clock-total-time (org-clock-sum-current-item
+ (org-clock-get-sum-start)))
+ (setq org-clock-start-time
+ (or (and org-clock-continuously org-clock-out-time)
+ (and leftover
+ (y-or-n-p
+ (format
+ "You stopped another clock %d mins ago; start this one from then? "
+ (/ (- (float-time
+ (org-current-time org-clock-rounding-minutes t))
+ (float-time leftover))
+ 60)))
+ leftover)
+ start-time
+ (org-current-time org-clock-rounding-minutes t)))
+ (setq ts (org-insert-time-stamp org-clock-start-time
+ 'with-hm 'inactive))))
+ (move-marker org-clock-marker (point) (buffer-base-buffer))
+ (move-marker org-clock-hd-marker
+ (save-excursion (org-back-to-heading t) (point))
+ (buffer-base-buffer))
+ (setq org-clock-has-been-used t)
+ ;; add to mode line
+ (when (or (eq org-clock-clocked-in-display 'mode-line)
+ (eq org-clock-clocked-in-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-mode-line-string)))))
+ ;; add to frame title
+ (when (or (eq org-clock-clocked-in-display 'frame-title)
+ (eq org-clock-clocked-in-display 'both))
+ (setq frame-title-format org-clock-frame-title-format))
+ (org-clock-update-mode-line)
+ (when org-clock-mode-line-timer
+ (cancel-timer org-clock-mode-line-timer)
+ (setq org-clock-mode-line-timer nil))
+ (when org-clock-clocked-in-display
+ (setq org-clock-mode-line-timer
+ (run-with-timer org-clock-update-period
+ org-clock-update-period
+ 'org-clock-update-mode-line)))
+ (when org-clock-idle-timer
+ (cancel-timer org-clock-idle-timer)
+ (setq org-clock-idle-timer nil))
+ (setq org-clock-idle-timer
+ (run-with-timer 60 60 'org-resolve-clocks-if-idle))
+ (message "Clock starts at %s - %s" ts org--msg-extra)
+ (run-hooks 'org-clock-in-hook))))))
;;;###autoload
(defun org-clock-in-last (&optional arg)
@@ -1488,7 +1485,8 @@ line and position cursor in that line."
(throw 'exit t)))))))
(goto-char beg)
(let ((clock-re (concat "^[ \t]*" org-clock-string))
- (count 0) positions first)
+ (count 0)
+ positions)
;; Count the CLOCK lines and store their positions.
(save-excursion
(while (re-search-forward clock-re end t)
@@ -1514,9 +1512,9 @@ line and position cursor in that line."
;; When a clock drawer needs to be created because of the
;; number of clock items or simply if it is missing, collect
;; all clocks in the section and wrap them within the drawer.
- ((or drawer
- (and (wholenump org-clock-into-drawer)
- (>= (1+ count) org-clock-into-drawer)))
+ ((if (wholenump org-clock-into-drawer)
+ (>= (1+ count) org-clock-into-drawer)
+ drawer)
;; Skip planning line and property drawer, if any.
(org-end-of-meta-data)
(let ((beg (point)))
@@ -1570,7 +1568,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
ts te s h m remove)
(setq org-clock-out-time now)
(save-excursion ; Do not replace this with `with-current-buffer'.
- (org-no-warnings (set-buffer (org-clocking-buffer)))
+ (with-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
(widen)
(goto-char org-clock-marker)
@@ -1583,8 +1581,10 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(delete-region (point) (point-at-eol))
(insert "--")
(setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
- (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te)))
- (org-float-time (apply 'encode-time (org-parse-time-string ts))))
+ (setq s (- (float-time
+ (apply #'encode-time (org-parse-time-string te)))
+ (float-time
+ (apply #'encode-time (org-parse-time-string ts))))
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
@@ -1599,8 +1599,9 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
(when org-log-note-clock-out
- (org-add-log-setup 'clock-out nil nil nil nil
- (concat "# Task: " (org-get-heading t) "\n\n")))
+ (org-add-log-setup
+ 'clock-out nil nil nil
+ (concat "# Task: " (org-get-heading t) "\n\n")))
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
@@ -1617,10 +1618,11 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(org-clock-out-when-done nil))
(cond
((functionp org-clock-out-switch-to-state)
- (looking-at org-complex-heading-regexp)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
(let ((newstate (funcall org-clock-out-switch-to-state
(match-string 2))))
- (if newstate (org-todo newstate))))
+ (when newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
(not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
@@ -1630,18 +1632,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(message (concat "Clock stopped at %s after "
(org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s")
te (if remove " => LINE REMOVED" ""))
- (let ((h org-clock-out-hook)
- (clock-drawer (org-clock-into-drawer)))
- ;; If a closing note needs to be stored in the drawer
- ;; where clocks are stored, let's temporarily disable
- ;; `org-clock-remove-empty-clock-drawer'.
- (if (and clock-drawer
- (not (stringp clock-drawer))
- (org-log-into-drawer)
- (eq org-log-done 'note)
- org-clock-out-when-done)
- (setq h (delq 'org-clock-remove-empty-clock-drawer h)))
- (mapc (lambda (f) (funcall f)) h))
+ (run-hooks 'org-clock-out-hook)
(unless (org-clocking-p)
(setq org-clock-current-task nil)))))))
@@ -1698,13 +1689,13 @@ Optional argument N tells to change by that many units."
(let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2)))
(setq tdiff
- (subtract-time
+ (time-subtract
(org-time-string-to-time org-last-changed-timestamp)
(org-time-string-to-time ts)))
(save-excursion
(goto-char begts)
(org-timestamp-change
- (round (/ (org-float-time tdiff)
+ (round (/ (float-time tdiff)
(cond ((eq org-ts-what 'minute) 60)
((eq org-ts-what 'hour) 3600)
((eq org-ts-what 'day) (* 24 3600))
@@ -1723,10 +1714,10 @@ Optional argument N tells to change by that many units."
(force-mode-line-update)
(error "No active clock"))
(save-excursion ; Do not replace this with `with-current-buffer'.
- (org-no-warnings (set-buffer (org-clocking-buffer)))
+ (with-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
- (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")
- (line-beginning-position))
+ (if (looking-back (concat "^[ \t]*" org-clock-string ".*")
+ (line-beginning-position))
(progn (delete-region (1- (point-at-bol)) (point-at-eol))
(org-remove-empty-drawer-at (point)))
(message "Clock gone, cancel the timer anyway")
@@ -1757,7 +1748,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(setq recent t)
(car org-clock-history))
(t (error "No active or recent clock task")))))
- (org-pop-to-buffer-same-window (marker-buffer m))
+ (pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
(org-show-entry)
@@ -1769,9 +1760,8 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(message "No running clock, this is the most recently clocked task"))
(run-hooks 'org-clock-goto-hook)))
-(defvar org-clock-file-total-minutes nil
+(defvar-local org-clock-file-total-minutes nil
"Holds the file total time in minutes, after a call to `org-clock-sum'.")
-(make-variable-buffer-local 'org-clock-file-total-minutes)
(defun org-clock-sum-today (&optional headline-filter)
"Sum the times for each subtree for today."
@@ -1813,8 +1803,8 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
time)
(if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart)))
(if (stringp tend) (setq tend (org-time-string-to-seconds tend)))
- (if (consp tstart) (setq tstart (org-float-time tstart)))
- (if (consp tend) (setq tend (org-float-time tend)))
+ (if (consp tstart) (setq tstart (float-time tstart)))
+ (if (consp tend) (setq tend (float-time tend)))
(remove-text-properties (point-min) (point-max)
`(,(or propname :org-clock-minutes) t
:org-clock-force-headline-inclusion t))
@@ -1826,10 +1816,10 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
;; Two time stamps
(setq ts (match-string 2)
te (match-string 3)
- ts (org-float-time
- (apply 'encode-time (org-parse-time-string ts)))
- te (org-float-time
- (apply 'encode-time (org-parse-time-string te)))
+ ts (float-time
+ (apply #'encode-time (org-parse-time-string ts)))
+ te (float-time
+ (apply #'encode-time (org-parse-time-string te)))
ts (if tstart (max ts tstart) ts)
te (if tend (min te tend) te)
dt (- te ts)
@@ -1845,10 +1835,11 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(equal (marker-position org-clock-hd-marker) (point))
tstart
tend
- (>= (org-float-time org-clock-start-time) tstart)
- (<= (org-float-time org-clock-start-time) tend))
- (let ((time (floor (- (org-float-time)
- (org-float-time org-clock-start-time)) 60)))
+ (>= (float-time org-clock-start-time) tstart)
+ (<= (float-time org-clock-start-time) tend))
+ (let ((time (floor (- (float-time)
+ (float-time org-clock-start-time))
+ 60)))
(setq t1 (+ t1 time))))
(let* ((headline-forced
(get-text-property (point)
@@ -1863,24 +1854,22 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(when (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
- (loop for l from 0 to level do
- (aset ltimes l (+ (aref ltimes l) t1))))
+ (cl-loop for l from 0 to level do
+ (aset ltimes l (+ (aref ltimes l) t1))))
(setq time (aref ltimes level))
(goto-char (match-beginning 0))
(put-text-property (point) (point-at-eol)
(or propname :org-clock-minutes) time)
- (if headline-filter
- (save-excursion
- (save-match-data
- (while
- (> (funcall outline-level) 1)
- (outline-up-heading 1 t)
- (put-text-property
- (point) (point-at-eol)
- :org-clock-force-headline-inclusion t))))))
+ (when headline-filter
+ (save-excursion
+ (save-match-data
+ (while (org-up-heading-safe)
+ (put-text-property
+ (point) (line-end-position)
+ :org-clock-force-headline-inclusion t))))))
(setq t1 0)
- (loop for l from level to (1- lmax) do
- (aset ltimes l 0)))))))
+ (cl-loop for l from level to (1- lmax) do
+ (aset ltimes l 0)))))))
(setq org-clock-file-total-minutes (aref ltimes 0))))))
(defun org-clock-sum-current-item (&optional tstart)
@@ -1896,15 +1885,18 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
"Show subtree times in the entire buffer.
By default, show the total time for the range defined in
-`org-clock-display-default-range'. With \\[universal-argument] \
+`org-clock-display-default-range'. With `\\[universal-argument]' \
prefix, show
-the total time for today instead. With \\[universal-argument] \
-\\[universal-argument] prefix, use
-a custom range, entered at the prompt. With \\[universal-argument] \
-\\[universal-argument] \\[universal-argument]
-prefix, display the total time in the echo area.
+the total time for today instead.
+
+With `\\[universal-argument] \\[universal-argument]' prefix, \
+use a custom range, entered at prompt.
-Use \\[org-clock-remove-overlays] to remove the subtree times."
+With `\\[universal-argument] \ \\[universal-argument] \
+\\[universal-argument]' prefix, display the total time in the
+echo area.
+
+Use `\\[org-clock-remove-overlays]' to remove the subtree times."
(interactive "P")
(org-clock-remove-overlays)
(let* ((todayp (equal arg '(4)))
@@ -1936,7 +1928,7 @@ Use \\[org-clock-remove-overlays] to remove the subtree times."
m (- org-clock-file-total-minutes (* 60 h)))
;; Arrange to remove the overlays upon next change.
(when org-remove-highlights-with-change
- (org-add-hook 'before-change-functions 'org-clock-remove-overlays
+ (add-hook 'before-change-functions 'org-clock-remove-overlays
nil 'local))))
(message (concat (format "Total file time%s: "
(cond (todayp " for today")
@@ -1947,8 +1939,7 @@ Use \\[org-clock-remove-overlays] to remove the subtree times."
" (%d hours and %d minutes)")
h m)))
-(defvar org-clock-overlays nil)
-(make-variable-buffer-local 'org-clock-overlays)
+(defvar-local org-clock-overlays nil)
(defun org-clock-put-overlay (time)
"Put an overlays on the current line, displaying TIME.
@@ -1956,10 +1947,11 @@ This creates a new overlay and stores it in `org-clock-overlays', so that it
will be easy to remove."
(let (ov tx)
(beginning-of-line)
- (when (looking-at org-complex-heading-regexp)
- (goto-char (match-beginning 4)))
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (goto-char (match-beginning 4))))
(setq ov (make-overlay (point) (point-at-eol))
- tx (concat (buffer-substring-no-properties (point) (match-end 4))
+ tx (concat (buffer-substring-no-properties (point) (match-end 4))
(org-add-props
(make-string
(max 0 (- (- 60 (current-column))
@@ -1970,20 +1962,17 @@ will be easy to remove."
(format " %9s " (org-minutes-to-clocksum-string time))
'(face org-clock-overlay))
""))
- (if (not (featurep 'xemacs))
- (overlay-put ov 'display tx)
- (overlay-put ov 'invisible t)
- (overlay-put ov 'end-glyph (make-glyph tx)))
+ (overlay-put ov 'display tx)
(push ov org-clock-overlays)))
;;;###autoload
-(defun org-clock-remove-overlays (&optional beg end noremove)
+(defun org-clock-remove-overlays (&optional _beg _end noremove)
"Remove the occur highlights from the buffer.
-BEG and END are ignored. If NOREMOVE is nil, remove this function
-from the `before-change-functions' in the current buffer."
+If NOREMOVE is nil, remove this function from the
+`before-change-functions' in the current buffer."
(interactive)
(unless org-inhibit-highlight-removal
- (mapc 'delete-overlay org-clock-overlays)
+ (mapc #'delete-overlay org-clock-overlays)
(setq org-clock-overlays nil)
(unless noremove
(remove-hook 'before-change-functions
@@ -2201,22 +2190,22 @@ have priority."
(when (and (memq key '(quarter thisq)) (> shift 0))
(error "Looking forward with quarters isn't implemented"))))
(when (= shift 0)
- (case key
- (yesterday (setq key 'today shift -1))
- (lastweek (setq key 'week shift -1))
- (lastmonth (setq key 'month shift -1))
- (lastyear (setq key 'year shift -1))
- (lastq (setq key 'quarter shift -1))))
+ (pcase key
+ (`yesterday (setq key 'today shift -1))
+ (`lastweek (setq key 'week shift -1))
+ (`lastmonth (setq key 'month shift -1))
+ (`lastyear (setq key 'year shift -1))
+ (`lastq (setq key 'quarter shift -1))))
;; Prepare start and end times depending on KEY's type.
- (case key
- ((day today) (setq m 0 h 0 h1 24 d (+ d shift)))
- ((week thisweek)
+ (pcase key
+ ((or `day `today) (setq m 0 h 0 h1 24 d (+ d shift)))
+ ((or `week `thisweek)
(let* ((ws (or wstart 1))
(diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))))
(setq m 0 h 0 d (- d diff) d1 (+ 7 d))))
- ((month thismonth)
+ ((or `month `thismonth)
(setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month)))
- ((quarter thisq)
+ ((or `quarter `thisq)
;; Compute if this shift remains in this year. If not, compute
;; how many years and quarters we have to shift (via floor*) and
;; compute the shifted years, months and quarters.
@@ -2224,7 +2213,7 @@ have priority."
((< (+ (- q 1) shift) 0) ; Shift not in this year.
(let* ((interval (* -1 (+ (- q 1) shift)))
;; Set tmp to ((years to shift) (quarters to shift)).
- (tmp (org-floor* interval 4)))
+ (tmp (cl-floor interval 4)))
;; Due to the use of floor, 0 quarters actually means 4.
(if (= 0 (nth 1 tmp))
(setq shiftedy (- y (nth 0 tmp))
@@ -2239,35 +2228,35 @@ have priority."
(setq shiftedy y)
(let ((qshift (* 3 (1- (+ q shift)))))
(setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift))))))
- ((year thisyear)
+ ((or `year `thisyear)
(setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
- ((interactive untilnow)) ; Special cases, ignore them.
- (t (user-error "No such time block %s" key)))
+ ((or `interactive `untilnow)) ; Special cases, ignore them.
+ (_ (user-error "No such time block %s" key)))
;; Format start and end times according to AS-STRINGS.
- (let* ((start (case key
- (interactive (org-read-date nil t nil "Range start? "))
- (untilnow org-clock--oldest-date)
- (t (encode-time 0 m h d month y))))
- (end (case key
- (interactive (org-read-date nil t nil "Range end? "))
- (untilnow (current-time))
- (t (encode-time 0
+ (let* ((start (pcase key
+ (`interactive (org-read-date nil t nil "Range start? "))
+ (`untilnow org-clock--oldest-date)
+ (_ (encode-time 0 m h d month y))))
+ (end (pcase key
+ (`interactive (org-read-date nil t nil "Range end? "))
+ (`untilnow (current-time))
+ (_ (encode-time 0
(or m1 m)
(or h1 h)
(or d1 d)
(or month1 month)
(or y1 y)))))
(text
- (case key
- ((day today) (format-time-string "%A, %B %d, %Y" start))
- ((week thisweek) (format-time-string "week %G-W%V" start))
- ((month thismonth) (format-time-string "%B %Y" start))
- ((year thisyear) (format-time-string "the year %Y" start))
- ((quarter thisq)
+ (pcase key
+ ((or `day `today) (format-time-string "%A, %B %d, %Y" start))
+ ((or `week `thisweek) (format-time-string "week %G-W%V" start))
+ ((or `month `thismonth) (format-time-string "%B %Y" start))
+ ((or `year `thisyear) (format-time-string "the year %Y" start))
+ ((or `quarter `thisq)
(concat (org-count-quarter shiftedq)
" quarter of " (number-to-string shiftedy)))
- (interactive "(Range interactively set)")
- (untilnow "now"))))
+ (`interactive "(Range interactively set)")
+ (`untilnow "now"))))
(if (not as-strings) (list start end text)
(let ((f (cdr org-time-stamp-formats)))
(list (format-time-string f start)
@@ -2370,25 +2359,31 @@ the currently selected interval size."
(setq params (org-combine-plists org-clocktable-defaults params))
(catch 'exit
(let* ((scope (plist-get params :scope))
+ (files (pcase scope
+ (`agenda
+ (org-agenda-files t))
+ (`agenda-with-archives
+ (org-add-archive-files (org-agenda-files t)))
+ (`file-with-archives
+ (and buffer-file-name
+ (org-add-archive-files (list buffer-file-name))))
+ (_ (or (buffer-file-name) (current-buffer)))))
(block (plist-get params :block))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
- (link (plist-get params :link))
- (maxlevel (or (plist-get params :maxlevel) 3))
(ws (plist-get params :wstart))
(ms (plist-get params :mstart))
(step (plist-get params :step))
- (timestamp (plist-get params :timestamp))
(formatter (or (plist-get params :formatter)
org-clock-clocktable-formatter
'org-clocktable-write-default))
- cc range-text ipos pos one-file-with-archives
- scope-is-list tbls level)
+ cc)
;; Check if we need to do steps
(when block
;; Get the range text for the header
(setq cc (org-clock-special-range block nil t ws ms)
- ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ ts (car cc)
+ te (nth 1 cc)))
(when step
;; Write many tables, in steps
(unless (or block (and ts te))
@@ -2396,65 +2391,49 @@ the currently selected interval size."
(org-clocktable-steps params)
(throw 'exit nil))
- (setq ipos (point)) ; remember the insertion position
-
- ;; Get the right scope
- (setq pos (point))
- (cond
- ((and scope (listp scope) (symbolp (car scope)))
- (setq scope (eval scope)))
- ((eq scope 'agenda)
- (setq scope (org-agenda-files t)))
- ((eq scope 'agenda-with-archives)
- (setq scope (org-agenda-files t))
- (setq scope (org-add-archive-files scope)))
- ((eq scope 'file-with-archives)
- (setq scope (and buffer-file-name
- (org-add-archive-files (list buffer-file-name)))
- one-file-with-archives t)))
- (setq scope-is-list (and scope (listp scope)))
- (if scope-is-list
- ;; we collect from several files
- (let* ((files scope)
- file)
- (org-agenda-prepare-buffers files)
- (while (setq file (pop files))
- (with-current-buffer (find-buffer-visiting file)
- (save-excursion
- (save-restriction
- (push (org-clock-get-table-data file params) tbls))))))
- ;; Just from the current file
- (save-restriction
- ;; get the right range into the restriction
- (org-agenda-prepare-buffers (list (or (buffer-file-name)
- (current-buffer))))
- (cond
- ((not scope)) ; use the restriction as it is now
- ((eq scope 'file) (widen))
- ((eq scope 'subtree) (org-narrow-to-subtree))
- ((eq scope 'tree)
- (while (org-up-heading-safe))
- (org-narrow-to-subtree))
- ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$"
- (symbol-name scope)))
- (setq level (string-to-number (match-string 1 (symbol-name scope))))
- (catch 'exit
- (while (org-up-heading-safe)
- (looking-at org-outline-regexp)
- (if (<= (org-reduced-level (funcall outline-level)) level)
- (throw 'exit nil))))
- (org-narrow-to-subtree)))
- ;; do the table, with no file name.
- (push (org-clock-get-table-data nil params) tbls)))
-
- ;; OK, at this point we tbls as a list of tables, one per file
- (setq tbls (nreverse tbls))
-
- (setq params (plist-put params :multifile scope-is-list))
- (setq params (plist-put params :one-file-with-archives
- one-file-with-archives))
-
- (funcall formatter ipos tbls params))))
+ (org-agenda-prepare-buffers (if (consp files) files (list files)))
+
+ (let ((origin (point))
+ (tables
+ (if (consp files)
+ (mapcar (lambda (file)
+ (with-current-buffer (find-buffer-visiting file)
+ (save-excursion
+ (save-restriction
+ (org-clock-get-table-data file params)))))
+ files)
+ ;; Get the right restriction for the scope.
+ (cond
+ ((not scope)) ;use the restriction as it is now
+ ((eq scope 'file) (widen))
+ ((eq scope 'subtree) (org-narrow-to-subtree))
+ ((eq scope 'tree)
+ (while (org-up-heading-safe))
+ (org-narrow-to-subtree))
+ ((and (symbolp scope)
+ (string-match "\\`tree\\([0-9]+\\)\\'"
+ (symbol-name scope)))
+ (let ((level (string-to-number
+ (match-string 1 (symbol-name scope)))))
+ (catch 'exit
+ (while (org-up-heading-safe)
+ (looking-at org-outline-regexp)
+ (when (<= (org-reduced-level (funcall outline-level))
+ level)
+ (throw 'exit nil))))
+ (org-narrow-to-subtree))))
+ (list (org-clock-get-table-data nil params))))
+ (multifile
+ ;; Even though `file-with-archives' can consist of
+ ;; multiple files, we consider this is one extended file
+ ;; instead.
+ (cond ((eq scope 'file-with-archives) nil)
+ ((consp files)))))
+
+ (funcall formatter
+ origin
+ tables
+ (org-combine-plists params `(:multifile ,multifile)))))))
(defun org-clocktable-write-default (ipos tables params)
"Write out a clock table at position IPOS in the current buffer.
@@ -2469,14 +2448,12 @@ from the dynamic block definition."
;; well-defined number of columns...
(let* ((hlchars '((1 . "*") (2 . "/")))
(lwords (assoc (or (plist-get params :lang)
- (org-bound-and-true-p org-export-default-language)
+ (bound-and-true-p org-export-default-language)
"en")
org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
(sort (plist-get params :sort))
- (ts (plist-get params :tstart))
- (te (plist-get params :tend))
(header (plist-get params :header))
(narrow (plist-get params :narrow))
(ws (or (plist-get params :wstart) 1))
@@ -2490,7 +2467,6 @@ from the dynamic block definition."
(timestamp (plist-get params :timestamp))
(properties (plist-get params :properties))
(ntcol (max 1 (or (plist-get params :tcolumns) 100)))
- (rm-file-column (plist-get params :one-file-with-archives))
(indent (plist-get params :indent))
(case-fold-search t)
range-text total-time tbl level hlc formula pcol
@@ -2695,10 +2671,6 @@ from the dynamic block definition."
(org-table-goto-column pcol nil 'force)
(insert "%")))
(org-table-recalculate 'all))
- (when rm-file-column
- ;; The file column is actually not wanted
- (forward-char 1)
- (org-table-delete-column))
total-time))
(defun org-clocktable-indent-string (level)
@@ -2718,26 +2690,26 @@ LEVEL is an integer. Indent by two spaces per level above 1."
(step (cdr (assoc step0 '((day . 86400) (week . 604800)))))
(stepskip0 (plist-get p1 :stepskip0))
(block (plist-get p1 :block))
- cc range-text step-time tsb)
+ cc step-time tsb)
(when block
(setq cc (org-clock-special-range block nil t ws ms)
- ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ ts (car cc)
+ te (nth 1 cc)))
(cond
((numberp ts)
- ;; If ts is a number, it's an absolute day number from org-agenda.
- (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts)
- (setq ts (org-float-time (encode-time 0 0 0 day month year)))))
+ ;; If ts is a number, it's an absolute day number from
+ ;; org-agenda.
+ (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts)))
+ (setq ts (float-time (encode-time 0 0 0 day month year)))))
(ts
- (setq ts (org-float-time
- (apply 'encode-time (org-parse-time-string ts))))))
+ (setq ts (float-time (apply #'encode-time (org-parse-time-string ts))))))
(cond
((numberp te)
;; Likewise for te.
- (destructuring-bind (month day year) (calendar-gregorian-from-absolute te)
- (setq te (org-float-time (encode-time 0 0 0 day month year)))))
+ (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te)))
+ (setq te (float-time (encode-time 0 0 0 day month year)))))
(te
- (setq te (org-float-time
- (apply 'encode-time (org-parse-time-string te))))))
+ (setq te (float-time (apply #'encode-time (org-parse-time-string te))))))
(setq tsb
(if (eq step0 'week)
(- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws)))
@@ -2780,7 +2752,7 @@ following structure:
(LEVEL HEADLINE TIMESTAMP TIME)
LEVEL: The level of the headline, as an integer. This will be
- the reduced leve, so 1,2,3,... even if only odd levels
+ the reduced level, so 1,2,3,... even if only odd levels
are being used.
HEADLINE: The text of the headline. Depending on PARAMS, this may
already be formatted like a link.
@@ -2801,14 +2773,14 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(tags (plist-get params :tags))
(properties (plist-get params :properties))
(inherit-property-p (plist-get params :inherit-props))
- todo-only
- (matcher (if tags (cdr (org-make-tags-matcher tags))))
- cc range-text st p time level hdl props tsp tbl)
+ (matcher (and tags (cdr (org-make-tags-matcher tags))))
+ cc st p time level hdl props tsp tbl)
(setq org-clock-file-total-minutes nil)
(when block
(setq cc (org-clock-special-range block nil t ws ms)
- ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ ts (car cc)
+ te (nth 1 cc)))
(when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
(when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
(when (and ts (listp ts))
@@ -2820,12 +2792,12 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(if te (setq te (org-matcher-time te)))
(save-excursion
(org-clock-sum ts te
- (unless (null matcher)
- (lambda ()
- (let* ((tags-list (org-get-tags-at))
- (org-scanner-tags tags-list)
- (org-trust-scanner-tags t))
- (eval matcher)))))
+ (when matcher
+ `(lambda ()
+ (let* ((tags-list (org-get-tags-at))
+ (org-scanner-tags tags-list)
+ (org-trust-scanner-tags t))
+ (funcall ,matcher nil tags-list nil)))))
(goto-char (point-min))
(setq st t)
(while (or (and (bobp) (prog1 st (setq st nil))
@@ -2837,7 +2809,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(when (setq time (get-text-property p :org-clock-minutes))
(save-excursion
(beginning-of-line 1)
- (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
+ (when (and (looking-at "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")
(setq level (org-reduced-level
(- (match-end 1) (match-beginning 1))))
(<= level maxlevel))
@@ -2852,7 +2824,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(replace-regexp-in-string
org-bracket-link-regexp
(lambda (m) (or (match-string 3 m)
- (match-string 1 m)))
+ (match-string 1 m)))
(match-string 2)))))
tsp (when timestamp
(setq props (org-entry-properties (point)))
@@ -2930,10 +2902,10 @@ Otherwise, return nil."
(end-of-line 1)
(setq ts (match-string 1)
te (match-string 3))
- (setq s (- (org-float-time
- (apply 'encode-time (org-parse-time-string te)))
- (org-float-time
- (apply 'encode-time (org-parse-time-string ts))))
+ (setq s (- (float-time
+ (apply #'encode-time (org-parse-time-string te)))
+ (float-time
+ (apply #'encode-time (org-parse-time-string ts))))
neg (< s 0)
s (abs s)
h (floor (/ s 3600))
@@ -2976,7 +2948,7 @@ The details of what will be saved are regulated by the variable
(when (and (memq org-clock-persist '(t history))
org-clock-history)
(insert
- "(setq stored-clock-history '("
+ "(setq org-clock-stored-history '("
(mapconcat
(lambda (m)
(when (and (setq b (marker-buffer m))
@@ -2995,22 +2967,20 @@ The details of what will be saved are regulated by the variable
(when (and org-clock-persist (not org-clock-loaded))
(let ((filename (expand-file-name org-clock-persist-file))
(org-clock-in-resume 'auto-restart)
- resume-clock stored-clock-history)
+ resume-clock)
(if (not (file-readable-p filename))
(message "Not restoring clock data; %s not found"
org-clock-persist-file)
(message "%s" "Restoring clock data")
(setq org-clock-loaded t)
+ ;; Load history.
(load-file filename)
- ;; load history
- (when stored-clock-history
- (save-window-excursion
- (mapc (lambda (task)
- (if (file-exists-p (car task))
- (org-clock-history-push (cdr task)
- (find-file (car task)))))
- stored-clock-history)))
- ;; resume clock
+ (save-window-excursion
+ (dolist (task org-clock-stored-history)
+ (when (file-exists-p (car task))
+ (org-clock-history-push (cdr task)
+ (find-file (car task))))))
+ ;; Resume clock.
(when (and resume-clock org-clock-persist
(file-exists-p (car resume-clock))
(or (not org-clock-persist-query-resume)
@@ -3021,8 +2991,9 @@ The details of what will be saved are regulated by the variable
(save-excursion
(goto-char (cdr resume-clock))
(org-back-to-heading t)
- (and (looking-at org-complex-heading-regexp)
- (match-string 4))))
+ (let ((case-fold-search nil))
+ (and (looking-at org-complex-heading-regexp)
+ (match-string 4)))))
") "))))
(when (file-exists-p (car resume-clock))
(with-current-buffer (find-file (car resume-clock))
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index eade725..d33f505 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -1,4 +1,4 @@
-;;; org-colview.el --- Column View in Org-mode
+;;; org-colview.el --- Column View in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -28,42 +28,117 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'org)
-(declare-function org-agenda-redo "org-agenda" ())
+(declare-function org-agenda-redo "org-agenda" (&optional all))
(declare-function org-agenda-do-context-action "org-agenda" ())
(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
-
-(when (featurep 'xemacs)
- (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory"))
-
+(declare-function org-element-extract-element "org-element" (element))
+(declare-function org-element-interpret-data "org-element" (data))
+(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
+(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-restriction "org-element" (element))
+(declare-function org-element-type "org-element" (element))
+
+(defvar org-agenda-columns-add-appointments-to-effort-sum)
+(defvar org-agenda-columns-compute-summary-properties)
+(defvar org-agenda-columns-show-summaries)
+(defvar org-agenda-view-columns-initially)
+(defvar org-inlinetask-min-level)
+
+
+;;; Configuration
+
+(defcustom org-columns-modify-value-for-display-function nil
+ "Function that modifies values for display in column view.
+For example, it can be used to cut out a certain part from a time stamp.
+The function must take 2 arguments:
+
+column-title The title of the column (*not* the property name)
+value The value that should be modified.
+
+The function should return the value that should be displayed,
+or nil if the normal value should be used."
+ :group 'org-properties
+ :type '(choice (const nil) (function)))
+
+(defcustom org-columns-summary-types nil
+ "Alist between operators and summarize functions.
+
+Each association follows the pattern (LABEL . SUMMARIZE) where
+
+ LABEL is a string used in #+COLUMNS definition describing the
+ summary type. It can contain any character but \"}\". It is
+ case-sensitive.
+
+ SUMMARIZE is a function called with two arguments. The first
+ argument is a non-empty list of values, as non-empty strings.
+ The second one is a format string or nil. It has to return
+ a string summarizing the list of values.
+
+Note that the return value can become one value for an higher
+order summary, so the function is expected to handle its own
+output.
+
+Types defined in this variable take precedence over those defined
+in `org-columns-summary-types-default', which see."
+ :group 'org-properties
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :type '(alist :key-type (string :tag " Label")
+ :value-type (function :tag "Summarize")))
+
+
+
;;; Column View
(defvar org-columns-overlays nil
"Holds the list of current column overlays.")
-(defvar org-columns-current-fmt nil
+(defvar org-columns--time 0.0
+ "Number of seconds since the epoch, as a floating point number.")
+
+(defvar-local org-columns-current-fmt nil
"Local variable, holds the currently active column format.")
-(make-variable-buffer-local 'org-columns-current-fmt)
-(defvar org-columns-current-fmt-compiled nil
+
+(defvar-local org-columns-current-fmt-compiled nil
"Local variable, holds the currently active column format.
This is the compiled version of the format.")
-(make-variable-buffer-local 'org-columns-current-fmt-compiled)
-(defvar org-columns-current-widths nil
- "Loval variable, holds the currently widths of fields.")
-(make-variable-buffer-local 'org-columns-current-widths)
-(defvar org-columns-current-maxwidths nil
- "Loval variable, holds the currently active maximum column widths.")
-(make-variable-buffer-local 'org-columns-current-maxwidths)
+
+(defvar-local org-columns-current-maxwidths nil
+ "Currently active maximum column widths, as a vector.")
+
(defvar org-columns-begin-marker (make-marker)
"Points to the position where last a column creation command was called.")
+
(defvar org-columns-top-level-marker (make-marker)
"Points to the position where current columns region starts.")
(defvar org-columns-map (make-sparse-keymap)
"The keymap valid in column display.")
+(defconst org-columns-summary-types-default
+ '(("+" . org-columns--summary-sum)
+ ("$" . org-columns--summary-currencies)
+ ("X" . org-columns--summary-checkbox)
+ ("X/" . org-columns--summary-checkbox-count)
+ ("X%" . org-columns--summary-checkbox-percent)
+ ("max" . org-columns--summary-max)
+ ("mean" . org-columns--summary-mean)
+ ("min" . org-columns--summary-min)
+ (":" . org-columns--summary-sum-times)
+ (":max" . org-columns--summary-max-time)
+ (":mean" . org-columns--summary-mean-time)
+ (":min" . org-columns--summary-min-time)
+ ("@max" . org-columns--summary-max-age)
+ ("@mean" . org-columns--summary-mean-age)
+ ("@min" . org-columns--summary-min-age)
+ ("est+" . org-columns--summary-estimate))
+ "Map operators to summarize functions.
+See `org-columns-summary-types' for details.")
+
(defun org-columns-content ()
"Switch to contents view while in columns view."
(interactive)
@@ -146,12 +221,77 @@ This is the compiled version of the format.")
"--"
["Quit" org-columns-quit t]))
-(defun org-columns--value (property pos)
- "Return value for PROPERTY at buffer position POS."
- (or (cdr (assoc-string property (get-text-property pos 'org-summaries) t))
- (org-entry-get pos property 'selective t)))
+(defun org-columns--displayed-value (spec value)
+ "Return displayed value for specification SPEC in current entry.
-(defun org-columns-new-overlay (beg end &optional string face)
+SPEC is a column format specification as stored in
+`org-columns-current-fmt-compiled'. VALUE is the real value to
+display, as a string."
+ (cond
+ ((and (functionp org-columns-modify-value-for-display-function)
+ (funcall org-columns-modify-value-for-display-function
+ (nth 1 spec)
+ value)))
+ ((equal (car spec) "ITEM")
+ (concat (make-string (1- (org-current-level))
+ (if org-hide-leading-stars ?\s ?*))
+ "* "
+ (org-columns-compact-links value)))
+ (value)))
+
+(defun org-columns--collect-values (&optional agenda)
+ "Collect values for columns on the current line.
+
+When optional argument AGENDA is non-nil, assume the value is
+meant for the agenda, i.e., caller is `org-agenda-columns'.
+
+Return a list of triplets (SPEC VALUE DISPLAYED) suitable for
+`org-columns--display-here'.
+
+This function assumes `org-columns-current-fmt-compiled' is
+initialized."
+ (let ((summaries (get-text-property (point) 'org-summaries)))
+ (mapcar
+ (lambda (spec)
+ (pcase spec
+ (`(,p . ,_)
+ (let* ((v (or (cdr (assoc spec summaries))
+ (org-entry-get (point) p 'selective t)
+ (and agenda
+ ;; Effort property is not defined. Try
+ ;; to use appointment duration.
+ org-agenda-columns-add-appointments-to-effort-sum
+ (string= p (upcase org-effort-property))
+ (get-text-property (point) 'duration)
+ (propertize
+ (org-minutes-to-clocksum-string
+ (get-text-property (point) 'duration))
+ 'face 'org-warning))
+ "")))
+ (list spec v (org-columns--displayed-value spec v))))))
+ org-columns-current-fmt-compiled)))
+
+(defun org-columns--set-widths (cache)
+ "Compute the maximum column widths from the format and CACHE.
+This function sets `org-columns-current-maxwidths' as a vector of
+integers greater than 0."
+ (setq org-columns-current-maxwidths
+ (apply #'vector
+ (mapcar
+ (lambda (spec)
+ (pcase spec
+ (`(,_ ,_ ,(and width (pred wholenump)) . ,_) width)
+ (`(,_ ,name . ,_)
+ ;; No width is specified in the columns format.
+ ;; Compute it by checking all possible values for
+ ;; PROPERTY.
+ (let ((width (length name)))
+ (dolist (entry cache width)
+ (let ((value (nth 2 (assoc spec (cdr entry)))))
+ (setq width (max (length value) width))))))))
+ org-columns-current-fmt-compiled))))
+
+(defun org-columns--new-overlay (beg end &optional string face)
"Create a new column overlay and add it to the list."
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face (or face 'secondary-selection))
@@ -159,9 +299,35 @@ This is the compiled version of the format.")
(push ov org-columns-overlays)
ov))
-(defun org-columns-display-here (&optional props dateline)
- "Overlay the current line with column display."
- (interactive)
+(defun org-columns--summarize (operator)
+ "Return summary function associated to string OPERATOR."
+ (if (not operator) nil
+ (cdr (or (assoc operator org-columns-summary-types)
+ (assoc operator org-columns-summary-types-default)
+ (error "Unknown %S operator" operator)))))
+
+(defun org-columns--overlay-text (value fmt width property original)
+ "Return text "
+ (format fmt
+ (let ((v (org-columns-add-ellipses value width)))
+ (pcase property
+ ("PRIORITY"
+ (propertize v 'face (org-get-priority-face original)))
+ ("TAGS"
+ (if (not org-tags-special-faces-re)
+ (propertize v 'face 'org-tag)
+ (replace-regexp-in-string
+ org-tags-special-faces-re
+ (lambda (m) (propertize m 'face (org-get-tag-face m)))
+ v nil nil 1)))
+ ("TODO" (propertize v 'face (org-get-todo-face original)))
+ (_ v)))))
+
+(defun org-columns--display-here (columns &optional dateline)
+ "Overlay the current line with column display.
+COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument
+DATELINE is non-nil when the face used should be
+`org-agenda-column-dateline'."
(save-excursion
(beginning-of-line)
(let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)")
@@ -174,14 +340,7 @@ This is the compiled version of the format.")
(font (list :height (face-attribute 'default :height)
:family (face-attribute 'default :family)))
(face (list color font 'org-column ref-face))
- (face1 (list color font 'org-agenda-column-dateline ref-face))
- (pom (and (eq major-mode 'org-agenda-mode)
- (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker))))
- (props (cond (props)
- ((eq major-mode 'org-agenda-mode)
- (and pom (org-entry-properties pom)))
- (t (org-entry-properties)))))
+ (face1 (list color font 'org-agenda-column-dateline ref-face)))
;; Each column is an overlay on top of a character. So there has
;; to be at least as many characters available on the line as
;; columns to display.
@@ -192,66 +351,34 @@ This is the compiled version of the format.")
(end-of-line)
(let ((inhibit-read-only t))
(insert (make-string (- columns chars) ?\s))))))
- ;; Walk the format. Create and install the overlay for the
+ ;; Display columns. Create and install the overlay for the
;; current column on the next character.
- (dolist (column org-columns-current-fmt-compiled)
- (let* ((property (car column))
- (title (nth 1 column))
- (ass (assoc-string property props t))
- (width
- (or
- (cdr (assoc-string property org-columns-current-maxwidths t))
- (nth 2 column)
- (length property)))
- (f (format "%%-%d.%ds | " width width))
- (fm (nth 4 column))
- (fc (nth 5 column))
- (calc (nth 7 column))
- (val (or (cdr ass) ""))
- (modval
- (cond
- ((functionp org-columns-modify-value-for-display-function)
- (funcall org-columns-modify-value-for-display-function
- title val))
- ((equal property "ITEM") (org-columns-compact-links val))
- (fc (org-columns-number-to-string
- (org-columns-string-to-number val fm) fm fc))
- ((and calc (functionp calc)
- (not (string= val ""))
- (not (get-text-property 0 'org-computed val)))
- (org-columns-number-to-string
- (funcall calc (org-columns-string-to-number val fm)) fm))))
- (string
- (format f
- (let ((v (org-columns-add-ellipses
- (or modval val) width)))
- (cond
- ((equal property "PRIORITY")
- (propertize v 'face (org-get-priority-face val)))
- ((equal property "TAGS")
- (if (not org-tags-special-faces-re)
- (propertize v 'face 'org-tag)
- (replace-regexp-in-string
- org-tags-special-faces-re
- (lambda (m)
- (propertize m 'face (org-get-tag-face m)))
- v nil nil 1)))
- ((equal property "TODO")
- (propertize v 'face (org-get-todo-face val)))
- (t v)))))
- (ov (org-columns-new-overlay
- (point) (1+ (point)) string (if dateline face1 face))))
- (overlay-put ov 'keymap org-columns-map)
- (overlay-put ov 'org-columns-key property)
- (overlay-put ov 'org-columns-value (cdr ass))
- (overlay-put ov 'org-columns-value-modified modval)
- (overlay-put ov 'org-columns-pom pom)
- (overlay-put ov 'org-columns-format f)
- (overlay-put ov 'line-prefix "")
- (overlay-put ov 'wrap-prefix "")
- (forward-char)))
+ (let ((i 0)
+ (last (1- (length columns))))
+ (dolist (column columns)
+ (pcase column
+ (`(,spec ,original ,value)
+ (let* ((property (car spec))
+ (width (aref org-columns-current-maxwidths i))
+ (fmt (format (if (= i last) "%%-%d.%ds |"
+ "%%-%d.%ds | ")
+ width width))
+ (ov (org-columns--new-overlay
+ (point) (1+ (point))
+ (org-columns--overlay-text
+ value fmt width property original)
+ (if dateline face1 face))))
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'org-columns-key property)
+ (overlay-put ov 'org-columns-value original)
+ (overlay-put ov 'org-columns-value-modified value)
+ (overlay-put ov 'org-columns-format fmt)
+ (overlay-put ov 'line-prefix "")
+ (overlay-put ov 'wrap-prefix "")
+ (forward-char))))
+ (cl-incf i)))
;; Make the rest of the line disappear.
- (let ((ov (org-columns-new-overlay (point) (line-end-position))))
+ (let ((ov (org-columns--new-overlay (point) (line-end-position))))
(overlay-put ov 'invisible t)
(overlay-put ov 'keymap org-columns-map)
(overlay-put ov 'line-prefix "")
@@ -267,7 +394,7 @@ This is the compiled version of the format.")
(line-beginning-position 2)
'read-only
(substitute-command-keys
- "Type \\<org-columns-map>\\[org-columns-edit-value] \
+ "Type \\<org-columns-map>`\\[org-columns-edit-value]' \
to edit property")))))))
(defun org-columns-add-ellipses (string width)
@@ -293,36 +420,27 @@ for the duration of the command.")
(defvar header-line-format)
(defvar org-columns-previous-hscroll 0)
-(defun org-columns-display-here-title ()
+(defun org-columns--display-here-title ()
"Overlay the newline before the current line with the table title."
(interactive)
- (let ((fmt org-columns-current-fmt-compiled)
- string (title "")
- property width f column str widths)
- (while (setq column (pop fmt))
- (setq property (car column)
- str (or (nth 1 column) property)
- width (or (cdr (assoc-string property
- org-columns-current-maxwidths
- t))
- (nth 2 column)
- (length str))
- widths (push width widths)
- f (format "%%-%d.%ds | " width width)
- string (format f str)
- title (concat title string)))
- (setq title (concat
- (org-add-props " " nil 'display '(space :align-to 0))
- ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default))))
- (org-add-props title nil 'face 'org-column-title)))
- (org-set-local 'org-previous-header-line-format header-line-format)
- (org-set-local 'org-columns-current-widths (nreverse widths))
- (setq org-columns-full-header-line-format title)
+ (let ((title "")
+ (i 0))
+ (dolist (column org-columns-current-fmt-compiled)
+ (pcase column
+ (`(,property ,name . ,_)
+ (let* ((width (aref org-columns-current-maxwidths i))
+ (fmt (format "%%-%d.%ds | " width width)))
+ (setq title (concat title (format fmt (or name property)))))))
+ (cl-incf i))
+ (setq-local org-previous-header-line-format header-line-format)
+ (setq org-columns-full-header-line-format
+ (concat
+ (org-add-props " " nil 'display '(space :align-to 0))
+ (org-add-props (substring title 0 -1) nil 'face 'org-column-title)))
(setq org-columns-previous-hscroll -1)
- ; (org-columns-hscoll-title)
- (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))
+ (add-hook 'post-command-hook 'org-columns-hscroll-title nil 'local)))
-(defun org-columns-hscoll-title ()
+(defun org-columns-hscroll-title ()
"Set the `header-line-format' so that it scrolls along with the table."
(sit-for .0001) ; need to force a redisplay to update window-hscroll
(when (not (= (window-hscroll) org-columns-previous-hscroll))
@@ -345,7 +463,7 @@ for the duration of the command.")
(when (local-variable-p 'org-previous-header-line-format)
(setq header-line-format org-previous-header-line-format)
(kill-local-variable 'org-previous-header-line-format)
- (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local))
+ (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local))
(move-marker org-columns-begin-marker nil)
(move-marker org-columns-top-level-marker nil)
(org-with-silent-modifications
@@ -381,25 +499,26 @@ for the duration of the command.")
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
- (when (eq major-mode 'org-agenda-mode)
+ (if (not (eq major-mode 'org-agenda-mode))
+ (setq org-columns-current-fmt nil)
(setq org-agenda-columns-active nil)
(message
"Modification not yet reflected in Agenda buffer, use `r' to refresh")))
(defun org-columns-check-computed ()
- "Check if this column value is computed.
-If yes, throw an error indicating that changing it does not make sense."
- (let ((val (get-char-property (point) 'org-columns-value)))
- (when (and (stringp val)
- (get-char-property 0 'org-computed val))
- (error "This value is computed from the entry's children"))))
-
-(defun org-columns-todo (&optional arg)
+ "Throw an error if current column value is computed."
+ (let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
+ (and
+ (nth 3 spec)
+ (assoc spec (get-text-property (line-beginning-position) 'org-summaries))
+ (error "This value is computed from the entry's children"))))
+
+(defun org-columns-todo (&optional _arg)
"Change the TODO state during column view."
(interactive "P")
(org-columns-edit-value "TODO"))
-(defun org-columns-set-tags-or-toggle (&optional arg)
+(defun org-columns-set-tags-or-toggle (&optional _arg)
"Toggle checkbox at point, or set tags for current headline."
(interactive "P")
(if (string-match "\\`\\[[ xX-]\\]\\'"
@@ -417,107 +536,76 @@ Where possible, use the standard interface for changing this line."
(interactive)
(org-columns-check-computed)
(let* ((col (current-column))
+ (bol (line-beginning-position))
+ (eol (line-end-position))
+ (pom (or (get-text-property bol 'org-hd-marker) (point)))
(key (or key (get-char-property (point) 'org-columns-key)))
- (value (get-char-property (point) 'org-columns-value))
- (bol (point-at-bol)) (eol (point-at-eol))
- (pom (or (get-text-property bol 'org-hd-marker)
- (point))) ; keep despite of compiler waring
- (line-overlays
- (delq nil (mapcar (lambda (x)
- (and (eq (overlay-buffer x) (current-buffer))
- (>= (overlay-start x) bol)
- (<= (overlay-start x) eol)
- x))
- org-columns-overlays)))
- (org-columns-time (time-to-number-of-days (current-time)))
- nval eval allowed)
+ (org-columns--time (float-time (current-time)))
+ (action
+ (pcase key
+ ("CLOCKSUM"
+ (error "This special column cannot be edited"))
+ ("ITEM"
+ (lambda () (org-with-point-at pom (org-edit-headline))))
+ ("TODO"
+ (lambda ()
+ (org-with-point-at pom (call-interactively #'org-todo))))
+ ("PRIORITY"
+ (lambda ()
+ (org-with-point-at pom
+ (call-interactively #'org-priority))))
+ ("TAGS"
+ (lambda ()
+ (org-with-point-at pom
+ (let ((org-fast-tag-selection-single-key
+ (if (eq org-fast-tag-selection-single-key 'expert)
+ t
+ org-fast-tag-selection-single-key)))
+ (call-interactively #'org-set-tags)))))
+ ("DEADLINE"
+ (lambda ()
+ (org-with-point-at pom (call-interactively #'org-deadline))))
+ ("SCHEDULED"
+ (lambda ()
+ (org-with-point-at pom (call-interactively #'org-schedule))))
+ ("BEAMER_ENV"
+ (lambda ()
+ (org-with-point-at pom
+ (call-interactively #'org-beamer-select-environment))))
+ (_
+ (let* ((allowed (org-property-get-allowed-values pom key 'table))
+ (value (get-char-property (point) 'org-columns-value))
+ (nval (org-trim
+ (if (null allowed) (read-string "Edit: " value)
+ (completing-read
+ "Value: " allowed nil
+ (not (get-text-property
+ 0 'org-unrestricted (caar allowed))))))))
+ (and (not (equal nval value))
+ (lambda () (org-entry-put pom key nval))))))))
(cond
- ((equal key "CLOCKSUM")
- (error "This special column cannot be edited"))
- ((equal key "ITEM")
- (setq eval '(org-with-point-at pom
- (org-edit-headline))))
- ((equal key "TODO")
- (setq eval '(org-with-point-at
- pom
- (call-interactively 'org-todo))))
- ((equal key "PRIORITY")
- (setq eval '(org-with-point-at pom
- (call-interactively 'org-priority))))
- ((equal key "TAGS")
- (setq eval '(org-with-point-at pom
- (let ((org-fast-tag-selection-single-key
- (if (eq org-fast-tag-selection-single-key 'expert)
- t org-fast-tag-selection-single-key)))
- (call-interactively 'org-set-tags)))))
- ((equal key "DEADLINE")
- (setq eval '(org-with-point-at pom
- (call-interactively 'org-deadline))))
- ((equal key "SCHEDULED")
- (setq eval '(org-with-point-at pom
- (call-interactively 'org-schedule))))
- ((equal key "BEAMER_env")
- (setq eval '(org-with-point-at pom
- (call-interactively 'org-beamer-select-environment))))
+ ((null action))
+ ((eq major-mode 'org-agenda-mode)
+ (org-columns--call action)
+ ;; The following let preserves the current format, and makes
+ ;; sure that in only a single file things need to be updated.
+ (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
+ (buffer (marker-buffer pom))
+ (org-agenda-contributing-files
+ (list (with-current-buffer buffer
+ (buffer-file-name (buffer-base-buffer))))))
+ (org-agenda-columns)))
(t
- (setq allowed (org-property-get-allowed-values pom key 'table))
- (if allowed
- (setq nval (org-icompleting-read
- "Value: " allowed nil
- (not (get-text-property 0 'org-unrestricted
- (caar allowed)))))
- (setq nval (read-string "Edit: " value)))
- (setq nval (org-trim nval))
- (when (not (equal nval value))
- (setq eval '(org-entry-put pom key nval)))))
- (when eval
-
- (cond
- ((equal major-mode 'org-agenda-mode)
- (org-columns-eval eval)
- ;; The following let preserves the current format, and makes sure
- ;; that in only a single file things need to be updated.
- (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
- (buffer (marker-buffer pom))
- (org-agenda-contributing-files
- (list (with-current-buffer buffer
- (buffer-file-name (buffer-base-buffer))))))
- (org-agenda-columns)))
- (t
- (let ((inhibit-read-only t))
- (org-with-silent-modifications
- (remove-text-properties
- (max (point-min) (1- bol)) eol '(read-only t)))
- (unwind-protect
- (progn
- (setq org-columns-overlays
- (org-delete-all line-overlays org-columns-overlays))
- (mapc 'delete-overlay line-overlays)
- (org-columns-eval eval))
- (org-columns-display-here)))
- (org-move-to-column col)
- (if (and (derived-mode-p 'org-mode)
- (nth 3 (assoc-string key org-columns-current-fmt-compiled t)))
- (org-columns-update key)))))))
-
-(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda????
- "Edit the current headline, the part without TODO keyword, TAGS."
- (org-back-to-heading)
- (when (looking-at org-todo-line-regexp)
- (let ((pos (point))
- (pre (buffer-substring (match-beginning 0) (match-beginning 3)))
- (txt (match-string 3))
- (post "")
- txt2)
- (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt)
- (setq post (match-string 0 txt)
- txt (substring txt 0 (match-beginning 0))))
- (setq txt2 (read-string "Edit: " txt))
- (when (not (equal txt txt2))
- (goto-char pos)
- (insert pre txt2 post)
- (delete-region (point) (point-at-eol))
- (org-set-tags nil t)))))
+ (let ((inhibit-read-only t))
+ (org-with-silent-modifications
+ (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t)))
+ (org-columns--call action))
+ ;; Some properties can modify headline (e.g., "TODO"), and
+ ;; possible shuffle overlays. Make sure they are still all at
+ ;; the right place on the current line.
+ (let ((org-columns-inhibit-recalculation)) (org-columns-redo))
+ (org-columns-update key)
+ (org-move-to-column col)))))
(defun org-columns-edit-allowed ()
"Edit the list of allowed values for the current property."
@@ -540,15 +628,15 @@ Where possible, use the standard interface for changing this line."
(t pom))
key1 nval)))
-(defun org-columns-eval (form)
- (let (hidep)
- (save-excursion
- (beginning-of-line 1)
- ;; `next-line' is needed here, because it skips invisible line.
- (condition-case nil (org-no-warnings (next-line 1)) (error nil))
- (setq hidep (org-at-heading-p 1)))
- (eval form)
- (and hidep (outline-hide-entry))))
+(defun org-columns--call (fun)
+ "Call function FUN while preserving heading visibility.
+FUN is a function called with no argument."
+ (let ((hide-body (and (/= (line-end-position) (point-max))
+ (save-excursion
+ (move-beginning-of-line 2)
+ (org-at-heading-p t)))))
+ (unwind-protect (funcall fun)
+ (when hide-body (outline-hide-entry)))))
(defun org-columns-previous-allowed-value ()
"Switch to the previous allowed value for this column."
@@ -561,74 +649,57 @@ When PREVIOUS is set, go to the previous value. When NTH is
an integer, select that value."
(interactive)
(org-columns-check-computed)
- (let* ((col (current-column))
+ (let* ((column (current-column))
(key (get-char-property (point) 'org-columns-key))
(value (get-char-property (point) 'org-columns-value))
- (bol (point-at-bol)) (eol (point-at-eol))
- (pom (or (get-text-property bol 'org-hd-marker)
- (point))) ; keep despite of compiler waring
- (line-overlays
- (delq nil (mapcar (lambda (x)
- (and (eq (overlay-buffer x) (current-buffer))
- (>= (overlay-start x) bol)
- (<= (overlay-start x) eol)
- x))
- org-columns-overlays)))
- (allowed (or (org-property-get-allowed-values pom key)
- (and (memq
- (nth 4 (assoc-string key
- org-columns-current-fmt-compiled
- t))
- '(checkbox checkbox-n-of-m checkbox-percent))
- '("[ ]" "[X]"))
- (org-colview-construct-allowed-dates value)))
- nval)
- (when (integerp nth)
- (setq nth (1- nth))
- (if (= nth -1) (setq nth 9)))
- (when (equal key "ITEM")
- (error "Cannot edit item headline from here"))
+ (pom (or (get-text-property (line-beginning-position) 'org-hd-marker)
+ (point)))
+ (allowed
+ (let ((all
+ (or (org-property-get-allowed-values pom key)
+ (pcase (nth column org-columns-current-fmt-compiled)
+ (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) '("[ ]" "[X]")))
+ (org-colview-construct-allowed-dates value))))
+ (if previous (reverse all) all))))
+ (when (equal key "ITEM") (error "Cannot edit item headline from here"))
(unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")))
(error "Allowed values for this property have not been defined"))
- (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))
- (setq nval (if previous 'earlier 'later))
- (if previous (setq allowed (reverse allowed)))
+ (let* ((l (length allowed))
+ (new
+ (cond
+ ((member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))
+ (if previous 'earlier 'later))
+ ((integerp nth)
+ (when (> (abs nth) l)
+ (user-error "Only %d allowed values for property `%s'" l key))
+ (nth (mod (1- nth) l) allowed))
+ ((member value allowed)
+ (when (= l 1) (error "Only one allowed value for this property"))
+ (or (nth 1 (member value allowed)) (car allowed)))
+ (t (car allowed))))
+ (action (lambda () (org-entry-put pom key new))))
(cond
- (nth
- (setq nval (nth nth allowed))
- (if (not nval)
- (error "There are only %d allowed values for property `%s'"
- (length allowed) key)))
- ((member value allowed)
- (setq nval (or (car (cdr (member value allowed)))
- (car allowed)))
- (if (equal nval value)
- (error "Only one allowed value for this property")))
- (t (setq nval (car allowed)))))
- (cond
- ((equal major-mode 'org-agenda-mode)
- (org-columns-eval `(org-entry-put ,pom ,key ,nval))
- ;; The following let preserves the current format, and makes sure
- ;; that in only a single file things need to be updated.
- (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
- (buffer (marker-buffer pom))
- (org-agenda-contributing-files
- (list (with-current-buffer buffer
- (buffer-file-name (buffer-base-buffer))))))
- (org-agenda-columns)))
- (t
- (let ((inhibit-read-only t))
- (remove-text-properties (max (1- bol) (point-min)) eol '(read-only t))
- (unwind-protect
- (progn
- (setq org-columns-overlays
- (org-delete-all line-overlays org-columns-overlays))
- (mapc 'delete-overlay line-overlays)
- (org-columns-eval `(org-entry-put ,pom ,key ,nval)))
- (org-columns-display-here)))
- (org-move-to-column col)
- (and (nth 3 (assoc-string key org-columns-current-fmt-compiled t))
- (org-columns-update key))))))
+ ((eq major-mode 'org-agenda-mode)
+ (org-columns--call action)
+ ;; The following let preserves the current format, and makes
+ ;; sure that in only a single file things need to be updated.
+ (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
+ (buffer (marker-buffer pom))
+ (org-agenda-contributing-files
+ (list (with-current-buffer buffer
+ (buffer-file-name (buffer-base-buffer))))))
+ (org-agenda-columns)))
+ (t
+ (let ((inhibit-read-only t))
+ (remove-text-properties (line-end-position 0) (line-end-position)
+ '(read-only t))
+ (org-columns--call action))
+ ;; Some properties can modify headline (e.g., "TODO"), and
+ ;; possible shuffle overlays. Make sure they are still all at
+ ;; the right place on the current line.
+ (let ((org-columns-inhibit-recalculation)) (org-columns-redo))
+ (org-columns-update key)
+ (org-move-to-column column))))))
(defun org-colview-construct-allowed-dates (s)
"Construct a list of three dates around the date in S.
@@ -651,13 +722,6 @@ around it."
(mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x)))
(list time-before time time-after)))))
-(defun org-verify-version (task)
- (cond
- ((eq task 'columns)
- (if (or (featurep 'xemacs)
- (< emacs-major-version 22))
- (error "Emacs 22 is required for the columns feature")))))
-
(defun org-columns-open-link (&optional arg)
(interactive "P")
(let ((value (get-char-property (point) 'org-columns-value)))
@@ -670,14 +734,28 @@ around it."
fmt))
(defun org-columns-get-format (&optional fmt-string)
+ "Return columns format specifications.
+When optional argument FMT-STRING is non-nil, use it as the
+current specifications. This function also sets
+`org-columns-current-fmt-compiled' and
+`org-columns-current-fmt'."
(interactive)
- (let (fmt-as-property fmt)
- (when (condition-case nil (org-back-to-heading) (error nil))
- (setq fmt-as-property (org-entry-get nil "COLUMNS" t)))
- (setq fmt (or fmt-string fmt-as-property org-columns-default-format))
- (org-set-local 'org-columns-current-fmt fmt)
- (org-columns-compile-format fmt)
- fmt))
+ (let ((format
+ (or fmt-string
+ (org-entry-get nil "COLUMNS" t)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (catch :found
+ (let ((case-fold-search t))
+ (while (re-search-forward "^[ \t]*#\\+COLUMNS: .+$" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (throw :found (org-element-property :value element)))))
+ nil)))
+ org-columns-default-format)))
+ (setq org-columns-current-fmt format)
+ (org-columns-compile-format format)
+ format))
(defun org-columns-goto-top-level ()
"Move to the beginning of the column view area.
@@ -690,162 +768,130 @@ Also sets `org-columns-top-level-marker' to the new position."
(t (org-back-to-heading) (point))))))
;;;###autoload
-(defun org-columns (&optional columns-fmt-string)
- "Turn on column view on an org-mode file.
+(defun org-columns (&optional global columns-fmt-string)
+ "Turn on column view on an Org mode file.
+
+Column view applies to the whole buffer if point is before the
+first headline. Otherwise, it applies to the first ancestor
+setting \"COLUMNS\" property. If there is none, it defaults to
+the current headline. With a `\\[universal-argument]' prefix \
+argument, turn on column
+view for the whole buffer unconditionally.
+
When COLUMNS-FMT-STRING is non-nil, use it as the column format."
- (interactive)
- (org-verify-version 'columns)
+ (interactive "P")
(org-columns-remove-overlays)
(move-marker org-columns-begin-marker (point))
(org-columns-goto-top-level)
;; Initialize `org-columns-current-fmt' and
;; `org-columns-current-fmt-compiled'.
- (let ((org-columns-time (time-to-number-of-days (current-time))))
- (org-columns-get-format columns-fmt-string))
- (unless org-columns-inhibit-recalculation (org-columns-compute-all))
- (save-excursion
- (save-restriction
- (narrow-to-region
- (point)
- (if (org-at-heading-p) (org-end-of-subtree t t) (point-max)))
- (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
- (org-clock-sum))
- (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
- (org-clock-sum-today))
- (let* ((column-names (mapcar #'car org-columns-current-fmt-compiled))
- (cache
- (org-map-entries
- (lambda ()
- (cons (point)
- (mapcar (lambda (p)
- (cons p (org-columns--value p (point))))
- column-names)))
- nil nil (and org-columns-skip-archived-trees 'archive))))
- (when cache
- (org-set-local 'org-columns-current-maxwidths
- (org-columns-get-autowidth-alist
- org-columns-current-fmt
- cache))
- (org-columns-display-here-title)
- (when (org-set-local 'org-columns-flyspell-was-active
- (org-bound-and-true-p flyspell-mode))
- (flyspell-mode 0))
- (unless (local-variable-p 'org-colview-initial-truncate-line-value)
- (org-set-local 'org-colview-initial-truncate-line-value
- truncate-lines))
- (setq truncate-lines t)
- (dolist (x cache)
- (goto-char (car x))
- (org-columns-display-here (cdr x))))))))
-
-(eval-when-compile (defvar org-columns-time))
-
-(defvar org-columns-compile-map
- '(("none" none +)
- (":" add_times +)
- ("+" add_numbers +)
- ("$" currency +)
- ("X" checkbox +)
- ("X/" checkbox-n-of-m +)
- ("X%" checkbox-percent +)
- ("max" max_numbers max)
- ("min" min_numbers min)
- ("mean" mean_numbers
- (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
- (":max" max_times max)
- (":min" min_times min)
- (":mean" mean_times
- (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
- ("@min" min_age min (lambda (x) (- org-columns-time x)))
- ("@max" max_age max (lambda (x) (- org-columns-time x)))
- ("@mean" mean_age
- (lambda (&rest x) (/ (apply '+ x) (float (length x))))
- (lambda (x) (- org-columns-time x)))
- ("est+" estimate org-estimate-combine))
- "Operator <-> format,function,calc map.
-Used to compile/uncompile columns format and completing read in
-interactive function `org-columns-new'.
-
-operator string used in #+COLUMNS definition describing the
- summary type
-format symbol describing summary type selected interactively in
- `org-columns-new' and internally in
- `org-columns-number-to-string' and
- `org-columns-string-to-number'
-function called with a list of values as argument to calculate
- the summary value
-calc function called on every element before summarizing. This is
- optional and should only be specified if needed")
-
-(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
- "Insert a new column, to the left of the current column."
+ (let ((org-columns--time (float-time (current-time))))
+ (org-columns-get-format columns-fmt-string)
+ (unless org-columns-inhibit-recalculation (org-columns-compute-all))
+ (save-excursion
+ (save-restriction
+ (when (and (not global) (org-at-heading-p))
+ (narrow-to-region (point) (org-end-of-subtree t t)))
+ (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
+ (org-clock-sum))
+ (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
+ (org-clock-sum-today))
+ (let ((cache
+ ;; Collect contents of columns ahead of time so as to
+ ;; compute their maximum width.
+ (org-map-entries
+ (lambda () (cons (point) (org-columns--collect-values)))
+ nil nil (and org-columns-skip-archived-trees 'archive))))
+ (when cache
+ (org-columns--set-widths cache)
+ (org-columns--display-here-title)
+ (when (setq-local org-columns-flyspell-was-active
+ (bound-and-true-p flyspell-mode))
+ (flyspell-mode 0))
+ (unless (local-variable-p 'org-colview-initial-truncate-line-value)
+ (setq-local org-colview-initial-truncate-line-value
+ truncate-lines))
+ (setq truncate-lines t)
+ (dolist (entry cache)
+ (goto-char (car entry))
+ (org-columns--display-here (cdr entry)))))))))
+
+(defun org-columns-new (&optional spec &rest attributes)
+ "Insert a new column, to the left of the current column.
+Interactively fill attributes for new column. When column format
+specification SPEC is provided, edit it instead.
+
+When optional argument attributes can be a list of columns
+specifications attributes to create the new column
+non-interactively. See `org-columns-compile-format' for
+details."
(interactive)
- (let ((editp (and prop
- (assoc-string prop org-columns-current-fmt-compiled t)))
- cell)
- (setq prop (org-icompleting-read
- "Property: " (mapcar 'list (org-buffer-property-keys t nil t))
- nil nil prop))
- (setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
- (setq width (read-string "Column width: " (if width (number-to-string width))))
- (if (string-match "\\S-" width)
- (setq width (string-to-number width))
- (setq width nil))
- (setq fmt (org-icompleting-read
- "Summary [none]: "
- (mapcar (lambda (x) (list (symbol-name (cadr x))))
- org-columns-compile-map)
- nil t))
- (setq fmt (intern fmt)
- fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
- (if (eq fmt 'none) (setq fmt nil))
- (if editp
- (progn
- (setcar editp prop)
- (setcdr editp (list title width nil fmt nil fun)))
- (setq cell (nthcdr (1- (current-column))
- org-columns-current-fmt-compiled))
- (setcdr cell (cons (list prop title width nil fmt nil
- (car fun) (cadr fun))
- (cdr cell))))
+ (let ((new (or attributes
+ (let ((prop
+ (completing-read
+ "Property: "
+ (mapcar #'list (org-buffer-property-keys t nil t))
+ nil nil (nth 0 spec))))
+ (list prop
+ (read-string (format "Column title [%s]: " prop)
+ (nth 1 spec))
+ ;; Use `read-string' instead of `read-number'
+ ;; to allow empty width.
+ (let ((w (read-string
+ "Column width: "
+ (and (nth 2 spec)
+ (number-to-string (nth 2 spec))))))
+ (and (org-string-nw-p w) (string-to-number w)))
+ (org-string-nw-p
+ (completing-read
+ "Summary: "
+ (delete-dups
+ (cons '("") ;Allow empty operator.
+ (mapcar (lambda (x) (list (car x)))
+ (append
+ org-columns-summary-types
+ org-columns-summary-types-default))))
+ nil t (nth 3 spec)))
+ (org-string-nw-p
+ (read-string "Format: " (nth 4 spec))))))))
+ (if spec
+ (progn (setcar spec (car new))
+ (setcdr spec (cdr new)))
+ (push new (nthcdr (current-column) org-columns-current-fmt-compiled)))
(org-columns-store-format)
(org-columns-redo)))
(defun org-columns-delete ()
"Delete the column at point from columns view."
(interactive)
- (let* ((n (current-column))
- (title (nth 1 (nth n org-columns-current-fmt-compiled))))
- (when (y-or-n-p
- (format "Are you sure you want to remove column \"%s\"? " title))
+ (let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
+ (when (y-or-n-p (format "Are you sure you want to remove column %S? "
+ (nth 1 spec)))
(setq org-columns-current-fmt-compiled
- (delq (nth n org-columns-current-fmt-compiled)
- org-columns-current-fmt-compiled))
+ (delq spec org-columns-current-fmt-compiled))
(org-columns-store-format)
- (org-columns-redo)
- (if (>= (current-column) (length org-columns-current-fmt-compiled))
- (backward-char 1)))))
+ ;; This may leave a now wrong value in a node property. However
+ ;; updating it may prove counter-intuitive. See comments in
+ ;; `org-columns-move-right' for details.
+ (let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
+ (when (>= (current-column) (length org-columns-current-fmt-compiled))
+ (backward-char)))))
(defun org-columns-edit-attributes ()
"Edit the attributes of the current column."
(interactive)
- (let* ((n (current-column))
- (info (nth n org-columns-current-fmt-compiled)))
- (apply 'org-columns-new info)))
+ (org-columns-new (nth (current-column) org-columns-current-fmt-compiled)))
(defun org-columns-widen (arg)
"Make the column wider by ARG characters."
(interactive "p")
(let* ((n (current-column))
(entry (nth n org-columns-current-fmt-compiled))
- (width (or (nth 2 entry)
- (cdr (assoc-string (car entry)
- org-columns-current-maxwidths
- t)))))
+ (width (aref org-columns-current-maxwidths n)))
(setq width (max 1 (+ width arg)))
(setcar (nthcdr 2 entry) width)
(org-columns-store-format)
- (org-columns-redo)))
+ (let ((org-columns-inhibit-recalculation t)) (org-columns-redo))))
(defun org-columns-narrow (arg)
"Make the column narrower by ARG characters."
@@ -864,7 +910,16 @@ calc function called on every element before summarizing. This is
(setcar cell (car (cdr cell)))
(setcdr cell (cons e (cdr (cdr cell))))
(org-columns-store-format)
- (org-columns-redo)
+ ;; Do not compute again properties, since we're just moving
+ ;; columns around. It can put a property value a bit off when
+ ;; switching between an non-computed and a computed value for the
+ ;; same property, e.g. from "%A %A{+}" to "%A{+} %A".
+ ;;
+ ;; In this case, the value needs to be updated since the first
+ ;; column related to a property determines how its value is
+ ;; computed. However, (correctly) updating the value could be
+ ;; surprising, so we leave it as-is nonetheless.
+ (let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
(forward-char 1)))
(defun org-columns-move-left ()
@@ -878,364 +933,447 @@ calc function called on every element before summarizing. This is
(backward-char 1)))
(defun org-columns-store-format ()
- "Store the text version of the current columns format in appropriate place.
-This is either in the COLUMNS property of the node starting the current column
-display, or in the #+COLUMNS line of the current buffer."
- (let (fmt (cnt 0))
- (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
- (org-set-local 'org-columns-current-fmt fmt)
- (if (marker-position org-columns-top-level-marker)
- (save-excursion
- (goto-char org-columns-top-level-marker)
- (if (and (org-at-heading-p)
- (org-entry-get nil "COLUMNS"))
- (org-entry-put nil "COLUMNS" fmt)
- (goto-char (point-min))
- ;; Overwrite all #+COLUMNS lines....
- (while (re-search-forward "^[ \t]*#\\+COLUMNS:.*" nil t)
- (setq cnt (1+ cnt))
- (replace-match (concat "#+COLUMNS: " fmt) t t))
- (unless (> cnt 0)
- (goto-char (point-min))
- (or (org-at-heading-p t) (outline-next-heading))
- (let ((inhibit-read-only t))
- (insert-before-markers "#+COLUMNS: " fmt "\n")))
- (org-set-local 'org-columns-default-format fmt))))))
-
-(defun org-columns-get-autowidth-alist (s cache)
- "Derive the maximum column widths from the format and the cache."
- (let ((start 0) rtn)
- (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start)
- (push (cons (match-string 1 s) 1) rtn)
- (setq start (match-end 0)))
- (mapc (lambda (x)
- (setcdr x
- (apply #'max
- (let ((prop (car x)))
- (mapcar
- (lambda (y)
- (length (or (cdr (assoc-string prop (cdr y) t))
- " ")))
- cache)))))
- rtn)
- rtn))
-
-(defun org-columns-compute-all ()
- "Compute all columns that have operators defined."
- (org-with-silent-modifications
- (remove-text-properties (point-min) (point-max) '(org-summaries t)))
- (let ((columns org-columns-current-fmt-compiled)
- (org-columns-time (time-to-number-of-days (current-time)))
- col)
- (while (setq col (pop columns))
- (when (nth 3 col)
- (save-excursion
- (org-columns-compute (car col)))))))
+ "Store the text version of the current columns format.
+The format is stored either in the COLUMNS property of the node
+starting the current column display, or in a #+COLUMNS line of
+the current buffer."
+ (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)))
+ (setq-local org-columns-current-fmt fmt)
+ (when (marker-position org-columns-top-level-marker)
+ (org-with-wide-buffer
+ (goto-char org-columns-top-level-marker)
+ (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS"))
+ (org-entry-put nil "COLUMNS" fmt)
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ ;; Try to replace the first COLUMNS keyword available.
+ (catch :found
+ (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t)
+ (let ((element (save-match-data (org-element-at-point))))
+ (when (and (eq (org-element-type element) 'keyword)
+ (equal (org-element-property :key element)
+ "COLUMNS"))
+ (replace-match (concat " " fmt) t t nil 1)
+ (throw :found nil))))
+ ;; No COLUMNS keyword in the buffer. Insert one at the
+ ;; beginning, right before the first heading, if any.
+ (goto-char (point-min))
+ (unless (org-at-heading-p t) (outline-next-heading))
+ (let ((inhibit-read-only t))
+ (insert-before-markers "#+COLUMNS: " fmt "\n"))))
+ (setq-local org-columns-default-format fmt))))))
(defun org-columns-update (property)
"Recompute PROPERTY, and update the columns display for it."
(org-columns-compute property)
- (let (fmt val pos)
- (save-excursion
- (mapc (lambda (ov)
- (when (equal (overlay-get ov 'org-columns-key) property)
- (setq pos (overlay-start ov))
- (goto-char pos)
- (when (setq val (cdr (assoc-string
- property
- (get-text-property
- (point-at-bol) 'org-summaries)
- t)))
- (setq fmt (overlay-get ov 'org-columns-format))
- (overlay-put ov 'org-columns-value val)
- (overlay-put ov 'display (format fmt val)))))
- org-columns-overlays))))
-
-(defvar org-inlinetask-min-level
- (if (featurep 'org-inlinetask) org-inlinetask-min-level 15))
-
-;;;###autoload
-(defun org-columns-compute (property)
- "Sum the values of property PROPERTY hierarchically, for the entire buffer."
- (interactive)
- (let* ((re org-outline-regexp-bol)
- (lmax 30) ; Does anyone use deeper levels???
- (lvals (make-vector lmax nil))
- (lflag (make-vector lmax nil))
- (level 0)
- (ass (assoc-string property org-columns-current-fmt-compiled t))
- (format (nth 4 ass))
- (printf (nth 5 ass))
- (fun (nth 6 ass))
- (calc (or (nth 7 ass) 'identity))
- (beg org-columns-top-level-marker)
- (inminlevel org-inlinetask-min-level)
- (last-level org-inlinetask-min-level)
- val valflag flag end sumpos sum-alist sum str str1 useval)
- (save-excursion
- ;; Find the region to compute
- (goto-char beg)
- (setq end (condition-case nil (org-end-of-subtree t) (error (point-max))))
- (goto-char end)
- ;; Walk the tree from the back and do the computations
- (while (re-search-backward re beg t)
- (setq sumpos (match-beginning 0)
- last-level (if (not (or (zerop level) (eq level inminlevel)))
- level last-level)
- level (org-outline-level)
- val (org-entry-get nil property)
- valflag (and val (string-match "\\S-" val)))
- (cond
- ((< level last-level)
- ;; Put the sum of lower levels here as a property. If
- ;; values are estimate, use an appropriate sum function.
- (setq sum (funcall
- (if (eq fun 'org-estimate-combine) #'org-estimate-combine
- #'+)
- (if (and (/= last-level inminlevel)
- (aref lvals last-level))
- (apply fun (aref lvals last-level)) 0)
- (if (aref lvals inminlevel)
- (apply fun (aref lvals inminlevel)) 0))
- flag (or (aref lflag last-level) ; any valid entries from children?
- (aref lflag inminlevel)) ; or inline tasks?
- str (org-columns-number-to-string sum format printf)
- str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
- useval (if flag str1 (if valflag val ""))
- sum-alist (get-text-property sumpos 'org-summaries))
- (let ((old (assoc-string property sum-alist t)))
- (if old (setcdr old useval)
- (push (cons property useval) sum-alist)
- (org-with-silent-modifications
- (add-text-properties sumpos (1+ sumpos)
- (list 'org-summaries sum-alist)))))
- (when (and val (not (equal val (if flag str val))))
- (org-entry-put nil property (if flag str val)))
- ;; add current to current level accumulator
- (when (or flag valflag)
- (push (if flag
- sum
- (funcall calc (org-columns-string-to-number
- (if flag str val) format)))
- (aref lvals level))
- (aset lflag level t))
- ;; clear accumulators for deeper levels
- (loop for l from (1+ level) to (1- lmax) do
- (aset lvals l nil)
- (aset lflag l nil)))
- ((>= level last-level)
- ;; add what we have here to the accumulator for this level
- (when valflag
- (push (funcall calc (org-columns-string-to-number val format))
- (aref lvals level))
- (aset lflag level t)))
- (t (error "This should not happen")))))))
+ (org-with-wide-buffer
+ (let ((p (upcase property)))
+ (dolist (ov org-columns-overlays)
+ (let ((key (overlay-get ov 'org-columns-key)))
+ (when (and key (equal key p) (overlay-start ov))
+ (goto-char (overlay-start ov))
+ (let* ((spec (nth (current-column) org-columns-current-fmt-compiled))
+ (value
+ (or (cdr (assoc spec
+ (get-text-property (line-beginning-position)
+ 'org-summaries)))
+ (org-entry-get (point) key))))
+ (when value
+ (let ((displayed (org-columns--displayed-value spec value))
+ (format (overlay-get ov 'org-columns-format))
+ (width
+ (aref org-columns-current-maxwidths (current-column))))
+ (overlay-put ov 'org-columns-value value)
+ (overlay-put ov 'org-columns-value-modified displayed)
+ (overlay-put ov
+ 'display
+ (org-columns--overlay-text
+ displayed format width property value)))))))))))
(defun org-columns-redo ()
"Construct the column display again."
(interactive)
(message "Recomputing columns...")
- (let ((line (org-current-line))
- (col (current-column)))
- (save-excursion
- (if (marker-position org-columns-begin-marker)
- (goto-char org-columns-begin-marker))
- (org-columns-remove-overlays)
- (if (derived-mode-p 'org-mode)
- (call-interactively 'org-columns)
- (org-agenda-redo)
- (call-interactively 'org-agenda-columns)))
- (org-goto-line line)
- (move-to-column col))
+ (org-with-wide-buffer
+ (when (marker-position org-columns-begin-marker)
+ (goto-char org-columns-begin-marker))
+ (org-columns-remove-overlays)
+ (if (derived-mode-p 'org-mode)
+ ;; Since we already know the columns format, provide it instead
+ ;; of computing again.
+ (call-interactively #'org-columns org-columns-current-fmt)
+ (org-agenda-redo)
+ (call-interactively #'org-agenda-columns)))
(message "Recomputing columns...done"))
-(defun org-columns-not-in-agenda ()
- (if (eq major-mode 'org-agenda-mode)
- (error "This command is only allowed in Org-mode buffers")))
-
-(defun org-string-to-number (s)
- "Convert string to number, and interpret hh:mm:ss."
- (if (not (string-match ":" s))
- (string-to-number s)
- (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
- (while l
- (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
- sum)))
-
-;;;###autoload
-(defun org-columns-number-to-string (n fmt &optional printf)
- "Convert a computed column number to a string value, according to FMT."
- (cond
- ((memq fmt '(estimate)) (org-estimate-print n printf))
- ((not (numberp n)) "")
- ((memq fmt '(add_times max_times min_times mean_times))
- (org-hours-to-clocksum-string n))
- ((eq fmt 'checkbox)
- (cond ((= n (floor n)) "[X]")
- ((> n 1.) "[-]")
- (t "[ ]")))
- ((memq fmt '(checkbox-n-of-m checkbox-percent))
- (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1))))))
- (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent))))
- (printf (format printf n))
- ((eq fmt 'currency)
- (format "%.2f" n))
- ((memq fmt '(min_age max_age mean_age))
- (org-format-time-period n))
- (t (number-to-string n))))
-
-(defun org-nofm-to-completion (n m &optional percent)
- (if (not percent)
- (format "[%d/%d]" n m)
- (format "[%d%%]" (round (* 100.0 n) m))))
-
-
-(defun org-columns-string-to-number (s fmt)
- "Convert a column value to a number that can be used for column computing."
- (if s
- (cond
- ((memq fmt '(min_age max_age mean_age))
- (cond ((string= s "") org-columns-time)
- ((string-match
- "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
- s)
- (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
- (string-to-number (match-string 2 s))))
- (string-to-number (match-string 3 s))))
- (string-to-number (match-string 4 s))))
- (t (time-to-number-of-days (apply 'encode-time
- (org-parse-time-string s t))))))
- ((string-match ":" s)
- (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
- (while l
- (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
- sum))
- ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
- (if (equal s "[X]") 1. 0.000001))
- ((memq fmt '(estimate)) (org-string-to-estimate s))
- ((string-match (concat "\\([0-9.]+\\) *\\("
- (regexp-opt (mapcar 'car org-effort-durations))
- "\\)") s)
- (setq s (concat "0:" (org-duration-string-to-minutes s t)))
- (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
- (while l
- (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
- sum))
- (t (string-to-number s)))))
-
-(defun org-columns-uncompile-format (cfmt)
- "Turn the compiled columns format back into a string representation."
- (let ((rtn "") e s prop title op op-match width fmt printf fun calc ee map)
- (while (setq e (pop cfmt))
- (setq prop (car e)
- title (nth 1 e)
- width (nth 2 e)
- op (nth 3 e)
- fmt (nth 4 e)
- printf (nth 5 e)
- fun (nth 6 e)
- calc (nth 7 e))
- (setq map (copy-sequence org-columns-compile-map))
- (while (setq ee (pop map))
- (if (equal fmt (nth 1 ee))
- (setq op (car ee) map nil)))
- (if (and op printf) (setq op (concat op ";" printf)))
- (if (equal title prop) (setq title nil))
- (setq s (concat "%" (if width (number-to-string width))
- prop
- (if title (concat "(" title ")"))
- (if op (concat "{" op "}"))))
- (setq rtn (concat rtn " " s)))
- (org-trim rtn)))
+(defun org-columns-uncompile-format (compiled)
+ "Turn the compiled columns format back into a string representation.
+COMPILED is an alist, as returned by
+`org-columns-compile-format', which see."
+ (mapconcat
+ (lambda (spec)
+ (pcase spec
+ (`(,prop ,title ,width ,op ,printf)
+ (concat "%"
+ (and width (number-to-string width))
+ prop
+ (and title (not (equal prop title)) (format "(%s)" title))
+ (cond ((not op) nil)
+ (printf (format "{%s;%s}" op printf))
+ (t (format "{%s}" op)))))))
+ compiled " "))
(defun org-columns-compile-format (fmt)
"Turn a column format string FMT into an alist of specifications.
The alist has one entry for each column in the format. The elements of
that list are:
-property the property
-title the title field for the columns
-width the column width in characters, can be nil for automatic
-operator the operator if any
-format the output format for computed results, derived from operator
-printf a printf format for computed values
-fun the lisp function to compute summary values, derived from operator
-calc function to get values from base elements
+property the property name, as an upper-case string
+title the title field for the columns, as a string
+width the column width in characters, can be nil for automatic width
+operator the summary operator, as a string, or nil
+printf a printf format for computed values, as a string, or nil
This function updates `org-columns-current-fmt-compiled'."
- (let ((start 0) width prop title op op-match f printf fun calc)
- (setq org-columns-current-fmt-compiled nil)
+ (setq org-columns-current-fmt-compiled nil)
+ (let ((start 0))
(while (string-match
- (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
+ "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\
+\\(?:{\\([^}]+\\)}\\)?\\s-*"
fmt start)
- (setq start (match-end 0)
- width (match-string 1 fmt)
- prop (match-string 2 fmt)
- title (or (match-string 3 fmt) prop)
- op (match-string 4 fmt)
- f nil
- printf nil
- fun '+
- calc nil)
- (if width (setq width (string-to-number width)))
- (when (and op (string-match ";" op))
- (setq printf (substring op (match-end 0))
- op (substring op 0 (match-beginning 0))))
- (when (setq op-match (assoc op org-columns-compile-map))
- (setq f (cadr op-match)
- fun (caddr op-match)
- calc (cadddr op-match)))
- (push (list prop title width op f printf fun calc)
- org-columns-current-fmt-compiled))
+ (setq start (match-end 0))
+ (let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt))))
+ (prop (match-string-no-properties 2 fmt))
+ (title (or (match-string-no-properties 3 fmt) prop))
+ (operator (match-string-no-properties 4 fmt)))
+ (push (if (not operator) (list (upcase prop) title width nil nil)
+ (let (printf)
+ (when (string-match ";" operator)
+ (setq printf (substring operator (match-end 0)))
+ (setq operator (substring operator 0 (match-beginning 0))))
+ (list (upcase prop) title width operator printf)))
+ org-columns-current-fmt-compiled)))
(setq org-columns-current-fmt-compiled
(nreverse org-columns-current-fmt-compiled))))
+
+;;;; Column View Summary
+(defconst org-columns--duration-re
+ (concat "[0-9.]+ *" (regexp-opt (mapcar #'car org-effort-durations)))
+ "Regexp matching a duration.")
+
+(defun org-columns--time-to-seconds (s)
+ "Turn time string S into a number of seconds.
+A time is expressed as HH:MM, HH:MM:SS, or with units defined in
+`org-effort-durations'. Plain numbers are considered as hours."
+ (cond
+ ((string-match "\\([0-9]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" s)
+ (+ (* 3600 (string-to-number (match-string 1 s)))
+ (* 60 (string-to-number (match-string 2 s)))
+ (if (match-end 3) (string-to-number (match-string 3 s)) 0)))
+ ((string-match-p org-columns--duration-re s)
+ (* 60 (org-duration-string-to-minutes s)))
+ (t (* 3600 (string-to-number s)))))
+
+(defun org-columns--age-to-seconds (s)
+ "Turn age string S into a number of seconds.
+An age is either computed from a given time-stamp, or indicated
+as days/hours/minutes/seconds."
+ (cond
+ ((string-match-p org-ts-regexp s)
+ (floor
+ (- org-columns--time
+ (float-time (apply #'encode-time (org-parse-time-string s))))))
+ ;; Match own output for computations in upper levels.
+ ((string-match "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" s)
+ (+ (* 86400 (string-to-number (match-string 1 s)))
+ (* 3600 (string-to-number (match-string 2 s)))
+ (* 60 (string-to-number (match-string 3 s)))
+ (string-to-number (match-string 4 s))))
+ (t (user-error "Invalid age: %S" s))))
+
+(defun org-columns--summary-apply-times (fun times)
+ "Apply FUN to time values TIMES.
+If TIMES contains any time value expressed as a duration, return
+the result as a duration. If it contains any H:M:S, use that
+format instead. Otherwise, use H:M format."
+ (let* ((hms-flag nil)
+ (duration-flag nil)
+ (seconds
+ (apply fun
+ (mapcar
+ (lambda (time)
+ (cond
+ (duration-flag)
+ ((string-match-p org-columns--duration-re time)
+ (setq duration-flag t))
+ (hms-flag)
+ ((string-match-p "\\`[0-9]+:[0-9]+:[0-9]+\\'" time)
+ (setq hms-flag t)))
+ (org-columns--time-to-seconds time))
+ times))))
+ (cond (duration-flag (org-minutes-to-clocksum-string (/ seconds 60.0)))
+ (hms-flag (format-seconds "%h:%.2m:%.2s" seconds))
+ (t (format-seconds "%h:%.2m" seconds)))))
+
+(defun org-columns--compute-spec (spec &optional update)
+ "Update tree according to SPEC.
+SPEC is a column format specification. When optional argument
+UPDATE is non-nil, summarized values can replace existing ones in
+properties drawers."
+ (let* ((lmax (if (bound-and-true-p org-inlinetask-min-level)
+ org-inlinetask-min-level
+ 29)) ;Hard-code deepest level.
+ (lvals (make-vector (1+ lmax) nil))
+ (level 0)
+ (inminlevel lmax)
+ (last-level lmax)
+ (property (car spec))
+ (printf (nth 4 spec))
+ (summarize (org-columns--summarize (nth 3 spec))))
+ (org-with-wide-buffer
+ ;; Find the region to compute.
+ (goto-char org-columns-top-level-marker)
+ (goto-char (condition-case nil (org-end-of-subtree t) (error (point-max))))
+ ;; Walk the tree from the back and do the computations.
+ (while (re-search-backward
+ org-outline-regexp-bol org-columns-top-level-marker t)
+ (unless (or (= level 0) (eq level inminlevel))
+ (setq last-level level))
+ (setq level (org-reduced-level (org-outline-level)))
+ (let* ((pos (match-beginning 0))
+ (value (org-entry-get nil property))
+ (value-set (org-string-nw-p value)))
+ (cond
+ ((< level last-level)
+ ;; Collect values from lower levels and inline tasks here
+ ;; and summarize them using SUMMARIZE. Store them in text
+ ;; property `org-summaries', in alist whose key is SPEC.
+ (let* ((summary
+ (and summarize
+ (let ((values (append (and (/= last-level inminlevel)
+ (aref lvals last-level))
+ (aref lvals inminlevel))))
+ (and values (funcall summarize values printf))))))
+ ;; Leaf values are not summaries: do not mark them.
+ (when summary
+ (let* ((summaries-alist (get-text-property pos 'org-summaries))
+ (old (assoc spec summaries-alist)))
+ (if old (setcdr old summary)
+ (push (cons spec summary) summaries-alist)
+ (org-with-silent-modifications
+ (add-text-properties
+ pos (1+ pos) (list 'org-summaries summaries-alist)))))
+ ;; When PROPERTY exists in current node, even if empty,
+ ;; but its value doesn't match the one computed, use
+ ;; the latter instead.
+ (when (and update value (not (equal value summary)))
+ (org-entry-put (point) property summary)))
+ ;; Add current to current level accumulator.
+ (when (or summary value-set)
+ (push (or summary value) (aref lvals level)))
+ ;; Clear accumulators for deeper levels.
+ (cl-loop for l from (1+ level) to lmax do (aset lvals l nil))))
+ (value-set (push value (aref lvals level)))
+ (t nil)))))))
+
+;;;###autoload
+(defun org-columns-compute (property)
+ "Summarize the values of PROPERTY hierarchically.
+Also update existing values for PROPERTY according to the first
+column specification."
+ (interactive)
+ (let ((main-flag t)
+ (upcase-prop (upcase property)))
+ (dolist (spec org-columns-current-fmt-compiled)
+ (pcase spec
+ (`(,(pred (equal upcase-prop)) . ,_)
+ (org-columns--compute-spec spec main-flag)
+ ;; Only the first summary can update the property value.
+ (when main-flag (setq main-flag nil)))))))
+
+(defun org-columns-compute-all ()
+ "Compute all columns that have operators defined."
+ (org-with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(org-summaries t)))
+ (let ((org-columns--time (float-time (current-time)))
+ seen)
+ (dolist (spec org-columns-current-fmt-compiled)
+ (let ((property (car spec)))
+ ;; Property value is updated only the first time a given
+ ;; property is encountered.
+ (org-columns--compute-spec spec (not (member property seen)))
+ (push property seen)))))
+
+(defun org-columns--summary-sum (values printf)
+ "Compute the sum of VALUES.
+When PRINTF is non-nil, use it to format the result."
+ (format (or printf "%s") (apply #'+ (mapcar #'string-to-number values))))
+
+(defun org-columns--summary-currencies (values _)
+ "Compute the sum of VALUES, with two decimals."
+ (format "%.2f" (apply #'+ (mapcar #'string-to-number values))))
+
+(defun org-columns--summary-checkbox (check-boxes _)
+ "Summarize CHECK-BOXES with a check-box."
+ (let ((done (cl-count "[X]" check-boxes :test #'equal))
+ (all (length check-boxes)))
+ (cond ((= done all) "[X]")
+ ((> done 0) "[-]")
+ (t "[ ]"))))
+
+(defun org-columns--summary-checkbox-count (check-boxes _)
+ "Summarize CHECK-BOXES with a check-box cookie."
+ (format "[%d/%d]"
+ (cl-count "[X]" check-boxes :test #'equal)
+ (length check-boxes)))
+
+(defun org-columns--summary-checkbox-percent (check-boxes _)
+ "Summarize CHECK-BOXES with a check-box percent."
+ (format "[%d%%]"
+ (round (* 100.0 (cl-count "[X]" check-boxes :test #'equal))
+ (float (length check-boxes)))))
+
+(defun org-columns--summary-min (values printf)
+ "Compute the minimum of VALUES.
+When PRINTF is non-nil, use it to format the result."
+ (format (or printf "%s")
+ (apply #'min (mapcar #'string-to-number values))))
+
+(defun org-columns--summary-max (values printf)
+ "Compute the maximum of VALUES.
+When PRINTF is non-nil, use it to format the result."
+ (format (or printf "%s")
+ (apply #'max (mapcar #'string-to-number values))))
+
+(defun org-columns--summary-mean (values printf)
+ "Compute the mean of VALUES.
+When PRINTF is non-nil, use it to format the result."
+ (format (or printf "%s")
+ (/ (apply #'+ (mapcar #'string-to-number values))
+ (float (length values)))))
+
+(defun org-columns--summary-sum-times (times _)
+ "Sum TIMES."
+ (org-columns--summary-apply-times #'+ times))
+
+(defun org-columns--summary-min-time (times _)
+ "Compute the minimum time among TIMES."
+ (org-columns--summary-apply-times #'min times))
+
+(defun org-columns--summary-max-time (times _)
+ "Compute the maximum time among TIMES."
+ (org-columns--summary-apply-times #'max times))
+
+(defun org-columns--summary-mean-time (times _)
+ "Compute the mean time among TIMES."
+ (org-columns--summary-apply-times
+ (lambda (&rest values) (/ (apply #'+ values) (float (length values))))
+ times))
+
+(defun org-columns--summary-min-age (ages _)
+ "Compute the minimum time among AGES."
+ (format-seconds
+ "%dd %.2hh %mm %ss"
+ (apply #'min (mapcar #'org-columns--age-to-seconds ages))))
+
+(defun org-columns--summary-max-age (ages _)
+ "Compute the maximum time among AGES."
+ (format-seconds
+ "%dd %.2hh %mm %ss"
+ (apply #'max (mapcar #'org-columns--age-to-seconds ages))))
+
+(defun org-columns--summary-mean-age (ages _)
+ "Compute the minimum time among AGES."
+ (format-seconds
+ "%dd %.2hh %mm %ss"
+ (/ (apply #'+ (mapcar #'org-columns--age-to-seconds ages))
+ (float (length ages)))))
+
+(defun org-columns--summary-estimate (estimates printf)
+ "Combine a list of estimates, using mean and variance.
+The mean and variance of the result will be the sum of the means
+and variances (respectively) of the individual estimates."
+ (let ((mean 0)
+ (var 0))
+ (dolist (e estimates)
+ (pcase (mapcar #'string-to-number (split-string e "-"))
+ (`(,low ,high)
+ (let ((m (/ (+ low high) 2.0)))
+ (cl-incf mean m)
+ (cl-incf var (- (/ (+ (* low low) (* high high)) 2.0) (* m m)))))
+ (`(,value) (cl-incf mean value))))
+ (let ((sd (sqrt var)))
+ (format "%s-%s"
+ (format (or printf "%.0f") (- mean sd))
+ (format (or printf "%.0f") (+ mean sd))))))
+
+
+
;;; Dynamic block for Column view
-(defun org-columns-capture-view (&optional maxlevel skip-empty-rows)
- "Get the column view of the current buffer or subtree.
-The first optional argument MAXLEVEL sets the level limit.
-A second optional argument SKIP-EMPTY-ROWS tells whether to skip
+(defun org-columns--capture-view (maxlevel skip-empty format local)
+ "Get the column view of the current buffer.
+
+MAXLEVEL sets the level limit. SKIP-EMPTY tells whether to skip
empty rows, an empty row being one where all the column view
-specifiers but ITEM are empty. This function returns a list
-containing the title row and all other rows. Each row is a list
-of fields."
- (save-excursion
- (let* ((title (mapcar #'cadr org-columns-current-fmt-compiled))
- (has-item? (member "ITEM" title))
- (n (length title))
- tbl)
- (goto-char (point-min))
- (while (re-search-forward org-outline-regexp-bol nil t)
- (catch 'next
- (when (and (or (null maxlevel)
- (>= maxlevel (org-reduced-level (org-outline-level))))
- (get-char-property (match-beginning 0) 'org-columns-key))
- (when (or (org-in-commented-heading-p t)
- (member org-archive-tag (org-get-tags)))
- (org-end-of-subtree t)
- (throw 'next t))
- (let (row)
- (dotimes (i n)
- (let ((col (+ (line-beginning-position) i)))
- (push (org-quote-vert
- (or (get-char-property col 'org-columns-value-modified)
- (get-char-property col 'org-columns-value)
- ""))
- row)))
- (unless (and skip-empty-rows
- (let ((r (delete-dups (remove "" row))))
- (or (null r) (and has-item? (= (length r) 1)))))
- (push (nreverse row) tbl))))))
- (append (list title 'hline) (nreverse tbl)))))
+specifiers but ITEM are empty. FORMAT is a format string for
+columns, or nil. When LOCAL is non-nil, only capture headings in
+current subtree.
+
+This function returns a list containing the title row and all
+other rows. Each row is a list of fields, as strings, or
+`hline'."
+ (org-columns (not local) format)
+ (goto-char org-columns-top-level-marker)
+ (let ((columns (length org-columns-current-fmt-compiled))
+ (has-item (assoc "ITEM" org-columns-current-fmt-compiled))
+ table)
+ (org-map-entries
+ (lambda ()
+ (when (get-char-property (point) 'org-columns-key)
+ (let (row)
+ (dotimes (i columns)
+ (let* ((col (+ (line-beginning-position) i))
+ (p (get-char-property col 'org-columns-key)))
+ (push (org-quote-vert
+ (get-char-property col
+ (if (string= p "ITEM")
+ 'org-columns-value
+ 'org-columns-value-modified)))
+ row)))
+ (unless (and skip-empty
+ (let ((r (delete-dups (remove "" row))))
+ (or (null r) (and has-item (= (length r) 1)))))
+ (push (cons (org-reduced-level (org-current-level)) (nreverse row))
+ table)))))
+ (and maxlevel (format "LEVEL<=%d" maxlevel))
+ (and local 'tree)
+ 'archive 'comment)
+ (org-columns-quit)
+ ;; Add column titles and a horizontal rule in front of the table.
+ (cons (mapcar #'cadr org-columns-current-fmt-compiled)
+ (cons 'hline (nreverse table)))))
+
+(defun org-columns--clean-item (item)
+ "Remove sensitive contents from string ITEM.
+This includes objects that may not be duplicated within
+a document, e.g., a target, or those forbidden in tables, e.g.,
+an inline src-block."
+ (let ((data (org-element-parse-secondary-string
+ item (org-element-restriction 'headline))))
+ (org-element-map data
+ '(footnote-reference inline-babel-call inline-src-block target
+ radio-target statistics-cookie)
+ #'org-element-extract-element)
+ (org-no-properties (org-element-interpret-data data))))
;;;###autoload
(defun org-dblock-write:columnview (params)
"Write the column view table.
PARAMS is a property list of parameters:
-:width enforce same column widths with <N> specifiers.
:id the :ID: property of the entry where the columns view
should be built. When the symbol `local', call locally.
When `global' call column view with the cursor at the beginning
@@ -1245,139 +1383,134 @@ PARAMS is a property list of parameters:
using `org-id-find'.
:hlines When t, insert a hline before each item. When a number, insert
a hline before each level <= that number.
+:indent When non-nil, indent each ITEM field according to its level.
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty.
+:width apply widths specified in columns format using <N> specifiers.
:format When non-nil, specify the column view format to use."
- (let ((pos (point-marker))
- (hlines (plist-get params :hlines))
- (vlines (plist-get params :vlines))
- (maxlevel (plist-get params :maxlevel))
- (content-lines (org-split-string (plist-get params :content) "\n"))
- (skip-empty-rows (plist-get params :skip-empty-rows))
- (columns-fmt (plist-get params :format))
- (case-fold-search t)
- tbl id idpos nfields tmp recalc line
- id-as-string view-file view-pos)
- (when (setq id (plist-get params :id))
- (setq id-as-string (cond ((numberp id) (number-to-string id))
- ((symbolp id) (symbol-name id))
- ((stringp id) id)
- (t "")))
- (cond ((not id) nil)
- ((eq id 'global) (setq view-pos (point-min)))
- ((eq id 'local))
- ((string-match "^file:\\(.*\\)" id-as-string)
- (setq view-file (match-string 1 id-as-string)
- view-pos 1)
- (unless (file-exists-p view-file)
- (error "No such file: \"%s\"" id-as-string)))
- ((setq idpos (org-find-entry-with-id id))
- (setq view-pos idpos))
- ((setq idpos (org-id-find id))
- (setq view-file (car idpos))
- (setq view-pos (cdr idpos)))
- (t (error "Cannot find entry with :ID: %s" id))))
- (with-current-buffer (if view-file
- (get-file-buffer view-file)
- (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (or view-pos (point)))
- (org-columns columns-fmt)
- (setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
- (setq nfields (length (car tbl)))
- (org-columns-quit))))
- (goto-char pos)
- (move-marker pos nil)
- (when tbl
- (when (plist-get params :hlines)
- (setq tmp nil)
- (while tbl
- (if (eq (car tbl) 'hline)
- (push (pop tbl) tmp)
- (if (string-match "\\` *\\(\\*+\\)" (caar tbl))
- (if (and (not (eq (car tmp) 'hline))
- (or (eq hlines t)
- (and (numberp hlines)
- (<= (- (match-end 1) (match-beginning 1))
- hlines))))
- (push 'hline tmp)))
- (push (pop tbl) tmp)))
- (setq tbl (nreverse tmp)))
- (when vlines
- (setq tbl (mapcar (lambda (x)
- (if (eq 'hline x) x (cons "" x)))
- tbl))
- (setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
- (when content-lines
- (while (string-match "^#" (car content-lines))
- (insert (pop content-lines) "\n")))
- (setq pos (point))
- (insert (org-listtable-to-string tbl))
+ (let ((table
+ (let ((id (plist-get params :id))
+ view-file view-pos)
+ (pcase id
+ (`global nil)
+ ((or `local `nil) (setq view-pos (point)))
+ ((and (let id-string (format "%s" id))
+ (guard (string-match "^file:\\(.*\\)" id-string)))
+ (setq view-file (match-string-no-properties 1 id-string))
+ (unless (file-exists-p view-file)
+ (user-error "No such file: %S" id-string)))
+ ((and (let idpos (org-find-entry-with-id id)) (guard idpos))
+ (setq view-pos idpos))
+ ((let `(,filename . ,position) (org-id-find id))
+ (setq view-file filename)
+ (setq view-pos position))
+ (_ (user-error "Cannot find entry with :ID: %s" id)))
+ (with-current-buffer (if view-file (get-file-buffer view-file)
+ (current-buffer))
+ (org-with-wide-buffer
+ (when view-pos (goto-char view-pos))
+ (org-columns--capture-view (plist-get params :maxlevel)
+ (plist-get params :skip-empty-rows)
+ (plist-get params :format)
+ view-pos))))))
+ (when table
+ ;; Prune level information from the table. Also normalize
+ ;; headings: remove stars, add indentation entities, if
+ ;; required, and possibly precede some of them with a horizontal
+ ;; rule.
+ (let ((item-index
+ (let ((p (assoc "ITEM" org-columns-current-fmt-compiled)))
+ (and p (cl-position p
+ org-columns-current-fmt-compiled
+ :test #'equal))))
+ (hlines (plist-get params :hlines))
+ (indent (plist-get params :indent))
+ new-table)
+ ;; Copy header and first rule.
+ (push (pop table) new-table)
+ (push (pop table) new-table)
+ (dolist (row table (setq table (nreverse new-table)))
+ (let ((level (car row)))
+ (when (and (not (eq (car new-table) 'hline))
+ (or (eq hlines t)
+ (and (numberp hlines) (<= level hlines))))
+ (push 'hline new-table))
+ (when item-index
+ (let ((item (org-columns--clean-item (nth item-index (cdr row)))))
+ (setf (nth item-index (cdr row))
+ (if (and indent (> level 1))
+ (concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
+ item))))
+ (push (cdr row) new-table))))
(when (plist-get params :width)
- (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
- org-columns-current-widths "|")))
- (while (setq line (pop content-lines))
- (when (string-match "^#" line)
- (insert "\n" line)
- (when (string-match "^[ \t]*#\\+tblfm" line)
- (setq recalc t))))
- (if recalc
- (progn (goto-char pos) (org-table-recalculate 'all))
- (goto-char pos)
+ (setq table
+ (append table
+ (list
+ (mapcar (lambda (spec)
+ (let ((w (nth 2 spec)))
+ (if w (format "<%d>" (max 3 w)) "")))
+ org-columns-current-fmt-compiled)))))
+ (when (plist-get params :vlines)
+ (setq table
+ (let ((size (length org-columns-current-fmt-compiled)))
+ (append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x)))
+ table)
+ (list (cons "/" (make-list size "<>")))))))
+ (let ((content-lines (org-split-string (plist-get params :content) "\n"))
+ recalc)
+ ;; Insert affiliated keywords before the table.
+ (when content-lines
+ (while (string-match-p "\\`[ \t]*#\\+" (car content-lines))
+ (insert (pop content-lines) "\n")))
+ (save-excursion
+ ;; Insert table at point.
+ (insert
+ (mapconcat (lambda (row)
+ (if (eq row 'hline) "|-|"
+ (format "|%s|" (mapconcat #'identity row "|"))))
+ table
+ "\n"))
+ ;; Insert TBLFM lines following table.
+ (let ((case-fold-search t))
+ (dolist (line content-lines)
+ (when (string-match-p "\\`[ \t]*#\\+TBLFM:" line)
+ (insert "\n" line)
+ (unless recalc (setq recalc t))))))
+ (when recalc (org-table-recalculate 'all t))
(org-table-align)))))
-(defun org-listtable-to-string (tbl)
- "Convert a listtable TBL to a string that contains the Org-mode table.
-The table still need to be aligned. The resulting string has no leading
-and tailing newline characters."
- (mapconcat
- (lambda (x)
- (cond
- ((listp x)
- (concat "|" (mapconcat 'identity x "|") "|"))
- ((eq x 'hline) "|-|")
- (t (error "Garbage in listtable: %s" x))))
- tbl "\n"))
-
;;;###autoload
-(defun org-insert-columns-dblock ()
+(defun org-columns-insert-dblock ()
"Create a dynamic block capturing a column view table."
(interactive)
- (let ((defaults '(:name "columnview" :hlines 1))
- (id (org-icompleting-read
+ (let ((id (completing-read
"Capture columns (local, global, entry with :ID: property) [local]: "
(append '(("global") ("local"))
- (mapcar 'list (org-property-values "ID"))))))
- (if (equal id "") (setq id 'local))
- (if (equal id "global") (setq id 'global))
- (setq defaults (append defaults (list :id id)))
- (org-create-dblock defaults)
- (org-update-dblock)))
-
-;;; Column view in the agenda
+ (mapcar #'list (org-property-values "ID"))))))
+ (org-create-dblock
+ (list :name "columnview"
+ :hlines 1
+ :id (cond ((string= id "global") 'global)
+ ((member id '("" "local")) 'local)
+ (id)))))
+ (org-update-dblock))
-(defvar org-agenda-view-columns-initially nil
- "When set, switch to columns view immediately after creating the agenda.")
-(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el
-(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el
-(defvar org-agenda-columns-add-appointments-to-effort-sum); as well
+
+;;; Column view in the agenda
;;;###autoload
(defun org-agenda-columns ()
"Turn on or update column view in the agenda."
(interactive)
- (org-verify-version 'columns)
(org-columns-remove-overlays)
(move-marker org-columns-begin-marker (point))
- (let ((org-columns-time (time-to-number-of-days (current-time)))
+ (let ((org-columns--time (float-time (current-time)))
(fmt
(cond
- ((org-bound-and-true-p org-agenda-overriding-columns-format))
+ ((bound-and-true-p org-agenda-overriding-columns-format))
((let ((m (org-get-at-bol 'org-hd-marker)))
(and m
(or (org-entry-get m "COLUMNS" t)
@@ -1392,7 +1525,7 @@ and tailing newline characters."
(with-current-buffer (marker-buffer m)
org-columns-default-format))))))
(t org-columns-default-format))))
- (org-set-local 'org-columns-current-fmt fmt)
+ (setq-local org-columns-current-fmt fmt)
(org-columns-compile-format fmt)
(when org-agenda-columns-compute-summary-properties
(org-agenda-colview-compute org-columns-current-fmt-compiled))
@@ -1400,204 +1533,111 @@ and tailing newline characters."
;; Collect properties for each headline in current view.
(goto-char (point-min))
(let (cache)
- (let ((names (mapcar #'car org-columns-current-fmt-compiled)) m)
- (while (not (eobp))
- (when (setq m (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker)))
- (push
- (cons
- (line-beginning-position)
- (org-with-point-at m
- (mapcar
- (lambda (name)
- (let ((value (org-columns--value name (point))))
- (cons
- name
- (if (and org-agenda-columns-add-appointments-to-effort-sum
- (not value)
- (eq (compare-strings name nil nil
- org-effort-property nil nil
- t)
- t)
- ;; Effort property is not defined. Try
- ;; to use appointment duration.
- (get-text-property (point) 'duration))
- (org-propertize
- (org-minutes-to-clocksum-string
- (get-text-property (point) 'duration))
- 'face 'org-warning)
- value))))
- names)))
- cache))
- (forward-line)))
+ (while (not (eobp))
+ (let ((m (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker))))
+ (when m
+ (push (cons (line-beginning-position)
+ (org-with-point-at m
+ (org-columns--collect-values 'agenda)))
+ cache)))
+ (forward-line))
(when cache
- (org-set-local 'org-columns-current-maxwidths
- (org-columns-get-autowidth-alist fmt cache))
- (org-columns-display-here-title)
- (when (org-set-local 'org-columns-flyspell-was-active
- (org-bound-and-true-p flyspell-mode))
+ (org-columns--set-widths cache)
+ (org-columns--display-here-title)
+ (when (setq-local org-columns-flyspell-was-active
+ (bound-and-true-p flyspell-mode))
(flyspell-mode 0))
- (dolist (x cache)
- (goto-char (car x))
- (org-columns-display-here (cdr x)))
+ (dolist (entry cache)
+ (goto-char (car entry))
+ (org-columns--display-here (cdr entry)))
(when org-agenda-columns-show-summaries
(org-agenda-colview-summarize cache)))))))
(defun org-agenda-colview-summarize (cache)
"Summarize the summarizable columns in column view in the agenda.
This will add overlays to the date lines, to show the summary for each day."
- (let* ((fmt (mapcar (lambda (x)
- (if (string-match "CLOCKSUM.*" (car x))
- (list (match-string 0 (car x))
- (nth 1 x) (nth 2 x) ":" 'add_times
- nil '+ nil)
- x))
- org-columns-current-fmt-compiled))
- line c c1 stype calc sumfunc props lsum entries prop v title)
- (catch 'exit
- (when (delq nil (mapcar 'cadr fmt))
- ;; OK, at least one summation column, it makes sense to try this
- (goto-char (point-max))
- (while t
- (when (or (get-text-property (point) 'org-date-line)
- (eq (get-text-property (point) 'face)
- 'org-agenda-structure))
- ;; OK, this is a date line that should be used
- (setq line (org-current-line))
- (setq entries nil c cache cache nil)
- (while (setq c1 (pop c))
- (if (> (car c1) line)
- (push c1 entries)
- (push c1 cache)))
- ;; now ENTRIES are the ones we want to use, CACHE is the rest
- ;; Compute the summaries for the properties we want,
- ;; set nil properties for the rest.
- (when (setq entries (mapcar 'cdr entries))
- (setq props
- (mapcar
- (lambda (f)
- (setq prop (car f)
- title (nth 1 f)
- stype (nth 4 f)
- sumfunc (nth 6 f)
- calc (or (nth 7 f) 'identity))
- (cond
- ((equal prop "ITEM")
- (cons prop (buffer-substring (point-at-bol)
- (point-at-eol))))
- ((not stype) (cons prop ""))
- (t ;; do the summary
- (setq lsum nil)
- (dolist (x entries)
- (setq v (cdr (assoc-string prop x t)))
- (if v
- (push
- (funcall
- (if (not (get-text-property 0 'org-computed v))
- calc
- 'identity)
- (org-columns-string-to-number
- v stype))
- lsum)))
- (setq lsum (remove nil lsum))
- (setq lsum
- (cond ((> (length lsum) 1)
- (org-columns-number-to-string
- (apply sumfunc lsum) stype))
- ((eq (length lsum) 1)
- (org-columns-number-to-string
- (car lsum) stype))
- (t "")))
- (put-text-property 0 (length lsum) 'face 'bold lsum)
- (unless (eq calc 'identity)
- (put-text-property 0 (length lsum) 'org-computed t lsum))
- (cons prop lsum))))
- fmt))
- (org-columns-display-here props 'dateline)
- (org-set-local 'org-agenda-columns-active t)))
- (if (bobp) (throw 'exit t))
- (beginning-of-line 0))))))
+ (let ((fmt (mapcar
+ (lambda (spec)
+ (pcase spec
+ (`(,property ,title ,width . ,_)
+ (if (member property '("CLOCKSUM" "CLOCKSUM_T"))
+ (list property title width ":" nil)
+ spec))))
+ org-columns-current-fmt-compiled))
+ entries)
+ ;; Ensure there's at least one summation column.
+ (when (cl-some (lambda (spec) (nth 3 spec)) fmt)
+ (goto-char (point-max))
+ (while (not (bobp))
+ (when (or (get-text-property (point) 'org-date-line)
+ (eq (get-text-property (point) 'face)
+ 'org-agenda-structure))
+ ;; OK, this is a date line that should be used.
+ (let (rest)
+ (dolist (c cache (setq cache rest))
+ (if (> (car c) (point))
+ (push c entries)
+ (push c rest))))
+ ;; Now ENTRIES contains entries below the current one.
+ ;; CACHE is the rest. Compute the summaries for the
+ ;; properties we want, set nil properties for the rest.
+ (when (setq entries (mapcar 'cdr entries))
+ (org-columns--display-here
+ (mapcar
+ (lambda (spec)
+ (pcase spec
+ (`("ITEM" . ,_)
+ ;; Replace ITEM with current date. Preserve
+ ;; properties for fontification.
+ (let ((date (buffer-substring
+ (line-beginning-position)
+ (line-end-position))))
+ (list spec date date)))
+ (`(,_ ,_ ,_ nil ,_) (list spec "" ""))
+ (`(,_ ,_ ,_ ,operator ,printf)
+ (let* ((summarize (org-columns--summarize operator))
+ (values
+ ;; Use real values for summary, not those
+ ;; prepared for display.
+ (delq nil
+ (mapcar
+ (lambda (e)
+ (org-string-nw-p (nth 1 (assoc spec e))))
+ entries)))
+ (final (if values (funcall summarize values printf)
+ "")))
+ (unless (equal final "")
+ (put-text-property 0 (length final) 'face 'bold final))
+ (list spec final final)))))
+ fmt)
+ 'dateline)
+ (setq-local org-agenda-columns-active t)))
+ (forward-line -1)))))
(defun org-agenda-colview-compute (fmt)
"Compute the relevant columns in the contributing source buffers."
(let ((files org-agenda-contributing-files)
(org-columns-begin-marker (make-marker))
- (org-columns-top-level-marker (make-marker))
- f fm a b)
- (while (setq f (pop files))
- (setq b (find-buffer-visiting f))
- (with-current-buffer (or (buffer-base-buffer b) b)
- (save-excursion
- (save-restriction
- (widen)
- (org-with-silent-modifications
- (remove-text-properties (point-min) (point-max) '(org-summaries t)))
- (goto-char (point-min))
- (org-columns-get-format-and-top-level)
- (while (setq fm (pop fmt))
- (cond ((equal (car fm) "CLOCKSUM")
- (org-clock-sum))
- ((equal (car fm) "CLOCKSUM_T")
- (org-clock-sum-today))
- ((and (nth 4 fm)
- (setq a (assoc-string (car fm)
- org-columns-current-fmt-compiled
- t))
- (equal (nth 4 a) (nth 4 fm)))
- (org-columns-compute (car fm)))))))))))
-
-(defun org-format-time-period (interval)
- "Convert time in fractional days to days/hours/minutes/seconds."
- (if (numberp interval)
- (let* ((days (floor interval))
- (frac-hours (* 24 (- interval days)))
- (hours (floor frac-hours))
- (minutes (floor (* 60 (- frac-hours hours))))
- (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
- (format "%dd %02dh %02dm %02ds" days hours minutes seconds))
- ""))
-
-(defun org-estimate-mean-and-var (v)
- "Return the mean and variance of an estimate."
- (let* ((v (cond ((consp v) v)
- ((numberp v) (list v v))
- (t (error "Invalid estimate type"))))
- (low (float (car v)))
- (high (float (cadr v)))
- (mean (/ (+ low high) 2.0))
- (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0)))
- (list mean var)))
-
-(defun org-estimate-combine (&rest el)
- "Combine a list of estimates, using mean and variance.
-The mean and variance of the result will be the sum of the means
-and variances (respectively) of the individual estimates."
- (let ((mean 0)
- (var 0))
- (mapc (lambda (e)
- (let ((stats (org-estimate-mean-and-var e)))
- (setq mean (+ mean (car stats)))
- (setq var (+ var (cadr stats)))))
- el)
- (let ((stdev (sqrt var)))
- (list (- mean stdev) (+ mean stdev)))))
-
-(defun org-estimate-print (e &optional fmt)
- "Prepare a string representation of an estimate.
-This formats these numbers as two numbers with a \"-\" between them."
- (let ((fmt (or fmt "%.0f"))
- (e (cond ((consp e) e)
- ((numberp e) (list e e))
- (t (error "Invalid estimate type")))))
- (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-"))))
-
-(defun org-string-to-estimate (s)
- "Convert a string to an estimate.
-The string should be two numbers joined with a \"-\"."
- (if (string-match "\\(.*\\)-\\(.*\\)" s)
- (list (string-to-number (match-string 1 s))
- (string-to-number(match-string 2 s)))
- (list (string-to-number s) (string-to-number s))))
+ (org-columns-top-level-marker (make-marker)))
+ (dolist (f files)
+ (let ((b (find-buffer-visiting f)))
+ (with-current-buffer (or (buffer-base-buffer b) b)
+ (org-with-wide-buffer
+ (org-with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(org-summaries t)))
+ (goto-char (point-min))
+ (org-columns-get-format-and-top-level)
+ (dolist (spec fmt)
+ (let ((prop (car spec)))
+ (cond
+ ((equal prop "CLOCKSUM") (org-clock-sum))
+ ((equal prop "CLOCKSUM_T") (org-clock-sum-today))
+ ((and (nth 3 spec)
+ (let ((a (assoc prop org-columns-current-fmt-compiled)))
+ (equal (nth 3 a) (nth 3 spec))))
+ (org-columns-compute prop)))))))))))
+
(provide 'org-colview)
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 70e4573..202b728 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -1,4 +1,4 @@
-;;; org-compat.el --- Compatibility code for Org-mode
+;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -24,62 +24,278 @@
;;
;;; Commentary:
-;; This file contains code needed for compatibility with XEmacs and older
+;; This file contains code needed for compatibility with older
;; versions of GNU Emacs.
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(require 'cl-lib)
(require 'org-macs)
-(declare-function w32-focus-frame "term/w32-win" (frame))
+(declare-function org-at-table.el-p "org" (&optional table-type))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-type "org-element" (element))
+(declare-function org-link-set-parameters "org" (type &rest rest))
+(declare-function org-table-end (&optional table-type))
+(declare-function table--at-cell-p "table" (position &optional object at-column))
+
+(defvar org-table-any-border-regexp)
+(defvar org-table-dataline-regexp)
+(defvar org-table-tab-recognizes-table.el)
+(defvar org-table1-hline-regexp)
+
+;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-'
+;; prefix, `find-tag' is replaced with `xref-find-definition' and
+;; `x-get-selection' with `gui-get-selection'.
+(when (< emacs-major-version 25)
+ (defalias 'outline-hide-entry 'hide-entry)
+ (defalias 'outline-hide-sublevels 'hide-sublevels)
+ (defalias 'outline-hide-subtree 'hide-subtree)
+ (defalias 'outline-show-all 'show-all)
+ (defalias 'outline-show-branches 'show-branches)
+ (defalias 'outline-show-children 'show-children)
+ (defalias 'outline-show-entry 'show-entry)
+ (defalias 'outline-show-subtree 'show-subtree)
+ (defalias 'xref-find-definitions 'find-tag)
+ (defalias 'format-message 'format)
+ (defalias 'gui-get-selection 'x-get-selection))
+
+
+;;; Obsolete aliases (remove them once the next major release is released).
-;; The following constant is for backward compatibility. We do not use
-;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs)
-;; at compilation time and can therefore optimize code better.
-(defconst org-xemacs-p (featurep 'xemacs))
+;;;; XEmacs compatibility, now removed.
+(define-obsolete-function-alias 'org-activate-mark 'activate-mark)
+(define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0")
+(define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0")
+(define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0")
+(define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0")
+(define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0")
+(define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0")
+(define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0")
+(define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0")
+(define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0")
+(define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0")
+(define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0")
+(define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0")
+(define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0")
+(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0")
+
+(defmacro org-re (s)
+ "Replace posix classes in regular expression S."
+ (declare (debug (form))
+ (obsolete "you can safely remove it." "Org 9.0"))
+ s)
+
+;;;; Functions from cl-lib that Org used to have its own implementation of.
+(define-obsolete-function-alias 'org-count 'cl-count "Org 9.0")
+(define-obsolete-function-alias 'org-every 'cl-every "Org 9.0")
+(define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0")
+(define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0")
+(define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0")
+(define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0")
+(define-obsolete-function-alias 'org-some 'cl-some "Org 9.0")
+(define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0")
+
+(defun org-sublist (list start end)
+ "Return a section of LIST, from START to END.
+Counting starts at 1."
+ (cl-subseq list (1- start) end))
+(make-obsolete 'org-sublist
+ "use cl-subseq (note the 0-based counting)."
+ "Org 9.0")
+
+
+;;;; Functions available since Emacs 24.3
+(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0")
+(define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0")
+(define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0")
+(define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0")
+(define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0")
+(define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0")
+(define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0")
+(define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0")
+(define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0")
+(define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0")
+
+;;;; Functions and variables from previous releases now obsolete.
+(define-obsolete-function-alias 'org-element-remove-indentation
+ 'org-remove-indentation "Org 9.0")
+(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
+ 'org-checkbox-hierarchical-statistics "Org 8.0")
+(define-obsolete-variable-alias 'org-description-max-indent
+ 'org-list-description-max-indent "Org 8.0")
+(define-obsolete-variable-alias 'org-latex-create-formula-image-program
+ 'org-preview-latex-default-process "Org 9.0")
+(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
+ 'org-preview-latex-image-directory "Org 9.0")
+(define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0")
+(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0")
+(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3")
+(define-obsolete-function-alias 'org-speed-command-default-hook
+ 'org-speed-command-activate "Org 8.0")
+(define-obsolete-function-alias 'org-babel-speed-command-hook
+ 'org-babel-speed-command-activate "Org 8.0")
+(define-obsolete-function-alias 'org-image-file-name-regexp
+ 'image-file-name-regexp "Org 9.0")
+(define-obsolete-function-alias 'org-get-legal-level
+ 'org-get-valid-level "Org 7.8")
+(define-obsolete-function-alias 'org-completing-read-no-i
+ 'completing-read "Org 9.0")
+(define-obsolete-function-alias 'org-icompleting-read
+ 'completing-read "Org 9.0")
+(define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0")
+(define-obsolete-function-alias 'org-days-to-time
+ 'org-time-stamp-to-now "Org 8.2")
+(define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties
+ 'org-agenda-ignore-properties "Org 9.0")
+(define-obsolete-function-alias 'org-preview-latex-fragment
+ 'org-toggle-latex-fragment "Org 8.3")
+(define-obsolete-function-alias 'org-display-inline-modification-hook
+ 'org-display-inline-remove-overlay "Org 8.0")
+(define-obsolete-function-alias 'org-export-get-genealogy
+ 'org-element-lineage "Org 9.0")
+(define-obsolete-variable-alias 'org-latex-with-hyperref
+ 'org-latex-hyperref-template "Org 9.0")
+(define-obsolete-variable-alias 'org-link-to-org-use-id
+ 'org-id-link-to-org-use-id "Org 8.0")
+(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0")
+(define-obsolete-variable-alias 'org-clock-modeline-total
+ 'org-clock-mode-line-total "Org 8.0")
+(define-obsolete-function-alias 'org-protocol-unhex-compound
+ 'org-link-unescape-compound "Org 7.8")
+(define-obsolete-function-alias 'org-protocol-unhex-string
+ 'org-link-unescape "Org 7.8")
+(define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence
+ 'org-link-unescape-single-byte-sequence "Org 7.8")
+(define-obsolete-variable-alias 'org-export-htmlized-org-css-url
+ 'org-org-htmlized-css-url "Org 8.2")
+(define-obsolete-variable-alias 'org-alphabetical-lists
+ 'org-list-allow-alphabetical "Org 8.0")
+(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0")
+(define-obsolete-variable-alias 'org-agenda-menu-two-column
+ 'org-agenda-menu-two-columns "Org 8.0")
+(define-obsolete-variable-alias 'org-finalize-agenda-hook
+ 'org-agenda-finalize-hook "Org 8.0")
+(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "Org 7.8")
+(define-obsolete-function-alias 'org-agenda-post-command-hook
+ 'org-agenda-update-agenda-type "Org 8.0")
+(define-obsolete-function-alias 'org-agenda-todayp
+ 'org-agenda-today-p "Org 9.0")
+(define-obsolete-function-alias 'org-babel-examplize-region
+ 'org-babel-examplify-region "Org 9.0")
+(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0")
+(define-obsolete-variable-alias 'org-html-style-include-scripts
+ 'org-html-head-include-scripts "Org 8.0")
+(define-obsolete-variable-alias 'org-html-style-include-default
+ 'org-html-head-include-default-style "Org 8.0")
+(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
+(define-obsolete-function-alias 'org-insert-columns-dblock
+ 'org-columns-insert-dblock "Org 9.0")
+
+(defun org-in-fixed-width-region-p ()
+ "Non-nil if point in a fixed-width region."
+ (save-match-data
+ (eq 'fixed-width (org-element-type (org-element-at-point)))))
+(make-obsolete 'org-in-fixed-width-region-p
+ "use `org-element' library"
+ "Org 9.0")
+
+(defcustom org-read-date-minibuffer-setup-hook nil
+ "Hook to be used to set up keys for the date/time interface.
+Add key definitions to `minibuffer-local-map', which will be a
+temporary copy."
+ :group 'org-time
+ :type 'hook)
+(make-obsolete-variable
+ 'org-read-date-minibuffer-setup-hook
+ "set `org-read-date-minibuffer-local-map' instead." "Org 8.0")
(defun org-compatible-face (inherits specs)
"Make a compatible face specification.
-If INHERITS is an existing face and if the Emacs version supports it,
-just inherit the face. If INHERITS is set and the Emacs version does
-not support it, copy the face specification from the inheritance face.
-If INHERITS is not given and SPECS is, use SPECS to define the face.
-XEmacs and Emacs 21 do not know about the `min-colors' attribute.
-For them we convert a (min-colors 8) entry to a `tty' entry and move it
-to the top of the list. The `min-colors' attribute will be removed from
-any other entries, and any resulting duplicates will be removed entirely."
- (when (and inherits (facep inherits) (not specs))
- (setq specs (or specs
- (get inherits 'saved-face)
- (get inherits 'face-defface-spec))))
- (cond
- ((and inherits (facep inherits)
- (not (featurep 'xemacs))
- (>= emacs-major-version 22)
- ;; do not inherit outline faces before Emacs 23
- (or (>= emacs-major-version 23)
- (not (string-match "\\`outline-[0-9]+"
- (symbol-name inherits)))))
- (list (list t :inherit inherits)))
- ((or (featurep 'xemacs) (< emacs-major-version 22))
- ;; These do not understand the `min-colors' attribute.
- (let (r e a)
- (while (setq e (pop specs))
- (cond
- ((memq (car e) '(t default)) (push e r))
- ((setq a (member '(min-colors 8) (car e)))
- (nconc r (list (cons (cons '(type tty) (delq (car a) (car e)))
- (cdr e)))))
- ((setq a (assq 'min-colors (car e)))
- (setq e (cons (delq a (car e)) (cdr e)))
- (or (assoc (car e) r) (push e r)))
- (t (or (assoc (car e) r) (push e r)))))
- (nreverse r)))
- (t specs)))
-(put 'org-compatible-face 'lisp-indent-function 1)
+If INHERITS is an existing face and if the Emacs version supports
+it, just inherit the face. If INHERITS is not given and SPECS
+is, use SPECS to define the face."
+ (declare (indent 1))
+ (if (facep inherits)
+ (list (list t :inherit inherits))
+ specs))
+(make-obsolete 'org-compatible-face "you can remove it." "Org 9.0")
+
+(defun org-add-link-type (type &optional follow export)
+ "Add a new TYPE link.
+FOLLOW and EXPORT are two functions.
+
+FOLLOW should take the link path as the single argument and do whatever
+is necessary to follow the link, for example find a file or display
+a mail message.
+
+EXPORT should format the link path for export to one of the export formats.
+It should be a function accepting three arguments:
+
+ path the path of the link, the text after the prefix (like \"http:\")
+ desc the description of the link, if any
+ format the export format, a symbol like `html' or `latex' or `ascii'.
+
+The function may use the FORMAT information to return different values
+depending on the format. The return value will be put literally into
+the exported file. If the return value is nil, this means Org should
+do what it normally does with links which do not have EXPORT defined.
+
+Org mode has a built-in default for exporting links. If you are happy with
+this default, there is no need to define an export function for the link
+type. For a simple example of an export function, see `org-bbdb.el'.
+
+If TYPE already exists, update it with the arguments.
+See `org-link-parameters' for documentation on the other parameters."
+ (org-link-set-parameters type :follow follow :export export)
+ (message "Created %s link." type))
+
+(make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0")
+
+(defun org-table-recognize-table.el ()
+ "If there is a table.el table nearby, recognize it and move into it."
+ (when (and org-table-tab-recognizes-table.el (org-at-table.el-p))
+ (beginning-of-line)
+ (unless (or (looking-at org-table-dataline-regexp)
+ (not (looking-at org-table1-hline-regexp)))
+ (forward-line)
+ (when (looking-at org-table-any-border-regexp)
+ (forward-line -2)))
+ (if (re-search-forward "|" (org-table-end t) t)
+ (progn
+ (require 'table)
+ (if (table--at-cell-p (point)) t
+ (message "recognizing table.el table...")
+ (table-recognize-table)
+ (message "recognizing table.el table...done")))
+ (error "This should not happen"))))
+
+;; Not used by Org core since commit 6d1e3082, Feb 2010.
+(make-obsolete 'org-table-recognize-table.el
+ "please notify the org mailing list if you use this function."
+ "Org 9.0")
+
+(define-obsolete-function-alias
+ 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string "Org 8.0")
+
+(defun org-remove-angle-brackets (s)
+ (org-unbracket-string "<" ">" s))
+(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0")
+
+(defun org-remove-double-quotes (s)
+ (org-unbracket-string "\"" "\"" s))
+(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0")
+
+;;;; Obsolete link types
+
+(eval-after-load 'org
+ '(progn
+ (org-link-set-parameters "file+emacs") ;since Org 9.0
+ (org-link-set-parameters "file+sys"))) ;since Org 9.0
+
+
+
+;;; Miscellaneous functions
(defun org-version-check (version feature level)
(let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
@@ -105,110 +321,19 @@ any other entries, and any resulting duplicates will be removed entirely."
t))
t)))
-
-;;;; Emacs/XEmacs compatibility
-
-(eval-and-compile
- (defun org-defvaralias (new-alias base-variable &optional docstring)
- "Compatibility function for defvaralias.
-Don't do the aliasing when `defvaralias' is not bound."
- (declare (indent 1))
- (when (fboundp 'defvaralias)
- (defvaralias new-alias base-variable docstring)))
-
- (when (and (not (boundp 'user-emacs-directory))
- (boundp 'user-init-directory))
- (org-defvaralias 'user-emacs-directory 'user-init-directory)))
-
-(when (featurep 'xemacs)
- (defadvice custom-handle-keyword
- (around org-custom-handle-keyword
- activate preactivate)
- "Remove custom keywords not recognized to avoid producing an error."
- (cond
- ((eq (ad-get-arg 1) :package-version))
- (t ad-do-it)))
- (defadvice define-obsolete-variable-alias
- (around org-define-obsolete-variable-alias
- (obsolete-name current-name &optional when docstring)
- activate preactivate)
- "Declare arguments defined in later versions of Emacs."
- ad-do-it)
- (defadvice define-obsolete-function-alias
- (around org-define-obsolete-function-alias
- (obsolete-name current-name &optional when docstring)
- activate preactivate)
- "Declare arguments defined in later versions of Emacs."
- ad-do-it)
- (defvar customize-package-emacs-version-alist nil)
- (defvar temporary-file-directory (temp-directory)))
-
-;; Keys
-(defconst org-xemacs-key-equivalents
- '(([mouse-1] . [button1])
- ([mouse-2] . [button2])
- ([mouse-3] . [button3])
- ([C-mouse-4] . [(control mouse-4)])
- ([C-mouse-5] . [(control mouse-5)]))
- "Translation alist for a couple of keys.")
-
-;; Overlay compatibility functions
-(defun org-detach-overlay (ovl)
- (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl)))
-(defun org-overlay-display (ovl text &optional face evap)
- "Make overlay OVL display TEXT with face FACE."
- (if (featurep 'xemacs)
- (let ((gl (make-glyph text)))
- (and face (set-glyph-face gl face))
- (set-extent-property ovl 'invisible t)
- (set-extent-property ovl 'end-glyph gl))
- (overlay-put ovl 'display text)
- (if face (overlay-put ovl 'face face))
- (if evap (overlay-put ovl 'evaporate t))))
-(defun org-overlay-before-string (ovl text &optional face evap)
- "Make overlay OVL display TEXT with face FACE."
- (if (featurep 'xemacs)
- (let ((gl (make-glyph text)))
- (and face (set-glyph-face gl face))
- (set-extent-property ovl 'begin-glyph gl))
- (if face (org-add-props text nil 'face face))
- (overlay-put ovl 'before-string text)
- (if evap (overlay-put ovl 'evaporate t))))
-(defun org-find-overlays (prop &optional pos delete)
- "Find all overlays specifying PROP at POS or point.
-If DELETE is non-nil, delete all those overlays."
- (let ((overlays (overlays-at (or pos (point))))
- ov found)
- (while (setq ov (pop overlays))
- (if (overlay-get ov prop)
- (if delete (delete-overlay ov) (push ov found))))
- found))
-
(defun org-get-x-clipboard (value)
- "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21."
- (cond ((eq window-system 'x)
- (let ((x (org-get-x-clipboard-compat value)))
- (if x (org-no-properties x))))
+ "Get the value of the X or Windows clipboard."
+ (cond ((and (eq window-system 'x)
+ (fboundp 'gui-get-selection)) ;Silence byte-compiler.
+ (org-no-properties
+ (ignore-errors
+ (or (gui-get-selection value 'UTF8_STRING)
+ (gui-get-selection value 'COMPOUND_TEXT)
+ (gui-get-selection value 'STRING)
+ (gui-get-selection value 'TEXT)))))
((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
(w32-get-clipboard-data))))
-(defsubst org-decompose-region (beg end)
- "Decompose from BEG to END."
- (if (featurep 'xemacs)
- (let ((modified-p (buffer-modified-p))
- (buffer-read-only nil))
- (remove-text-properties beg end '(composition nil))
- (set-buffer-modified-p modified-p))
- (decompose-region beg end)))
-
-;; Miscellaneous functions
-
-(defun org-add-hook (hook function &optional append local)
- "Add-hook, compatible with both Emacsen."
- (if (and local (featurep 'xemacs))
- (add-local-hook hook function append)
- (add-hook hook function append local)))
-
(defun org-add-props (string plist &rest props)
"Add text properties to entire string, from beginning to end.
PLIST may be a list of properties, PROPS are individual properties and values
@@ -235,57 +360,29 @@ ignored in this case."
(shrink-window-if-larger-than-buffer window)))
(or window (selected-window)))
-(defun org-number-sequence (from &optional to inc)
- "Call `number-sequence' or emulate it."
- (if (fboundp 'number-sequence)
- (number-sequence from to inc)
- (if (or (not to) (= from to))
- (list from)
- (or inc (setq inc 1))
- (when (zerop inc) (error "The increment can not be zero"))
- (let (seq (n 0) (next from))
- (if (> inc 0)
- (while (<= next to)
- (setq seq (cons next seq)
- n (1+ n)
- next (+ from (* n inc))))
- (while (>= next to)
- (setq seq (cons next seq)
- n (1+ n)
- next (+ from (* n inc)))))
- (nreverse seq)))))
-
;; `set-transient-map' is only in Emacs >= 24.4
(defalias 'org-set-transient-map
(if (fboundp 'set-transient-map)
'set-transient-map
'set-temporary-overlay-map))
-;; Region compatibility
+;;; Region compatibility
(defvar org-ignore-region nil
"Non-nil means temporarily disable the active region.")
(defun org-region-active-p ()
- "Is `transient-mark-mode' on and the region active?
-Works on both Emacs and XEmacs."
- (if org-ignore-region
- nil
- (if (featurep 'xemacs)
- (and zmacs-regions (region-active-p))
- (if (fboundp 'use-region-p)
- (use-region-p)
- (and transient-mark-mode mark-active))))) ; Emacs 22 and before
+ "Non-nil when the region active.
+Unlike to `use-region-p', this function also checks
+`org-ignore-region'."
+ (and (not org-ignore-region) (use-region-p)))
(defun org-cursor-to-region-beginning ()
(when (and (org-region-active-p)
(> (point) (region-beginning)))
(exchange-point-and-mark)))
-;; Old alias for emacs 22 compatibility, now dropped
-(define-obsolete-function-alias 'org-activate-mark 'activate-mark)
-
-;; Invisibility compatibility
+;;; Invisibility compatibility
(defun org-remove-from-invisibility-spec (arg)
"Remove elements from `buffer-invisibility-spec'."
@@ -300,65 +397,14 @@ Works on both Emacs and XEmacs."
(if (consp buffer-invisibility-spec)
(member arg buffer-invisibility-spec)))
-(defmacro org-xemacs-without-invisibility (&rest body)
- "Turn off extents with invisibility while executing BODY."
- `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol)
- 'all-extents-closed-open 'invisible))
- ext-inv-specs)
- (dolist (ext ext-inv)
- (when (extent-property ext 'invisible)
- (add-to-list 'ext-inv-specs (list ext (extent-property
- ext 'invisible)))
- (set-extent-property ext 'invisible nil)))
- ,@body
- (dolist (ext-inv-spec ext-inv-specs)
- (set-extent-property (car ext-inv-spec) 'invisible
- (cadr ext-inv-spec)))))
-(def-edebug-spec org-xemacs-without-invisibility (body))
-
-(defun org-indent-to-column (column &optional minimum buffer)
- "Work around a bug with extents with invisibility in XEmacs."
- (if (featurep 'xemacs)
- (org-xemacs-without-invisibility (indent-to-column column minimum buffer))
- (indent-to-column column minimum)))
-
-(defun org-indent-line-to (column)
- "Work around a bug with extents with invisibility in XEmacs."
- (if (featurep 'xemacs)
- (org-xemacs-without-invisibility (indent-line-to column))
- (indent-line-to column)))
-
-(defun org-move-to-column (column &optional force buffer)
+(defun org-move-to-column (column &optional force _buffer)
"Move to column COLUMN.
-Pass COLUMN and FORCE to `move-to-column'.
-Pass BUFFER to the XEmacs version of `move-to-column'."
+Pass COLUMN and FORCE to `move-to-column'."
(let ((buffer-invisibility-spec
(if (listp buffer-invisibility-spec)
(remove '(org-filtered) buffer-invisibility-spec)
buffer-invisibility-spec)))
- (if (featurep 'xemacs)
- (org-xemacs-without-invisibility
- (move-to-column column force buffer))
- (move-to-column column force))))
-
-(defun org-get-x-clipboard-compat (value)
- "Get the clipboard value on XEmacs or Emacs 21."
- (cond ((featurep 'xemacs)
- (org-no-warnings (get-selection-no-error value)))
- ((fboundp 'x-get-selection)
- (condition-case nil
- (or (x-get-selection value 'UTF8_STRING)
- (x-get-selection value 'COMPOUND_TEXT)
- (x-get-selection value 'STRING)
- (x-get-selection value 'TEXT))
- (error nil)))))
-
-(defun org-propertize (string &rest properties)
- (if (featurep 'xemacs)
- (progn
- (add-text-properties 0 (length string) properties string)
- string)
- (apply 'propertize string properties)))
+ (move-to-column column force)))
(defmacro org-find-library-dir (library)
`(file-name-directory (or (locate-library ,library) "")))
@@ -377,44 +423,12 @@ Pass BUFFER to the XEmacs version of `move-to-column'."
string)
(apply 'kill-new string args))
-(defun org-select-frame-set-input-focus (frame)
- "Select FRAME, raise it, and set input focus, if possible."
- (cond ((featurep 'xemacs)
- (if (fboundp 'select-frame-set-input-focus)
- (select-frame-set-input-focus frame)
- (raise-frame frame)
- (select-frame frame)
- (focus-frame frame)))
- ;; `select-frame-set-input-focus' defined in Emacs 21 will not
- ;; set the input focus.
- ((>= emacs-major-version 22)
- (select-frame-set-input-focus frame))
- (t
- (raise-frame frame)
- (select-frame frame)
- (cond ((memq window-system '(x ns mac))
- (x-focus-frame frame))
- ((eq window-system 'w32)
- (w32-focus-frame frame)))
- (when focus-follows-mouse
- (set-mouse-position frame (1- (frame-width frame)) 0)))))
-
-(defalias 'org-float-time
- (if (featurep 'xemacs) 'time-to-seconds 'float-time))
-
-;; `user-error' is only available from 24.2.50 on
-(unless (fboundp 'user-error)
- (defalias 'user-error 'error))
-
-;; ‘format-message’ is available only from 25 on
-(unless (fboundp 'format-message)
- (defalias 'format-message 'format))
-
;; `font-lock-ensure' is only available from 24.4.50 on
(defalias 'org-font-lock-ensure
(if (fboundp 'font-lock-ensure)
#'font-lock-ensure
- (lambda (&optional _beg _end) (font-lock-fontify-buffer))))
+ (lambda (&optional _beg _end)
+ (with-no-warnings (font-lock-fontify-buffer)))))
(defmacro org-no-popups (&rest body)
"Suppress popup windows.
@@ -426,88 +440,6 @@ effect, which variables to use depends on the Emacs version."
`(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
,@body)))
-(if (fboundp 'string-match-p)
- (defalias 'org-string-match-p 'string-match-p)
- (defun org-string-match-p (regexp string &optional start)
- (save-match-data
- (funcall 'string-match regexp string start))))
-
-(if (fboundp 'looking-at-p)
- (defalias 'org-looking-at-p 'looking-at-p)
- (defun org-looking-at-p (&rest args)
- (save-match-data
- (apply 'looking-at args))))
-
-;; XEmacs does not have `looking-back'.
-(if (fboundp 'looking-back)
- (defalias 'org-looking-back 'looking-back)
- (defun org-looking-back (regexp &optional limit greedy)
- "Return non-nil if text before point matches regular expression REGEXP.
-Like `looking-at' except matches before point, and is slower.
-LIMIT if non-nil speeds up the search by specifying a minimum
-starting position, to avoid checking matches that would start
-before LIMIT.
-
-If GREEDY is non-nil, extend the match backwards as far as
-possible, stopping when a single additional previous character
-cannot be part of a match for REGEXP. When the match is
-extended, its starting position is allowed to occur before
-LIMIT."
- (let ((start (point))
- (pos
- (save-excursion
- (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
- (point)))))
- (if (and greedy pos)
- (save-restriction
- (narrow-to-region (point-min) start)
- (while (and (> pos (point-min))
- (save-excursion
- (goto-char pos)
- (backward-char 1)
- (looking-at (concat "\\(?:" regexp "\\)\\'"))))
- (setq pos (1- pos)))
- (save-excursion
- (goto-char pos)
- (looking-at (concat "\\(?:" regexp "\\)\\'")))))
- (not (null pos)))))
-
-(defun org-floor* (x &optional y)
- "Return a list of the floor of X and the fractional part of X.
-With two arguments, return floor and remainder of their quotient."
- (let ((q (floor x y)))
- (list q (- x (if y (* y q) q)))))
-
-;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1.
-(defun org-pop-to-buffer-same-window
- (&optional buffer-or-name norecord label)
- "Pop to buffer specified by BUFFER-OR-NAME in the selected window."
- (if (fboundp 'pop-to-buffer-same-window)
- (funcall
- 'pop-to-buffer-same-window buffer-or-name norecord)
- (funcall 'switch-to-buffer buffer-or-name norecord)))
-
-;; RECURSIVE has been introduced with Emacs 23.2.
-;; This is copying and adapted from `tramp-compat-delete-directory'
-(defun org-delete-directory (directory &optional recursive)
- "Compatibility function for `delete-directory'."
- (if (null recursive)
- (delete-directory directory)
- (condition-case nil
- (funcall 'delete-directory directory recursive)
- ;; This Emacs version does not support the RECURSIVE flag. We
- ;; use the implementation from Emacs 23.2.
- (wrong-number-of-arguments
- (setq directory (directory-file-name (expand-file-name directory)))
- (if (not (file-symlink-p directory))
- (mapc (lambda (file)
- (if (eq t (car (file-attributes file)))
- (org-delete-directory file recursive)
- (delete-file file)))
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
- (delete-directory directory)))))
-
;;;###autoload
(defmacro org-check-version ()
"Try very hard to provide sensible version strings."
@@ -526,41 +458,33 @@ With two arguments, return floor and remainder of their quotient."
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
-(defun org-file-equal-p (f1 f2)
- "Return t if files F1 and F2 are the same.
-Implements `file-equal-p' for older emacsen and XEmacs."
- (if (fboundp 'file-equal-p)
- (file-equal-p f1 f2)
- (let (f1-attr f2-attr)
- (and (setq f1-attr (file-attributes (file-truename f1)))
- (setq f2-attr (file-attributes (file-truename f2)))
- (equal f1-attr f2-attr)))))
-
-;; `buffer-narrowed-p' is available for Emacs >=24.3
-(defun org-buffer-narrowed-p ()
- "Compatibility function for `buffer-narrowed-p'."
- (if (fboundp 'buffer-narrowed-p)
- (buffer-narrowed-p)
- (/= (- (point-max) (point-min)) (buffer-size))))
-
-;; As of Emacs 25.1, `outline-mode` functions are under the 'outline-'
-;; prefix.
-(when (< emacs-major-version 25)
- (defalias 'outline-show-all 'show-all)
- (defalias 'outline-hide-subtree 'hide-subtree)
- (defalias 'outline-show-subtree 'show-subtree)
- (defalias 'outline-show-branches 'show-branches)
- (defalias 'outline-show-children 'show-children)
- (defalias 'outline-show-entry 'show-entry)
- (defalias 'outline-hide-entry 'hide-entry)
- (defalias 'outline-hide-sublevels 'hide-sublevels))
-
(defmacro org-with-silent-modifications (&rest body)
(if (fboundp 'with-silent-modifications)
`(with-silent-modifications ,@body)
`(org-unmodified ,@body)))
(def-edebug-spec org-with-silent-modifications (body))
+;; Functions for Emacs < 24.4 compatibility
+(defun org-define-error (name message)
+ "Define NAME as a new error signal.
+MESSAGE is a string that will be output to the echo area if such
+an error is signaled without being caught by a `condition-case'.
+Implements `define-error' for older emacsen."
+ (if (fboundp 'define-error) (define-error name message)
+ (put name 'error-conditions
+ (copy-sequence (cons name (get 'error 'error-conditions))))))
+
+(unless (fboundp 'string-suffix-p)
+ ;; From Emacs subr.el.
+ (defun string-suffix-p (suffix string &optional ignore-case)
+ "Return non-nil if SUFFIX is a suffix of STRING.
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences."
+ (let ((start-pos (- (length string) (length suffix))))
+ (and (>= start-pos 0)
+ (eq t (compare-strings suffix nil nil
+ string start-pos nil ignore-case))))))
+
(provide 'org-compat)
;;; org-compat.el ends here
diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el
index d41e80a..1039996 100644
--- a/lisp/org-crypt.el
+++ b/lisp/org-crypt.el
@@ -1,5 +1,4 @@
-;;; org-crypt.el --- Public key encryption for org-mode entries
-
+;;; org-crypt.el --- Public Key Encryption for Org Entries -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
@@ -7,7 +6,7 @@
;; Keywords: org-mode
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Peter Jones <pjones@pmade.com>
-;; Description: Adds public key encryption to org-mode buffers
+;; Description: Adds public key encryption to Org buffers
;; URL: http://www.newartisans.com/software/emacs.html
;; Compatibility: Emacs22
@@ -142,7 +141,7 @@ See `org-crypt-disable-auto-save'."
(message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
((eq org-crypt-disable-auto-save 'encrypt)
(message "org-decrypt: Enabling re-encryption on auto-save.")
- (org-add-hook 'auto-save-hook
+ (add-hook 'auto-save-hook
(lambda ()
(message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
(org-encrypt-entries))
@@ -164,96 +163,92 @@ See `org-crypt-disable-auto-save'."
(if (and (string= crypt-key (get-text-property 0 'org-crypt-key str))
(string= (sha1 str) (get-text-property 0 'org-crypt-checksum str)))
(get-text-property 0 'org-crypt-text str)
- (set (make-local-variable 'epg-context) (epg-make-context nil t t))
+ (setq-local epg-context (epg-make-context nil t t))
(epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key))))
(defun org-encrypt-entry ()
"Encrypt the content of the current headline."
(interactive)
(require 'epg)
- (save-excursion
- (org-back-to-heading t)
- (set (make-local-variable 'epg-context) (epg-make-context nil t t))
- (let ((start-heading (point)))
- (forward-line)
- (when (not (looking-at "-----BEGIN PGP MESSAGE-----"))
- (let ((folded (outline-invisible-p))
- (crypt-key (org-crypt-key-for-heading))
- (beg (point))
- end encrypted-text)
- (goto-char start-heading)
- (org-end-of-subtree t t)
- (org-back-over-empty-lines)
- (setq end (point)
- encrypted-text
- (org-encrypt-string (buffer-substring beg end) crypt-key))
- (delete-region beg end)
- (insert encrypted-text)
- (when folded
- (goto-char start-heading)
- (outline-hide-subtree))
- nil)))))
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (setq-local epg-context (epg-make-context nil t t))
+ (let ((start-heading (point)))
+ (org-end-of-meta-data)
+ (unless (looking-at-p "-----BEGIN PGP MESSAGE-----")
+ (let ((folded (outline-invisible-p))
+ (crypt-key (org-crypt-key-for-heading))
+ (beg (point)))
+ (goto-char start-heading)
+ (org-end-of-subtree t t)
+ (org-back-over-empty-lines)
+ (let ((contents (delete-and-extract-region beg (point))))
+ (insert (org-encrypt-string contents crypt-key)))
+ (when folded
+ (goto-char start-heading)
+ (outline-hide-subtree))
+ nil)))))
(defun org-decrypt-entry ()
"Decrypt the content of the current headline."
(interactive)
(require 'epg)
(unless (org-before-first-heading-p)
- (save-excursion
- (org-back-to-heading t)
- (let ((heading-point (point))
- (heading-was-invisible-p
- (save-excursion
- (outline-end-of-heading)
- (outline-invisible-p))))
- (forward-line)
- (when (looking-at "-----BEGIN PGP MESSAGE-----")
- (org-crypt-check-auto-save)
- (set (make-local-variable 'epg-context) (epg-make-context nil t t))
- (let* ((end (save-excursion
- (search-forward "-----END PGP MESSAGE-----")
- (forward-line)
- (point)))
- (encrypted-text (buffer-substring-no-properties (point) end))
- (decrypted-text
- (decode-coding-string
- (epg-decrypt-string
- epg-context
- encrypted-text)
- 'utf-8)))
- ;; Delete region starting just before point, because the
- ;; outline property starts at the \n of the heading.
- (delete-region (1- (point)) end)
- ;; Store a checksum of the decrypted and the encrypted
- ;; text value. This allows reusing the same encrypted text
- ;; if the text does not change, and therefore avoid a
- ;; re-encryption process.
- (insert "\n" (propertize decrypted-text
- 'org-crypt-checksum (sha1 decrypted-text)
- 'org-crypt-key (org-crypt-key-for-heading)
- 'org-crypt-text encrypted-text))
- (when heading-was-invisible-p
- (goto-char heading-point)
- (org-flag-subtree t))
- nil))))))
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let ((heading-point (point))
+ (heading-was-invisible-p
+ (save-excursion
+ (outline-end-of-heading)
+ (outline-invisible-p))))
+ (org-end-of-meta-data)
+ (when (looking-at "-----BEGIN PGP MESSAGE-----")
+ (org-crypt-check-auto-save)
+ (setq-local epg-context (epg-make-context nil t t))
+ (let* ((end (save-excursion
+ (search-forward "-----END PGP MESSAGE-----")
+ (forward-line)
+ (point)))
+ (encrypted-text (buffer-substring-no-properties (point) end))
+ (decrypted-text
+ (decode-coding-string
+ (epg-decrypt-string
+ epg-context
+ encrypted-text)
+ 'utf-8)))
+ ;; Delete region starting just before point, because the
+ ;; outline property starts at the \n of the heading.
+ (delete-region (1- (point)) end)
+ ;; Store a checksum of the decrypted and the encrypted
+ ;; text value. This allows reusing the same encrypted text
+ ;; if the text does not change, and therefore avoid a
+ ;; re-encryption process.
+ (insert "\n" (propertize decrypted-text
+ 'org-crypt-checksum (sha1 decrypted-text)
+ 'org-crypt-key (org-crypt-key-for-heading)
+ 'org-crypt-text encrypted-text))
+ (when heading-was-invisible-p
+ (goto-char heading-point)
+ (org-flag-subtree t))
+ nil))))))
(defun org-encrypt-entries ()
"Encrypt all top-level entries in the current buffer."
(interactive)
- (let (todo-only)
+ (let ((org--matcher-tags-todo-only nil))
(org-scan-tags
'org-encrypt-entry
(cdr (org-make-tags-matcher org-crypt-tag-matcher))
- todo-only)))
+ org--matcher-tags-todo-only)))
(defun org-decrypt-entries ()
"Decrypt all entries in the current buffer."
(interactive)
- (let (todo-only)
+ (let ((org--matcher-tags-todo-only nil))
(org-scan-tags
'org-decrypt-entry
(cdr (org-make-tags-matcher org-crypt-tag-matcher))
- todo-only)))
+ org--matcher-tags-todo-only)))
(defun org-at-encrypted-entry-p ()
"Is the current entry encrypted?"
@@ -267,7 +262,7 @@ See `org-crypt-disable-auto-save'."
"Add a hook to automatically encrypt entries before a file is saved to disk."
(add-hook
'org-mode-hook
- (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t))))
+ (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t))))
(add-hook 'org-reveal-start-hook 'org-decrypt-entry)
diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el
index ea4f52b..3c63af0 100644
--- a/lisp/org-ctags.el
+++ b/lisp/org-ctags.el
@@ -1,4 +1,4 @@
-;;; org-ctags.el - Integrate Emacs "tags" facility with org mode.
+;;; org-ctags.el - Integrate Emacs "tags" Facility with Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
@@ -26,20 +26,21 @@
;; Synopsis
;; ========
;;
-;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
-;; destinations in org-mode files as any text between <<double angled
-;; brackets>>. This allows the tags-generation program `exuberant ctags' to
-;; parse these files and create tag tables that record where these
-;; destinations are found. Plain [[links]] in org mode files which do not have
-;; <<matching destinations>> within the same file will then be interpreted as
-;; links to these 'tagged' destinations, allowing seamless navigation between
-;; multiple org-mode files. Topics can be created in any org mode file and
-;; will always be found by plain links from other files. Other file types
-;; recognized by ctags (source code files, latex files, etc) will also be
-;; available as destinations for plain links, and similarly, org-mode links
-;; will be available as tags from source files. Finally, the function
-;; `org-ctags-find-tag-interactive' lets you choose any known tag, using
-;; autocompletion, and quickly jump to it.
+;; Allows Org mode to make use of the Emacs `etags' system. Defines
+;; tag destinations in Org files as any text between <<double angled
+;; brackets>>. This allows the tags-generation program `exuberant
+;; ctags' to parse these files and create tag tables that record where
+;; these destinations are found. Plain [[links]] in org mode files
+;; which do not have <<matching destinations>> within the same file
+;; will then be interpreted as links to these 'tagged' destinations,
+;; allowing seamless navigation between multiple Org files. Topics
+;; can be created in any org mode file and will always be found by
+;; plain links from other files. Other file types recognized by ctags
+;; (source code files, latex files, etc) will also be available as
+;; destinations for plain links, and similarly, Org links will be
+;; available as tags from source files. Finally, the function
+;; `org-ctags-find-tag-interactive' lets you choose any known tag,
+;; using autocompletion, and quickly jump to it.
;;
;; Installation
;; ============
@@ -110,8 +111,9 @@
;; Keeping the TAGS file up to date
;; ================================
;;
-;; Tags mode has no way of knowing that you have created new tags by typing in
-;; your org-mode buffer. New tags make it into the TAGS file in 3 ways:
+;; Tags mode has no way of knowing that you have created new tags by
+;; typing in your Org buffer. New tags make it into the TAGS file in
+;; 3 ways:
;;
;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file.
;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in
@@ -135,12 +137,8 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(require 'org)
-(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
-
(defgroup org-ctags nil
"Options concerning use of ctags within org mode."
:tag "Org-Ctags"
@@ -151,7 +149,7 @@
(defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/"
"Regexp expression used by ctags external program.
-The regexp matches tag destinations in org-mode files.
+The regexp matches tag destinations in Org files.
Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/
See the ctags documentation for more information.")
@@ -210,8 +208,8 @@ The following patterns are replaced in the string:
(defadvice visit-tags-table (after org-ctags-load-tag-list activate compile)
(when (and org-ctags-enabled-p tags-file-name)
- (set (make-local-variable 'org-ctags-tag-list)
- (org-ctags-all-tags-in-current-tags-table))))
+ (setq-local org-ctags-tag-list
+ (org-ctags-all-tags-in-current-tags-table))))
(defun org-ctags-enable ()
@@ -273,11 +271,6 @@ Return the list."
(replace-regexp-in-string (regexp-quote search) replace string t t))
-(defun y-or-n-minibuffer (prompt)
- (let ((use-dialog-box nil))
- (y-or-n-p prompt)))
-
-
;;; Internal functions =======================================================
@@ -285,29 +278,28 @@ Return the list."
"Visit or create a file called `NAME.org', and insert a new topic.
The new topic will be titled NAME (or TITLE if supplied)."
(interactive "sFile name: ")
- (let ((filename (substitute-in-file-name (expand-file-name name))))
- (condition-case v
- (progn
- (org-open-file name t)
- (message "Opened file OK")
- (goto-char (point-max))
- (insert (org-ctags-string-search-and-replace
- "%t" (capitalize (or title name))
- org-ctags-new-topic-template))
- (message "Inserted new file text OK")
- (org-mode-restart))
- (error (error "Error %S in org-ctags-open-file" v)))))
+ (condition-case v
+ (progn
+ (org-open-file name t)
+ (message "Opened file OK")
+ (goto-char (point-max))
+ (insert (org-ctags-string-search-and-replace
+ "%t" (capitalize (or title name))
+ org-ctags-new-topic-template))
+ (message "Inserted new file text OK")
+ (org-mode-restart))
+ (error (error "Error %S in org-ctags-open-file" v))))
;;;; Misc interoperability with etags system =================================
-(defadvice find-tag (before org-ctags-set-org-mark-before-finding-tag
- activate compile)
+(defadvice xref-find-definitions
+ (before org-ctags-set-org-mark-before-finding-tag activate compile)
"Before trying to find a tag, save our current position on org mark ring."
(save-excursion
- (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
- (org-mark-ring-push))))
+ (when (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
+ (org-mark-ring-push))))
@@ -359,7 +351,7 @@ visit the file and location where the tag is found."
(old-pnt (point-marker))
(old-mark (copy-marker (mark-marker))))
(condition-case nil
- (progn (find-tag name)
+ (progn (xref-find-definitions name)
t)
(error
;; only restore old location if find-tag raises error
@@ -386,7 +378,7 @@ the new file."
(cond
((get-buffer (concat name ".org"))
;; Buffer is already open
- (org-pop-to-buffer-same-window (get-buffer (concat name ".org"))))
+ (pop-to-buffer-same-window (get-buffer (concat name ".org"))))
((file-exists-p filename)
;; File exists but is not open --> open it
(message "Opening existing org file `%S'..."
@@ -421,7 +413,6 @@ the heading a destination for the tag `NAME'."
(insert (org-ctags-string-search-and-replace
"%t" (capitalize name) org-ctags-new-topic-template))
(backward-char 4)
- (org-update-radio-target-regexp)
(end-of-line)
(forward-line 2)
(when narrowp
@@ -464,10 +455,10 @@ Wrapper for org-ctags-rebuild-tags-file-then-find-tag."
nil))
-(defun org-ctags-fail-silently (name)
+(defun org-ctags-fail-silently (_name)
"This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
-Put as the last function in the list if you want to prevent org's default
-behavior of free text search."
+Put as the last function in the list if you want to prevent Org's
+default behavior of free text search."
t)
@@ -484,7 +475,7 @@ end up in one file, called TAGS, located in the directory. This
function may take several seconds to finish if the directory or
its subdirectories contain large numbers of taggable files."
(interactive)
- (assert (buffer-file-name))
+ (cl-assert (buffer-file-name))
(let ((dir-name (or directory-name
(file-name-directory (buffer-file-name))))
(exitcode nil))
@@ -499,8 +490,8 @@ its subdirectories contain large numbers of taggable files."
(expand-file-name (concat dir-name "/*")))))
(cond
((eql 0 exitcode)
- (set (make-local-variable 'org-ctags-tag-list)
- (org-ctags-all-tags-in-current-tags-table)))
+ (setq-local org-ctags-tag-list
+ (org-ctags-all-tags-in-current-tags-table)))
(t
;; This seems to behave differently on Linux, so just ignore
;; error codes for now
@@ -528,7 +519,7 @@ a new topic."
((member tag org-ctags-tag-list)
;; Existing tag
(push tag org-ctags-find-tag-history)
- (find-tag tag))
+ (xref-find-definitions tag))
(t
;; New tag
(run-hook-with-args-until-success
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
index 999bc24..2a921bf 100644
--- a/lisp/org-datetree.el
+++ b/lisp/org-datetree.el
@@ -1,4 +1,4 @@
-;;; org-datetree.el --- Create date entries in a tree
+;;; org-datetree.el --- Create date entries in a tree -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -34,9 +34,10 @@
(defvar org-datetree-base-level 1
"The level at which years should be placed in the date tree.
-This is normally one, but if the buffer has an entry with a DATE_TREE
-property (any value), the date tree will become a subtree under that entry,
-so the base level will be properly adjusted.")
+This is normally one, but if the buffer has an entry with a
+DATE_TREE (or WEEK_TREE for ISO week entries) property (any
+value), the date tree will become a subtree under that entry, so
+the base level will be properly adjusted.")
(defcustom org-datetree-add-timestamp nil
"When non-nil, add a time stamp matching date of entry.
@@ -49,103 +50,116 @@ Added time stamp is active unless value is `inactive'."
(const :tag "Add an active time stamp" active)))
;;;###autoload
-(defun org-datetree-find-date-create (date &optional keep-restriction)
- "Find or create an entry for DATE.
+(defun org-datetree-find-date-create (d &optional keep-restriction)
+ "Find or create an entry for date D.
If KEEP-RESTRICTION is non-nil, do not widen the buffer.
When it is nil, the buffer will be widened to make sure an existing date
tree can be found."
- (org-set-local 'org-datetree-base-level 1)
+ (setq-local org-datetree-base-level 1)
(or keep-restriction (widen))
(save-restriction
(let ((prop (org-find-property "DATE_TREE")))
(when prop
(goto-char prop)
- (org-set-local 'org-datetree-base-level
- (org-get-valid-level (org-current-level) 1))
+ (setq-local org-datetree-base-level
+ (org-get-valid-level (org-current-level) 1))
(org-narrow-to-subtree)))
(goto-char (point-min))
- (let ((year (nth 2 date))
- (month (car date))
- (day (nth 1 date)))
- (org-datetree-find-year-create year)
- (org-datetree-find-month-create year month)
- (org-datetree-find-day-create year month day))))
-
-(defun org-datetree-find-year-create (year)
- "Find the YEAR datetree or create it."
- (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)")
- match)
- (goto-char (point-min))
- (while (and (setq match (re-search-forward re nil t))
- (goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) year)))
- (cond
- ((not match)
- (goto-char (point-max))
- (or (bolp) (newline))
- (org-datetree-insert-line year))
- ((= (string-to-number (match-string 1)) year)
- (goto-char (point-at-bol)))
- (t
- (beginning-of-line 1)
- (org-datetree-insert-line year)))))
+ (let ((year (calendar-extract-year d))
+ (month (calendar-extract-month d))
+ (day (calendar-extract-day d)))
+ (org-datetree--find-create
+ "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
+\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
+ year)
+ (org-datetree--find-create
+ "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$"
+ year month)
+ (org-datetree--find-create
+ "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
+ year month day))))
-(defun org-datetree-find-month-create (year month)
- "Find the datetree for YEAR and MONTH or create it."
- (org-narrow-to-subtree)
- (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year))
- match)
+;;;###autoload
+(defun org-datetree-find-iso-week-create (d &optional keep-restriction)
+ "Find or create an ISO week entry for date D.
+Compared to `org-datetree-find-date-create' this function creates
+entries ordered by week instead of months.
+If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it
+is nil, the buffer will be widened to make sure an existing date
+tree can be found."
+ (setq-local org-datetree-base-level 1)
+ (or keep-restriction (widen))
+ (save-restriction
+ (let ((prop (org-find-property "WEEK_TREE")))
+ (when prop
+ (goto-char prop)
+ (setq-local org-datetree-base-level
+ (org-get-valid-level (org-current-level) 1))
+ (org-narrow-to-subtree)))
(goto-char (point-min))
- (while (and (setq match (re-search-forward re nil t))
- (goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) month)))
- (cond
- ((not match)
- (goto-char (point-max))
- (or (bolp) (newline))
- (org-datetree-insert-line year month))
- ((= (string-to-number (match-string 1)) month)
- (goto-char (point-at-bol)))
- (t
- (beginning-of-line 1)
- (org-datetree-insert-line year month)))))
-
-(defun org-datetree-find-day-create (year month day)
- "Find the datetree for YEAR, MONTH and DAY or create it."
- (org-narrow-to-subtree)
- (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month))
+ (require 'cal-iso)
+ (let* ((year (calendar-extract-year d))
+ (month (calendar-extract-month d))
+ (day (calendar-extract-day d))
+ (time (encode-time 0 0 0 day month year))
+ (iso-date (calendar-iso-from-absolute
+ (calendar-absolute-from-gregorian d)))
+ (weekyear (nth 2 iso-date))
+ (week (nth 0 iso-date)))
+ ;; ISO 8601 week format is %G-W%V(-%u)
+ (org-datetree--find-create
+ "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
+\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
+ weekyear nil nil
+ (format-time-string "%G" time))
+ (org-datetree--find-create
+ "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$"
+ weekyear week nil
+ (format-time-string "%G-W%V" time))
+ ;; For the actual day we use the regular date instead of ISO week.
+ (org-datetree--find-create
+ "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
+ year month day))))
+
+(defun org-datetree--find-create (regex year &optional month day insert)
+ "Find the datetree matched by REGEX for YEAR, MONTH, or DAY.
+REGEX is passed to `format' with YEAR, MONTH, and DAY as
+arguments. Match group 1 is compared against the specified date
+component. If INSERT is non-nil and there is no match then it is
+inserted into the buffer."
+ (when (or month day)
+ (org-narrow-to-subtree))
+ (let ((re (format regex year month day))
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
(goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) day)))
+ (< (string-to-number (match-string 1)) (or day month year))))
(cond
((not match)
(goto-char (point-max))
- (or (bolp) (newline))
- (org-datetree-insert-line year month day))
- ((= (string-to-number (match-string 1)) day)
- (goto-char (point-at-bol)))
+ (unless (bolp) (insert "\n"))
+ (org-datetree-insert-line year month day insert))
+ ((= (string-to-number (match-string 1)) (or day month year))
+ (beginning-of-line))
(t
- (beginning-of-line 1)
- (org-datetree-insert-line year month day)))))
+ (beginning-of-line)
+ (org-datetree-insert-line year month day insert)))))
-(defun org-datetree-insert-line (year &optional month day)
+(defun org-datetree-insert-line (year &optional month day text)
(delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point))
(insert "\n" (make-string org-datetree-base-level ?*) " \n")
(backward-char)
(when month (org-do-demote))
(when day (org-do-demote))
- (insert (format "%d" year))
- (when month
- (insert
- (format "-%02d" month)
- (if day
- (format "-%02d %s"
- day
- (format-time-string "%A" (encode-time 0 0 0 day month year)))
- (format " %s"
- (format-time-string "%B" (encode-time 0 0 0 1 month year))))))
+ (if text
+ (insert text)
+ (insert (format "%d" year))
+ (when month
+ (insert
+ (if day
+ (format-time-string "-%m-%d %A" (encode-time 0 0 0 day month year))
+ (format-time-string "-%m %B" (encode-time 0 0 0 1 month year))))))
(when (and day org-datetree-add-timestamp)
(save-excursion
(insert "\n")
@@ -156,9 +170,9 @@ tree can be found."
(eq org-datetree-add-timestamp 'inactive))))
(beginning-of-line))
-(defun org-datetree-file-entry-under (txt date)
- "Insert a node TXT into the date tree under DATE."
- (org-datetree-find-date-create date)
+(defun org-datetree-file-entry-under (txt d)
+ "Insert a node TXT into the date tree under date D."
+ (org-datetree-find-date-create d)
(let ((level (org-get-valid-level (funcall outline-level) 1)))
(org-end-of-subtree t t)
(org-back-over-empty-lines)
@@ -171,44 +185,42 @@ before running this command, even though the command tries to be smart."
(interactive)
(goto-char (point-min))
(let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'"))
- (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))
- dct ts tmp date year month day pos hdl-pos)
+ (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")))
(while (re-search-forward org-ts-regexp nil t)
(catch 'next
- (setq ts (match-string 0))
- (setq tmp (buffer-substring
- (max (point-at-bol) (- (match-beginning 0)
- org-ds-keyword-length))
- (match-beginning 0)))
- (if (or (string-match "-\\'" tmp)
- (string-match dre tmp)
- (string-match sre tmp))
+ (let ((tmp (buffer-substring
+ (max (line-beginning-position)
+ (- (match-beginning 0) org-ds-keyword-length))
+ (match-beginning 0))))
+ (when (or (string-suffix-p "-" tmp)
+ (string-match dre tmp)
+ (string-match sre tmp))
(throw 'next nil))
- (setq dct (decode-time (org-time-string-to-time (match-string 0)))
- date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
- year (nth 2 date)
- month (car date)
- day (nth 1 date)
- pos (point))
- (org-back-to-heading t)
- (setq hdl-pos (point))
- (unless (org-up-heading-safe)
- ;; No parent, we are not in a date tree
- (goto-char pos)
- (throw 'next nil))
- (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
- ;; Parent looks wrong, we are not in a date tree
- (goto-char pos)
- (throw 'next nil))
- (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
- ;; At correct date already, do nothing
- (progn (goto-char pos) (throw 'next nil)))
- ;; OK, we need to refile this entry
- (goto-char hdl-pos)
- (org-cut-subtree)
- (save-excursion
- (save-restriction
- (org-datetree-file-entry-under (current-kill 0) date)))))))
+ (let* ((dct (decode-time (org-time-string-to-time (match-string 0))))
+ (date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)))
+ (year (nth 2 date))
+ (month (car date))
+ (day (nth 1 date))
+ (pos (point))
+ (hdl-pos (progn (org-back-to-heading t) (point))))
+ (unless (org-up-heading-safe)
+ ;; No parent, we are not in a date tree.
+ (goto-char pos)
+ (throw 'next nil))
+ (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
+ ;; Parent looks wrong, we are not in a date tree.
+ (goto-char pos)
+ (throw 'next nil))
+ (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
+ ;; At correct date already, do nothing.
+ (goto-char pos)
+ (throw 'next nil))
+ ;; OK, we need to refile this entry.
+ (goto-char hdl-pos)
+ (org-cut-subtree)
+ (save-excursion
+ (save-restriction
+ (org-datetree-file-entry-under (current-kill 0) date)))))))))
(provide 'org-datetree)
diff --git a/lisp/org-docview.el b/lisp/org-docview.el
index d2a9525..0f0bdaf 100644
--- a/lisp/org-docview.el
+++ b/lisp/org-docview.el
@@ -1,4 +1,4 @@
-;;; org-docview.el --- support for links to doc-view-mode buffers
+;;; org-docview.el --- Support for links to doc-view-mode buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -25,7 +25,7 @@
;;; Commentary:
;; This file implements links to open files in doc-view-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;; The links take the form
@@ -49,8 +49,10 @@
(declare-function doc-view-goto-page "doc-view" (page))
(declare-function image-mode-window-get "image-mode" (prop &optional winprops))
-(org-add-link-type "docview" 'org-docview-open 'org-docview-export)
-(add-hook 'org-store-link-functions 'org-docview-store-link)
+(org-link-set-parameters "docview"
+ :follow #'org-docview-open
+ :export #'org-docview-export
+ :store #'org-docview-store-link)
(defun org-docview-export (link description format)
"Export a docview link from Org files."
@@ -81,8 +83,7 @@
;; This buffer is in doc-view-mode
(let* ((path buffer-file-name)
(page (image-mode-window-get 'page))
- (link (concat "docview:" path "::" (number-to-string page)))
- (description ""))
+ (link (concat "docview:" path "::" (number-to-string page))))
(org-store-link-props
:type "docview"
:link link
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 2576c3f..027eea4 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -1,4 +1,4 @@
-;;; org-element.el --- Parser And Applications for Org syntax
+;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@@ -116,9 +116,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'org)
(require 'avl-tree)
+(require 'cl-lib)
@@ -151,7 +151,7 @@ specially in `org-element--object-lex'.")
;; Headlines, inlinetasks.
org-outline-regexp "\\|"
;; Footnote definitions.
- "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ "\\[fn:[-_[:word:]]+\\]" "\\|"
;; Diary sexps.
"%%(" "\\|"
"[ \t]*\\(?:"
@@ -177,15 +177,15 @@ specially in `org-element--object-lex'.")
;; Clock lines.
(regexp-quote org-clock-string) "\\|"
;; Lists.
- (let ((term (case org-plain-list-ordered-item-terminator
- (?\) ")") (?. "\\.") (otherwise "[.)]")))
+ (let ((term (pcase org-plain-list-ordered-item-terminator
+ (?\) ")") (?. "\\.") (_ "[.)]")))
(alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
(concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
"\\(?:[ \t]\\|$\\)"))
"\\)\\)")
org-element--object-regexp
(mapconcat #'identity
- (let ((link-types (regexp-opt org-link-types)))
+ (let ((link-types (regexp-opt (org-link-types))))
(list
;; Sub/superscript.
"\\(?:[_^][-{(*+.,[:alnum:]]\\)"
@@ -199,7 +199,12 @@ specially in `org-element--object-lex'.")
;; Objects starting with "[": regular link,
;; footnote reference, statistics cookie,
;; timestamp (inactive).
- "\\[\\(?:fn:\\|\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)\\|\\[\\)"
+ (concat "\\[\\(?:"
+ "fn:" "\\|"
+ "\\[" "\\|"
+ "[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" "\\|"
+ "[0-9]*\\(?:%\\|/[0-9]*\\)\\]"
+ "\\)")
;; Objects starting with "@": export snippets.
"@@"
;; Objects starting with "{": macro.
@@ -258,17 +263,6 @@ specially in `org-element--object-lex'.")
(append org-element-recursive-objects '(paragraph table-row verse-block))
"List of object or element types that can directly contain objects.")
-(defvar org-element-block-name-alist
- '(("CENTER" . org-element-center-block-parser)
- ("COMMENT" . org-element-comment-block-parser)
- ("EXAMPLE" . org-element-example-block-parser)
- ("QUOTE" . org-element-quote-block-parser)
- ("SRC" . org-element-src-block-parser)
- ("VERSE" . org-element-verse-block-parser))
- "Alist between block names and the associated parsing function.
-Names must be uppercase. Any block whose name has no association
-is parsed with `org-element-special-block-parser'.")
-
(defconst org-element-affiliated-keywords
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
"RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
@@ -334,7 +328,7 @@ This list is checked after translations have been applied. See
;; Regular affiliated keywords.
(format "\\(?1:%s\\)"
(regexp-opt
- (org-remove-if
+ (cl-remove-if
(lambda (k) (member k org-element-dual-keywords))
org-element-affiliated-keywords)))
"\\|"
@@ -358,10 +352,11 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(italic ,@standard-set)
(item ,@standard-set-no-line-break)
(keyword ,@(remq 'footnote-reference standard-set))
- ;; Ignore all links excepted plain links in a link description.
- ;; Also ignore radio-targets and line breaks.
+ ;; Ignore all links excepted plain links and angular links in
+ ;; a link description. Also ignore radio-targets and line
+ ;; breaks.
(link bold code entity export-snippet inline-babel-call inline-src-block
- italic latex-fragment macro plain-link statistics-cookie
+ italic latex-fragment macro simple-link statistics-cookie
strike-through subscript superscript underline verbatim)
(paragraph ,@standard-set)
;; Remove any variable object from radio target as it would
@@ -399,6 +394,15 @@ still has an entry since one of its properties (`:title') does.")
(item :tag))
"Alist between element types and locations of secondary values.")
+(defconst org-element--pair-round-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\( "()" table)
+ (modify-syntax-entry ?\) ")(" table)
+ (dolist (char '(?\{ ?\} ?\[ ?\] ?\< ?\>) table)
+ (modify-syntax-entry char " " table)))
+ "Table used internally to pair only round brackets.
+Other brackets are treated as spaces.")
+
(defconst org-element--pair-square-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?\[ "(]" table)
@@ -408,6 +412,33 @@ still has an entry since one of its properties (`:title') does.")
"Table used internally to pair only square brackets.
Other brackets are treated as spaces.")
+(defconst org-element--pair-curly-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\{ "(}" table)
+ (modify-syntax-entry ?\} "){" table)
+ (dolist (char '(?\[ ?\] ?\( ?\) ?\< ?\>) table)
+ (modify-syntax-entry char " " table)))
+ "Table used internally to pair only curly brackets.
+Other brackets are treated as spaces.")
+
+(defun org-element--parse-paired-brackets (char)
+ "Parse paired brackets at point.
+CHAR is the opening bracket to consider, as a character. Return
+contents between brackets, as a string, or nil. Also move point
+past the brackets."
+ (when (eq char (char-after))
+ (let ((syntax-table (pcase char
+ (?\{ org-element--pair-curly-table)
+ (?\[ org-element--pair-square-table)
+ (?\( org-element--pair-round-table)
+ (_ nil)))
+ (pos (point)))
+ (when syntax-table
+ (with-syntax-table syntax-table
+ (let ((end (ignore-errors (scan-lists pos 1 0))))
+ (when end
+ (goto-char end)
+ (buffer-substring-no-properties (1+ pos) (1- end)))))))))
;;; Accessors and Setters
@@ -424,8 +455,10 @@ Other brackets are treated as spaces.")
;; high-level functions useful to modify a parse tree.
;;
;; `org-element-secondary-p' is a predicate used to know if a given
-;; object belongs to a secondary string. `org-element-copy' returns
-;; an element or object, stripping its parent property in the process.
+;; object belongs to a secondary string. `org-element-class' tells if
+;; some parsed data is an element or an object, handling pseudo
+;; elements and objects. `org-element-copy' returns an element or
+;; object, stripping its parent property in the process.
(defsubst org-element-type (element)
"Return type of ELEMENT.
@@ -465,10 +498,11 @@ Return modified element."
element))
(defsubst org-element-set-contents (element &rest contents)
- "Set ELEMENT contents to CONTENTS."
- (cond ((not element) (list contents))
+ "Set ELEMENT's contents to CONTENTS.
+Return ELEMENT."
+ (cond ((null element) contents)
((not (symbolp (car element))) contents)
- ((cdr element) (setcdr (cdr element) contents))
+ ((cdr element) (setcdr (cdr element) contents) element)
(t (nconc element contents))))
(defun org-element-secondary-p (object)
@@ -482,6 +516,32 @@ Return value is the property name, as a keyword, or nil."
(and (memq object (org-element-property p parent))
(throw 'exit p))))))
+(defun org-element-class (datum &optional parent)
+ "Return class for ELEMENT, as a symbol.
+Class is either `element' or `object'. Optional argument PARENT
+is the element or object containing DATUM. It defaults to the
+value of DATUM `:parent' property."
+ (let ((type (org-element-type datum))
+ (parent (or parent (org-element-property :parent datum))))
+ (cond
+ ;; Trivial cases.
+ ((memq type org-element-all-objects) 'object)
+ ((memq type org-element-all-elements) 'element)
+ ;; Special cases.
+ ((eq type 'org-data) 'element)
+ ((eq type 'plain-text) 'object)
+ ((not type) 'object)
+ ;; Pseudo object or elements. Make a guess about its class.
+ ;; Basically a pseudo object is contained within another object,
+ ;; a secondary string or a container element.
+ ((not parent) 'element)
+ (t
+ (let ((parent-type (org-element-type parent)))
+ (cond ((not parent-type) 'object)
+ ((memq parent-type org-element-object-containers) 'object)
+ ((org-element-secondary-p datum) 'object)
+ (t 'element)))))))
+
(defsubst org-element-adopt-elements (parent &rest children)
"Append elements to the contents of another element.
@@ -587,11 +647,11 @@ DATUM is an element, object, string or nil. `:parent' property
is cleared and contents are removed in the process."
(when datum
(let ((type (org-element-type datum)))
- (case type
- (org-data (list 'org-data nil))
- (plain-text (substring-no-properties datum))
- ((nil) (copy-sequence datum))
- (otherwise
+ (pcase type
+ (`org-data (list 'org-data nil))
+ (`plain-text (substring-no-properties datum))
+ (`nil (copy-sequence datum))
+ (_
(list type (plist-put (copy-sequence (nth 1 datum)) :parent nil)))))))
@@ -674,8 +734,8 @@ Assume point is at the beginning of the block."
:post-affiliated post-affiliated)
(cdr affiliated))))))))
-(defun org-element-center-block-interpreter (center-block contents)
- "Interpret CENTER-BLOCK element as Org syntax.
+(defun org-element-center-block-interpreter (_ contents)
+ "Interpret a center-block element as Org syntax.
CONTENTS is the contents of the element."
(format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
@@ -702,7 +762,7 @@ Assume point is at beginning of drawer."
(save-excursion
(let* ((drawer-end-line (match-beginning 0))
(name (progn (looking-at org-drawer-regexp)
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(begin (car affiliated))
(post-affiliated (point))
;; Empty drawers have no contents.
@@ -758,8 +818,8 @@ Assume point is at beginning of dynamic block."
(let ((block-end-line (match-beginning 0)))
(save-excursion
(let* ((name (progn (looking-at org-dblock-start-re)
- (org-match-string-no-properties 1)))
- (arguments (org-match-string-no-properties 3))
+ (match-string-no-properties 1)))
+ (arguments (match-string-no-properties 3))
(begin (car affiliated))
(post-affiliated (point))
;; Empty blocks have no contents.
@@ -817,7 +877,7 @@ a plist containing `:label', `:begin' `:end', `:contents-begin',
Assume point is at the beginning of the footnote definition."
(save-excursion
(let* ((label (progn (looking-at org-footnote-definition-re)
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(begin (car affiliated))
(post-affiliated (point))
(ending
@@ -832,7 +892,7 @@ Assume point is at the beginning of the footnote definition."
;; before any affiliated keyword above.
(forward-line -1)
(while (and (> (point) post-affiliated)
- (org-looking-at-p org-element--affiliated-re))
+ (looking-at-p org-element--affiliated-re))
(forward-line -1))
(line-beginning-position 2))
(t (match-beginning 0)))))
@@ -861,7 +921,7 @@ Assume point is at the beginning of the footnote definition."
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
CONTENTS is the contents of the footnote-definition."
- (concat (format "[%s]" (org-element-property :label footnote-definition))
+ (concat (format "[fn:%s]" (org-element-property :label footnote-definition))
" "
contents))
@@ -875,13 +935,13 @@ obtained through property drawer and default properties from the
parser (e.g. `:end' and :END:). Return value is a plist."
(save-excursion
(forward-line)
- (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at-p org-planning-line-re) (forward-line))
(when (looking-at org-property-drawer-re)
(forward-line)
(let ((end (match-end 0)) properties)
(while (< (line-end-position) end)
(looking-at org-property-re)
- (push (org-match-string-no-properties 3) properties)
+ (push (match-string-no-properties 3) properties)
(push (intern (concat ":" (upcase (match-string 2)))) properties)
(forward-line))
properties))))
@@ -944,7 +1004,7 @@ Assume point is at beginning of the headline."
(goto-char (match-end 0))))
(title-start (point))
(tags (when (re-search-forward
- (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(line-end-position)
'move)
(goto-char (match-beginning 0))
@@ -995,17 +1055,16 @@ Assume point is at beginning of the headline."
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
- (let ((title (org-element--parse-objects
- (progn (goto-char title-start)
- (skip-chars-forward " \t")
- (point))
- (progn (goto-char title-end)
- (skip-chars-backward " \t")
- (point))
- nil
- (org-element-restriction 'headline))))
- (dolist (datum title title)
- (org-element-put-property datum :parent headline)))))))))
+ (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
+ (org-element-restriction 'headline)
+ headline)))))))
(defun org-element-headline-interpreter (headline contents)
"Interpret HEADLINE element as Org syntax.
@@ -1087,7 +1146,7 @@ Assume point is at beginning of the inline task."
(aref (match-string 0) 2))))
(title-start (point))
(tags (when (re-search-forward
- (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(line-end-position)
'move)
(goto-char (match-beginning 0))
@@ -1098,7 +1157,7 @@ Assume point is at beginning of the inline task."
(task-end (save-excursion
(end-of-line)
(and (re-search-forward org-outline-regexp-bol limit t)
- (org-looking-at-p "END[ \t]*$")
+ (looking-at-p "END[ \t]*$")
(line-beginning-position))))
(standard-props (and task-end (org-element--get-node-properties)))
(time-props (and task-end (org-element--get-time-properties)))
@@ -1131,17 +1190,16 @@ Assume point is at beginning of the inline task."
(org-element-put-property
inlinetask :title
(if raw-secondary-p raw-value
- (let ((title (org-element--parse-objects
- (progn (goto-char title-start)
- (skip-chars-forward " \t")
- (point))
- (progn (goto-char title-end)
- (skip-chars-backward " \t")
- (point))
- nil
- (org-element-restriction 'inlinetask))))
- (dolist (datum title title)
- (org-element-put-property datum :parent inlinetask))))))))
+ (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
+ (org-element-restriction 'inlinetask)
+ inlinetask))))))
(defun org-element-inlinetask-interpreter (inlinetask contents)
"Interpret INLINETASK element as Org syntax.
@@ -1183,7 +1241,7 @@ CONTENTS is the contents of inlinetask."
;;;; Item
-(defun org-element-item-parser (limit struct &optional raw-secondary-p)
+(defun org-element-item-parser (_ struct &optional raw-secondary-p)
"Parse an item.
STRUCT is the structure of the plain list.
@@ -1202,7 +1260,7 @@ Assume point is at the beginning of the item."
(beginning-of-line)
(looking-at org-list-full-item-re)
(let* ((begin (point))
- (bullet (org-match-string-no-properties 1))
+ (bullet (match-string-no-properties 1))
(checkbox (let ((box (match-string 3)))
(cond ((equal "[ ]" box) 'off)
((equal "[X]" box) 'on)
@@ -1253,11 +1311,10 @@ Assume point is at the beginning of the item."
(let ((raw (org-list-get-tag begin struct)))
(when raw
(if raw-secondary-p raw
- (let ((tag (org-element--parse-objects
- (match-beginning 4) (match-end 4) nil
- (org-element-restriction 'item))))
- (dolist (datum tag tag)
- (org-element-put-property datum :parent item))))))))))
+ (org-element--parse-objects
+ (match-beginning 4) (match-end 4) nil
+ (org-element-restriction 'item)
+ item))))))))
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
@@ -1280,10 +1337,11 @@ CONTENTS is the contents of the element."
(concat
bullet
(and counter (format "[@%d] " counter))
- (case checkbox
- (on "[X] ")
- (off "[ ] ")
- (trans "[-] "))
+ (pcase checkbox
+ (`on "[X] ")
+ (`off "[ ] ")
+ (`trans "[-] ")
+ (_ nil))
(and tag (format "%s :: " tag))
(when contents
(let ((contents (replace-regexp-in-string
@@ -1351,7 +1409,7 @@ CONTENTS is the contents of the element."
(forward-line)
(let ((origin (point)))
(when (re-search-forward inlinetask-re limit t)
- (if (org-looking-at-p "END[ \t]*$") (forward-line)
+ (if (looking-at-p "END[ \t]*$") (forward-line)
(goto-char origin)))))
;; At some text line. Check if it ends any previous item.
(t
@@ -1393,7 +1451,7 @@ containing `:type', `:begin', `:end', `:contents-begin' and
Assume point is at the beginning of the list."
(save-excursion
(let* ((struct (or structure (org-element--list-struct limit)))
- (type (cond ((org-looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
+ (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
((nth 5 (assq (point) struct)) 'descriptive)
(t 'unordered)))
(contents-begin (point))
@@ -1421,8 +1479,8 @@ Assume point is at the beginning of the list."
:post-affiliated contents-begin)
(cdr affiliated))))))
-(defun org-element-plain-list-interpreter (plain-list contents)
- "Interpret PLAIN-LIST element as Org syntax.
+(defun org-element-plain-list-interpreter (_ contents)
+ "Interpret plain-list element as Org syntax.
CONTENTS is the contents of the element."
(with-temp-buffer
(insert contents)
@@ -1461,8 +1519,8 @@ Assume point is at the beginning of the property drawer."
:post-blank (count-lines before-blank end)
:post-affiliated begin))))))
-(defun org-element-property-drawer-interpreter (property-drawer contents)
- "Interpret PROPERTY-DRAWER element as Org syntax.
+(defun org-element-property-drawer-interpreter (_ contents)
+ "Interpret property-drawer element as Org syntax.
CONTENTS is the properties within the drawer."
(format ":PROPERTIES:\n%s:END:" contents))
@@ -1511,19 +1569,17 @@ Assume point is at the beginning of the block."
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-quote-block-interpreter (quote-block contents)
- "Interpret QUOTE-BLOCK element as Org syntax.
+(defun org-element-quote-block-interpreter (_ contents)
+ "Interpret quote-block element as Org syntax.
CONTENTS is the contents of the element."
(format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
;;;; Section
-(defun org-element-section-parser (limit)
+(defun org-element-section-parser (_)
"Parse a section.
-LIMIT bounds the search.
-
Return a list whose CAR is `section' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `contents-end',
`:post-blank' and `:post-affiliated' keywords."
@@ -1534,8 +1590,7 @@ containing `:begin', `:end', `:contents-begin', `contents-end',
(end (progn (org-with-limited-levels (outline-next-heading))
(point)))
(pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (forward-line)
- (point))))
+ (line-beginning-position 2))))
(list 'section
(list :begin begin
:end end
@@ -1544,8 +1599,8 @@ containing `:begin', `:end', `:contents-begin', `contents-end',
:post-blank (count-lines pos-before-blank end)
:post-affiliated begin)))))
-(defun org-element-section-interpreter (section contents)
- "Interpret SECTION element as Org syntax.
+(defun org-element-section-interpreter (_ contents)
+ "Interpret section element as Org syntax.
CONTENTS is the contents of the element."
contents)
@@ -1616,9 +1671,6 @@ CONTENTS is the contents of the element."
;; through the following steps: implement a parser and an interpreter,
;; tweak `org-element--current-element' so that it recognizes the new
;; type and add that new type to `org-element-all-elements'.
-;;
-;; As a special case, when the newly defined type is a block type,
-;; `org-element-block-name-alist' has to be modified accordingly.
;;;; Babel Call
@@ -1665,9 +1717,8 @@ containing `:call', `:inside-header', `:arguments',
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-babel-call-interpreter (babel-call contents)
- "Interpret BABEL-CALL element as Org syntax.
-CONTENTS is nil."
+(defun org-element-babel-call-interpreter (babel-call _)
+ "Interpret BABEL-CALL element as Org syntax."
(concat "#+CALL: "
(org-element-property :call babel-call)
(let ((h (org-element-property :inside-header babel-call)))
@@ -1696,7 +1747,7 @@ Return a list whose CAR is `clock' and CDR is a plist containing
(duration (and (search-forward " => " (line-end-position) t)
(progn (skip-chars-forward " \t")
(looking-at "\\(\\S-+\\)[ \t]*$"))
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(status (if duration 'closed 'running))
(post-blank (let ((before-blank (progn (forward-line) (point))))
(skip-chars-forward " \r\t\n" limit)
@@ -1713,9 +1764,8 @@ Return a list whose CAR is `clock' and CDR is a plist containing
:post-blank post-blank
:post-affiliated begin)))))
-(defun org-element-clock-interpreter (clock contents)
- "Interpret CLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-clock-interpreter (clock _)
+ "Interpret CLOCK element as Org syntax."
(concat org-clock-string " "
(org-element-timestamp-interpreter
(org-element-property :value clock) nil)
@@ -1774,7 +1824,7 @@ Assume point is at comment beginning."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-comment-interpreter (comment contents)
+(defun org-element-comment-interpreter (comment _)
"Interpret COMMENT element as Org syntax.
CONTENTS is nil."
(replace-regexp-in-string "^" "# " (org-element-property :value comment)))
@@ -1821,9 +1871,8 @@ Assume point is at comment block beginning."
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-comment-block-interpreter (comment-block contents)
- "Interpret COMMENT-BLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-comment-block-interpreter (comment-block _)
+ "Interpret COMMENT-BLOCK element as Org syntax."
(format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
(org-element-normalize-string
(org-remove-indentation
@@ -1847,7 +1896,7 @@ containing `:begin', `:end', `:value', `:post-blank' and
(let ((begin (car affiliated))
(post-affiliated (point))
(value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
@@ -1860,9 +1909,8 @@ containing `:begin', `:end', `:value', `:post-blank' and
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-diary-sexp-interpreter (diary-sexp contents)
- "Interpret DIARY-SEXP as Org syntax.
-CONTENTS is nil."
+(defun org-element-diary-sexp-interpreter (diary-sexp _)
+ "Interpret DIARY-SEXP as Org syntax."
(org-element-property :value diary-sexp))
@@ -1890,12 +1938,20 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
(let* ((switches
(progn
(looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
- (org-match-string-no-properties 1)))
- ;; Switches analysis
+ (match-string-no-properties 1)))
+ ;; Switches analysis.
(number-lines
- (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
+ (and switches
+ (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
+ switches)
+ (cons
+ (if (equal (match-string 1 switches) "-")
+ 'new
+ 'continued)
+ (if (not (match-end 2)) 0
+ ;; Subtract 1 to give number of lines before
+ ;; first line.
+ (1- (string-to-number (match-string 2 switches)))))))
(preserve-indent
(and switches (string-match "-i\\>" switches)))
;; Should labels be retained in (or stripped from) example
@@ -1917,13 +1973,10 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
;; Standard block parsing.
(begin (car affiliated))
(post-affiliated (point))
- (block-ind (progn (skip-chars-forward " \t") (current-column)))
- (contents-begin (progn (forward-line) (point)))
- (value (org-element-remove-indentation
- (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end))
- block-ind))
+ (contents-begin (line-beginning-position 2))
+ (value (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ contents-begin contents-end)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1944,9 +1997,8 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-example-block-interpreter (example-block contents)
- "Interpret EXAMPLE-BLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-example-block-interpreter (example-block _)
+ "Interpret EXAMPLE-BLOCK element as Org syntax."
(let ((switches (org-element-property :switches example-block))
(value (org-element-property :value example-block)))
(concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
@@ -1955,7 +2007,7 @@ CONTENTS is nil."
(if (or org-src-preserve-indentation
(org-element-property :preserve-indent example-block))
value
- (org-element-remove-indentation value))))
+ (org-remove-indentation value))))
"#+END_EXAMPLE")))
@@ -1974,43 +2026,44 @@ containing `:begin', `:end', `:type', `:value', `:post-blank' and
`:post-affiliated' keywords.
Assume point is at export-block beginning."
- (let* ((case-fold-search t)
- (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (upcase (org-match-string-no-properties 1)))))
+ (let* ((case-fold-search t))
(if (not (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
+ (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (progn (forward-line) (point)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (value (buffer-substring-no-properties contents-begin
- contents-end)))
- (list 'export-block
- (nconc
- (list :begin begin
- :end end
- :type type
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (save-excursion
+ (let* ((contents-end (match-beginning 0))
+ (backend
+ (progn
+ (looking-at
+ "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$")
+ (match-string-no-properties 1)))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ (contents-begin (progn (forward-line) (point)))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position))))
+ (value (org-unescape-code-in-string
+ (buffer-substring-no-properties contents-begin
+ contents-end))))
+ (list 'export-block
+ (nconc
+ (list :type (and backend (upcase backend))
+ :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
-(defun org-element-export-block-interpreter (export-block contents)
- "Interpret EXPORT-BLOCK element as Org syntax.
-CONTENTS is nil."
- (let ((type (org-element-property :type export-block)))
- (concat (format "#+BEGIN_%s\n" type)
- (org-element-property :value export-block)
- (format "#+END_%s" type))))
+(defun org-element-export-block-interpreter (export-block _)
+ "Interpret EXPORT-BLOCK element as Org syntax."
+ (format "#+BEGIN_EXPORT %s\n%s#+END_EXPORT"
+ (org-element-property :type export-block)
+ (org-element-property :value export-block)))
;;;; Fixed-width
@@ -2055,9 +2108,8 @@ Assume point is at the beginning of the fixed-width area."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-fixed-width-interpreter (fixed-width contents)
- "Interpret FIXED-WIDTH element as Org syntax.
-CONTENTS is nil."
+(defun org-element-fixed-width-interpreter (fixed-width _)
+ "Interpret FIXED-WIDTH element as Org syntax."
(let ((value (org-element-property :value fixed-width)))
(and value
(replace-regexp-in-string
@@ -2092,9 +2144,8 @@ keywords."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
- "Interpret HORIZONTAL-RULE element as Org syntax.
-CONTENTS is nil."
+(defun org-element-horizontal-rule-interpreter (&rest _)
+ "Interpret HORIZONTAL-RULE element as Org syntax."
"-----")
@@ -2118,7 +2169,7 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
(let ((begin (or (car affiliated) (point)))
(post-affiliated (point))
(key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
- (upcase (org-match-string-no-properties 1))))
+ (upcase (match-string-no-properties 1))))
(value (org-trim (buffer-substring-no-properties
(match-end 0) (point-at-eol))))
(pos-before-blank (progn (forward-line) (point)))
@@ -2134,9 +2185,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-keyword-interpreter (keyword contents)
- "Interpret KEYWORD element as Org syntax.
-CONTENTS is nil."
+(defun org-element-keyword-interpreter (keyword _)
+ "Interpret KEYWORD element as Org syntax."
(format "#+%s: %s"
(org-element-property :key keyword)
(org-element-property :value keyword)))
@@ -2192,9 +2242,8 @@ Assume point is at the beginning of the latex environment."
:post-affiliated code-begin)
(cdr affiliated))))))))
-(defun org-element-latex-environment-interpreter (latex-environment contents)
- "Interpret LATEX-ENVIRONMENT element as Org syntax.
-CONTENTS is nil."
+(defun org-element-latex-environment-interpreter (latex-environment _)
+ "Interpret LATEX-ENVIRONMENT element as Org syntax."
(org-element-property :value latex-environment))
@@ -2211,8 +2260,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
(looking-at org-property-re)
(let ((case-fold-search t)
(begin (point))
- (key (org-match-string-no-properties 2))
- (value (org-match-string-no-properties 3))
+ (key (match-string-no-properties 2))
+ (value (match-string-no-properties 3))
(end (save-excursion
(end-of-line)
(if (re-search-forward org-property-re limit t)
@@ -2226,9 +2275,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
:post-blank 0
:post-affiliated begin))))
-(defun org-element-node-property-interpreter (node-property contents)
- "Interpret NODE-PROPERTY element as Org syntax.
-CONTENTS is nil."
+(defun org-element-node-property-interpreter (node-property _)
+ "Interpret NODE-PROPERTY element as Org syntax."
(format org-property-format
(format ":%s:" (org-element-property :key node-property))
(or (org-element-property :value node-property) "")))
@@ -2303,8 +2351,8 @@ Assume point is at the beginning of the paragraph."
:post-affiliated contents-begin)
(cdr affiliated))))))
-(defun org-element-paragraph-interpreter (paragraph contents)
- "Interpret PARAGRAPH element as Org syntax.
+(defun org-element-paragraph-interpreter (_ contents)
+ "Interpret paragraph element as Org syntax.
CONTENTS is the contents of the element."
contents)
@@ -2347,11 +2395,10 @@ containing `:closed', `:deadline', `:scheduled', `:begin',
:post-blank post-blank
:post-affiliated begin)))))
-(defun org-element-planning-interpreter (planning contents)
- "Interpret PLANNING element as Org syntax.
-CONTENTS is nil."
+(defun org-element-planning-interpreter (planning _)
+ "Interpret PLANNING element as Org syntax."
(mapconcat
- 'identity
+ #'identity
(delq nil
(list (let ((deadline (org-element-property :deadline planning)))
(when deadline
@@ -2398,20 +2445,28 @@ Assume point is at the beginning of the block."
(language
(progn
(looking-at
- (concat "^[ \t]*#\\+BEGIN_SRC"
- "\\(?: +\\(\\S-+\\)\\)?"
- "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
- "\\(.*\\)[ \t]*$"))
- (org-match-string-no-properties 1)))
+ "^[ \t]*#\\+BEGIN_SRC\
+\\(?: +\\(\\S-+\\)\\)?\
+\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\
+\\(.*\\)[ \t]*$")
+ (match-string-no-properties 1)))
;; Get switches.
- (switches (org-match-string-no-properties 2))
+ (switches (match-string-no-properties 2))
;; Get parameters.
- (parameters (org-match-string-no-properties 3))
- ;; Switches analysis
+ (parameters (match-string-no-properties 3))
+ ;; Switches analysis.
(number-lines
- (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
+ (and switches
+ (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
+ switches)
+ (cons
+ (if (equal (match-string 1 switches) "-")
+ 'new
+ 'continued)
+ (if (not (match-end 2)) 0
+ ;; Subtract 1 to give number of lines before
+ ;; first line.
+ (1- (string-to-number (match-string 2 switches)))))))
(preserve-indent (and switches
(string-match "-i\\>" switches)))
(label-fmt
@@ -2430,14 +2485,10 @@ Assume point is at the beginning of the block."
(or (not switches)
(and retain-labels
(not (string-match "-k\\>" switches)))))
- ;; Indentation.
- (block-ind (progn (skip-chars-forward " \t") (current-column)))
;; Retrieve code.
- (value (org-element-remove-indentation
- (org-unescape-code-in-string
- (buffer-substring-no-properties
- (progn (forward-line) (point)) contents-end))
- block-ind))
+ (value (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ (line-beginning-position 2) contents-end)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -2463,9 +2514,8 @@ Assume point is at the beginning of the block."
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-src-block-interpreter (src-block contents)
- "Interpret SRC-BLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-src-block-interpreter (src-block _)
+ "Interpret SRC-BLOCK element as Org syntax."
(let ((lang (org-element-property :language src-block))
(switches (org-element-property :switches src-block))
(params (org-element-property :parameters src-block))
@@ -2475,11 +2525,12 @@ CONTENTS is nil."
((or org-src-preserve-indentation
(org-element-property :preserve-indent src-block))
val)
- ((zerop org-edit-src-content-indentation) val)
+ ((zerop org-edit-src-content-indentation)
+ (org-remove-indentation val))
(t
(let ((ind (make-string org-edit-src-content-indentation ?\s)))
(replace-regexp-in-string
- "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
+ "^" ind (org-remove-indentation val))))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
@@ -2517,7 +2568,7 @@ Assume point is at the beginning of the table."
(point)))
(tblfm (let (acc)
(while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
- (push (org-match-string-no-properties 1) acc)
+ (push (match-string-no-properties 1) acc)
(forward-line))
acc))
(pos-before-blank (point))
@@ -2556,11 +2607,9 @@ CONTENTS is a string, if table's type is `org', or nil."
;;;; Table Row
-(defun org-element-table-row-parser (limit)
+(defun org-element-table-row-parser (_)
"Parse table row at point.
-LIMIT bounds the search.
-
Return a list whose CAR is `table-row' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
`:type', `:post-blank' and `:post-affiliated' keywords."
@@ -2569,9 +2618,7 @@ containing `:begin', `:end', `:contents-begin', `:contents-end',
(begin (point))
;; A table rule has no contents. In that case, ensure
;; CONTENTS-BEGIN matches CONTENTS-END.
- (contents-begin (and (eq type 'standard)
- (search-forward "|")
- (point)))
+ (contents-begin (and (eq type 'standard) (search-forward "|")))
(contents-end (and (eq type 'standard)
(progn
(end-of-line)
@@ -2591,7 +2638,7 @@ containing `:begin', `:end', `:contents-begin', `:contents-end',
"Interpret TABLE-ROW element as Org syntax.
CONTENTS is the contents of the table row."
(if (eq (org-element-property :type table-row) 'rule) "|-"
- (concat "| " contents)))
+ (concat "|" contents)))
;;;; Verse Block
@@ -2634,8 +2681,8 @@ Assume point is at beginning of the block."
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-verse-block-interpreter (verse-block contents)
- "Interpret VERSE-BLOCK element as Org syntax.
+(defun org-element-verse-block-interpreter (_ contents)
+ "Interpret verse-block element as Org syntax.
CONTENTS is verse block contents."
(format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
@@ -2683,8 +2730,8 @@ Assume point is at the first star marker."
:contents-end contents-end
:post-blank post-blank))))))
-(defun org-element-bold-interpreter (bold contents)
- "Interpret BOLD object as Org syntax.
+(defun org-element-bold-interpreter (_ contents)
+ "Interpret bold object as Org syntax.
CONTENTS is the contents of the object."
(format "*%s*" contents))
@@ -2703,7 +2750,7 @@ Assume point is at the first tilde marker."
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
(let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
+ (value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2))
(skip-chars-forward " \t")))
(end (point)))
@@ -2713,9 +2760,8 @@ Assume point is at the first tilde marker."
:end end
:post-blank post-blank))))))
-(defun org-element-code-interpreter (code contents)
- "Interpret CODE object as Org syntax.
-CONTENTS is nil."
+(defun org-element-code-interpreter (code _)
+ "Interpret CODE object as Org syntax."
(format "~%s~" (org-element-property :value code)))
@@ -2754,9 +2800,8 @@ Assume point is at the beginning of the entity."
:use-brackets-p bracketsp
:post-blank post-blank)))))))
-(defun org-element-entity-interpreter (entity contents)
- "Interpret ENTITY object as Org syntax.
-CONTENTS is nil."
+(defun org-element-entity-interpreter (entity _)
+ "Interpret ENTITY object as Org syntax."
(concat "\\"
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
@@ -2781,7 +2826,7 @@ Assume point is at the beginning of the snippet."
(re-search-forward "@@" nil t)
(match-beginning 0))))
(let* ((begin (match-beginning 0))
- (back-end (org-match-string-no-properties 1))
+ (back-end (match-string-no-properties 1))
(value (buffer-substring-no-properties
(match-end 0) contents-end))
(post-blank (skip-chars-forward " \t"))
@@ -2793,9 +2838,8 @@ Assume point is at the beginning of the snippet."
:end end
:post-blank post-blank)))))))
-(defun org-element-export-snippet-interpreter (export-snippet contents)
- "Interpret EXPORT-SNIPPET object as Org syntax.
-CONTENTS is nil."
+(defun org-element-export-snippet-interpreter (export-snippet _)
+ "Interpret EXPORT-SNIPPET object as Org syntax."
(format "@@%s:%s@@"
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
@@ -2816,14 +2860,10 @@ When at a footnote reference, return a list whose car is
(when closing
(save-excursion
(let* ((begin (point))
- (label
- (or (org-match-string-no-properties 2)
- (org-match-string-no-properties 3)
- (and (match-string 1)
- (concat "fn:" (org-match-string-no-properties 1)))))
- (type (if (or (not label) (match-string 1)) 'inline 'standard))
+ (label (match-string-no-properties 1))
(inner-begin (match-end 0))
(inner-end (1- closing))
+ (type (if (match-end 2) 'inline 'standard))
(post-blank (progn (goto-char closing)
(skip-chars-forward " \t")))
(end (point)))
@@ -2839,9 +2879,9 @@ When at a footnote reference, return a list whose car is
(defun org-element-footnote-reference-interpreter (footnote-reference contents)
"Interpret FOOTNOTE-REFERENCE object as Org syntax.
CONTENTS is its definition, when inline, or nil."
- (format "[%s]"
- (concat (or (org-element-property :label footnote-reference) "fn:")
- (and contents (concat ":" contents)))))
+ (format "[fn:%s%s]"
+ (or (org-element-property :label footnote-reference) "")
+ (if contents (concat ":" contents) "")))
;;;; Inline Babel Call
@@ -2856,31 +2896,39 @@ When at an inline babel call, return a list whose car is
Assume point is at the beginning of the babel call."
(save-excursion
- (unless (bolp) (backward-char))
- (when (let ((case-fold-search t))
- (looking-at org-babel-inline-lob-one-liner-regexp))
- (let ((begin (match-end 1))
- (call (org-match-string-no-properties 2))
- (inside-header (org-string-nw-p (org-match-string-no-properties 4)))
- (arguments (org-string-nw-p (org-match-string-no-properties 6)))
- (end-header (org-string-nw-p (org-match-string-no-properties 8)))
- (value (buffer-substring-no-properties (match-end 1) (match-end 0)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-babel-call
- (list :call call
- :inside-header inside-header
- :arguments arguments
- :end-header end-header
- :begin begin
- :end end
- :value value
- :post-blank post-blank))))))
+ (catch :no-object
+ (when (let ((case-fold-search nil))
+ (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]"))
+ (goto-char (match-end 1))
+ (let* ((begin (match-beginning 0))
+ (call (match-string-no-properties 1))
+ (inside-header
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (arguments (org-string-nw-p
+ (or (org-element--parse-paired-brackets ?\()
+ ;; Parenthesis are mandatory.
+ (throw :no-object nil))))
+ (end-header
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (value (buffer-substring-no-properties begin (point)))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (list 'inline-babel-call
+ (list :call call
+ :inside-header inside-header
+ :arguments arguments
+ :end-header end-header
+ :begin begin
+ :end end
+ :value value
+ :post-blank post-blank)))))))
-(defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
- "Interpret INLINE-BABEL-CALL object as Org syntax.
-CONTENTS is nil."
+(defun org-element-inline-babel-call-interpreter (inline-babel-call _)
+ "Interpret INLINE-BABEL-CALL object as Org syntax."
(concat "call_"
(org-element-property :call inline-babel-call)
(let ((h (org-element-property :inside-header inline-babel-call)))
@@ -2902,26 +2950,29 @@ keywords. Otherwise, return nil.
Assume point is at the beginning of the inline src block."
(save-excursion
- (unless (bolp) (backward-char))
- (when (looking-at org-babel-inline-src-block-regexp)
- (let ((begin (match-beginning 1))
- (language (org-match-string-no-properties 2))
- (parameters (org-match-string-no-properties 4))
- (value (org-match-string-no-properties 5))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-src-block
- (list :language language
- :value value
- :parameters parameters
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (catch :no-object
+ (when (let ((case-fold-search nil))
+ (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]"))
+ (goto-char (match-end 1))
+ (let ((begin (match-beginning 0))
+ (language (match-string-no-properties 1))
+ (parameters
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (value (or (org-element--parse-paired-brackets ?\{)
+ (throw :no-object nil)))
+ (post-blank (skip-chars-forward " \t")))
+ (list 'inline-src-block
+ (list :language language
+ :value value
+ :parameters parameters
+ :begin begin
+ :end (point)
+ :post-blank post-blank)))))))
-(defun org-element-inline-src-block-interpreter (inline-src-block contents)
- "Interpret INLINE-SRC-BLOCK object as Org syntax.
-CONTENTS is nil."
+(defun org-element-inline-src-block-interpreter (inline-src-block _)
+ "Interpret INLINE-SRC-BLOCK object as Org syntax."
(let ((language (org-element-property :language inline-src-block))
(arguments (org-element-property :parameters inline-src-block))
(body (org-element-property :value inline-src-block)))
@@ -2957,8 +3008,8 @@ Assume point is at the first slash marker."
:contents-end contents-end
:post-blank post-blank))))))
-(defun org-element-italic-interpreter (italic contents)
- "Interpret ITALIC object as Org syntax.
+(defun org-element-italic-interpreter (_ contents)
+ "Interpret italic object as Org syntax.
CONTENTS is the contents of the object."
(format "/%s/" contents))
@@ -2986,12 +3037,13 @@ Assume point is at the beginning of the LaTeX fragment."
'(?\s ?\t ?\n ?, ?.)))
(looking-at "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|$\\)")
(point)))
- (case (char-after (1+ (point)))
+ (pcase (char-after (1+ (point)))
(?\( (search-forward "\\)" nil t))
(?\[ (search-forward "\\]" nil t))
- (otherwise
+ (_
;; Macro.
- (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
+ (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\
+\\|\\({[^{}\n]*}\\)\\)*")
(match-end 0))))))
(post-blank (if (not after-fragment) (throw 'no-object nil)
(goto-char after-fragment)
@@ -3003,9 +3055,8 @@ Assume point is at the beginning of the LaTeX fragment."
:end end
:post-blank post-blank))))))
-(defun org-element-latex-fragment-interpreter (latex-fragment contents)
- "Interpret LATEX-FRAGMENT object as Org syntax.
-CONTENTS is nil."
+(defun org-element-latex-fragment-interpreter (latex-fragment _)
+ "Interpret LATEX-FRAGMENT object as Org syntax."
(org-element-property :value latex-fragment))
;;;; Line Break
@@ -3018,16 +3069,15 @@ and cdr a plist with `:begin', `:end' and `:post-blank' keywords.
Otherwise, return nil.
Assume point is at the beginning of the line break."
- (when (and (org-looking-at-p "\\\\\\\\[ \t]*$")
+ (when (and (looking-at-p "\\\\\\\\[ \t]*$")
(not (eq (char-before) ?\\)))
(list 'line-break
(list :begin (point)
:end (line-beginning-position 2)
:post-blank 0))))
-(defun org-element-line-break-interpreter (line-break contents)
- "Interpret LINE-BREAK object as Org syntax.
-CONTENTS is nil."
+(defun org-element-line-break-interpreter (&rest _)
+ "Interpret LINE-BREAK object as Org syntax."
"\\\\\n")
@@ -3037,7 +3087,7 @@ CONTENTS is nil."
"Parse link at point, if any.
When at a link, return a list whose car is `link' and cdr a plist
-with `:type', `:path', `:raw-link', `:application',
+with `:type', `:path', `:format', `:raw-link', `:application',
`:search-option', `:begin', `:end', `:contents-begin',
`:contents-end' and `:post-blank' as keywords. Otherwise, return
nil.
@@ -3045,20 +3095,22 @@ nil.
Assume point is at the beginning of the link."
(catch 'no-object
(let ((begin (point))
- end contents-begin contents-end link-end post-blank path type
- raw-link link search-option application)
+ end contents-begin contents-end link-end post-blank path type format
+ raw-link search-option application)
(cond
;; Type 1: Text targeted from a radio target.
((and org-target-link-regexp
(save-excursion (or (bolp) (backward-char))
(looking-at org-target-link-regexp)))
- (setq type "radio"
- link-end (match-end 1)
- path (org-match-string-no-properties 1)
- contents-begin (match-beginning 1)
- contents-end (match-end 1)))
+ (setq type "radio")
+ (setq format 'plain)
+ (setq link-end (match-end 1))
+ (setq path (match-string-no-properties 1))
+ (setq contents-begin (match-beginning 1))
+ (setq contents-end (match-end 1)))
;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
((looking-at org-bracket-link-regexp)
+ (setq format 'bracket)
(setq contents-begin (match-beginning 3))
(setq contents-end (match-end 3))
(setq link-end (match-end 0))
@@ -3076,7 +3128,7 @@ Assume point is at the beginning of the link."
(setq raw-link (org-link-expand-abbrev
(replace-regexp-in-string
"[ \t]*\n[ \t]*" " "
- (org-match-string-no-properties 1))))
+ (match-string-no-properties 1))))
;; Determine TYPE of link and set PATH accordingly. According
;; to RFC 3986, remove whitespaces from URI in external links.
;; In internal ones, treat indentation as a single space.
@@ -3086,16 +3138,13 @@ Assume point is at the beginning of the link."
(string-match "\\`\\.\\.?/" raw-link))
(setq type "file")
(setq path raw-link))
- ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
+ ;; Explicit type (http, irc, bbdb...).
((string-match org-link-types-re raw-link)
(setq type (match-string 1 raw-link))
(setq path (substring raw-link (match-end 0))))
- ;; Id type: PATH is the id.
- ((string-match "\\`id:\\([-a-f0-9]+\\)\\'" raw-link)
- (setq type "id" path (match-string 1 raw-link)))
;; Code-ref type: PATH is the name of the reference.
- ((and (org-string-match-p "\\`(" raw-link)
- (org-string-match-p ")\\'" raw-link))
+ ((and (string-match-p "\\`(" raw-link)
+ (string-match-p ")\\'" raw-link))
(setq type "coderef")
(setq path (substring raw-link 1 -1)))
;; Custom-id type: PATH is the name of the custom id.
@@ -3110,21 +3159,23 @@ Assume point is at the beginning of the link."
(setq path raw-link))))
;; Type 3: Plain link, e.g., http://orgmode.org
((looking-at org-plain-link-re)
- (setq raw-link (org-match-string-no-properties 0)
- type (org-match-string-no-properties 1)
- link-end (match-end 0)
- path (org-match-string-no-properties 2)))
+ (setq format 'plain)
+ (setq raw-link (match-string-no-properties 0))
+ (setq type (match-string-no-properties 1))
+ (setq link-end (match-end 0))
+ (setq path (match-string-no-properties 2)))
;; Type 4: Angular link, e.g., <http://orgmode.org>. Unlike to
;; bracket links, follow RFC 3986 and remove any extra
;; whitespace in URI.
((looking-at org-angle-link-re)
- (setq type (org-match-string-no-properties 1))
+ (setq format 'angle)
+ (setq type (match-string-no-properties 1))
(setq link-end (match-end 0))
(setq raw-link
(buffer-substring-no-properties
(match-beginning 1) (match-end 2)))
(setq path (replace-regexp-in-string
- "[ \t]*\n[ \t]*" "" (org-match-string-no-properties 2))))
+ "[ \t]*\n[ \t]*" "" (match-string-no-properties 2))))
(t (throw 'no-object nil)))
;; In any case, deduce end point after trailing white space from
;; LINK-END variable.
@@ -3149,6 +3200,7 @@ Assume point is at the beginning of the link."
(list 'link
(list :type type
:path path
+ :format format
:raw-link (or raw-link path)
:application application
:search-option search-option
@@ -3164,18 +3216,38 @@ CONTENTS is the contents of the object, or nil."
(let ((type (org-element-property :type link))
(path (org-element-property :path link)))
(if (string= type "radio") path
- (format "[[%s]%s]"
- (cond ((string= type "coderef") (format "(%s)" path))
- ((string= type "custom-id") (concat "#" path))
- ((string= type "file")
- (let ((app (org-element-property :application link))
- (opt (org-element-property :search-option link)))
- (concat type (and app (concat "+" app)) ":"
- path
- (and opt (concat "::" opt)))))
- ((string= type "fuzzy") path)
- (t (concat type ":" path)))
- (if contents (format "[%s]" contents) "")))))
+ (let ((fmt (pcase (org-element-property :format link)
+ ;; Links with contents and internal links have to
+ ;; use bracket syntax. Ignore `:format' in these
+ ;; cases. This is also the default syntax when the
+ ;; property is not defined, e.g., when the object
+ ;; was crafted by the user.
+ ((guard contents)
+ (format "[[%%s][%s]]"
+ ;; Since this is going to be used as
+ ;; a format string, escape percent signs
+ ;; in description.
+ (replace-regexp-in-string "%" "%%" contents)))
+ ((or `bracket
+ `nil
+ (guard (member type '("coderef" "custom-id" "fuzzy"))))
+ "[[%s]]")
+ ;; Otherwise, just obey to `:format'.
+ (`angle "<%s>")
+ (`plain "%s")
+ (f (error "Wrong `:format' value: %s" f)))))
+ (format fmt
+ (pcase type
+ ("coderef" (format "(%s)" path))
+ ("custom-id" (concat "#" path))
+ ("file"
+ (let ((app (org-element-property :application link))
+ (opt (org-element-property :search-option link)))
+ (concat type (and app (concat "+" app)) ":"
+ path
+ (and opt (concat "::" opt)))))
+ ("fuzzy" path)
+ (_ (concat type ":" path))))))))
;;;; Macro
@@ -3191,12 +3263,12 @@ Assume point is at the macro."
(save-excursion
(when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
(let ((begin (point))
- (key (downcase (org-match-string-no-properties 1)))
- (value (org-match-string-no-properties 0))
+ (key (downcase (match-string-no-properties 1)))
+ (value (match-string-no-properties 0))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point))
- (args (let ((args (org-match-string-no-properties 3)))
+ (args (let ((args (match-string-no-properties 3)))
(and args (org-macro-extract-arguments args)))))
(list 'macro
(list :key key
@@ -3206,9 +3278,8 @@ Assume point is at the macro."
:end end
:post-blank post-blank))))))
-(defun org-element-macro-interpreter (macro contents)
- "Interpret MACRO object as Org syntax.
-CONTENTS is nil."
+(defun org-element-macro-interpreter (macro _)
+ "Interpret MACRO object as Org syntax."
(org-element-property :value macro))
@@ -3228,7 +3299,7 @@ Assume point is at the radio target."
(let ((begin (point))
(contents-begin (match-beginning 1))
(contents-end (match-end 1))
- (value (org-match-string-no-properties 1))
+ (value (match-string-no-properties 1))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
@@ -3240,8 +3311,8 @@ Assume point is at the radio target."
:post-blank post-blank
:value value))))))
-(defun org-element-radio-target-interpreter (target contents)
- "Interpret TARGET object as Org syntax.
+(defun org-element-radio-target-interpreter (_ contents)
+ "Interpret target object as Org syntax.
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
@@ -3270,9 +3341,8 @@ Assume point is at the beginning of the statistics-cookie."
:value value
:post-blank post-blank))))))
-(defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
- "Interpret STATISTICS-COOKIE object as Org syntax.
-CONTENTS is nil."
+(defun org-element-statistics-cookie-interpreter (statistics-cookie _)
+ "Interpret STATISTICS-COOKIE object as Org syntax."
(org-element-property :value statistics-cookie))
@@ -3303,8 +3373,8 @@ Assume point is at the first plus sign marker."
:contents-end contents-end
:post-blank post-blank))))))
-(defun org-element-strike-through-interpreter (strike-through contents)
- "Interpret STRIKE-THROUGH object as Org syntax.
+(defun org-element-strike-through-interpreter (_ contents)
+ "Interpret strike-through object as Org syntax.
CONTENTS is the contents of the object."
(format "+%s+" contents))
@@ -3404,8 +3474,8 @@ and `:post-blank' keywords."
:contents-end contents-end
:post-blank 0))))
-(defun org-element-table-cell-interpreter (table-cell contents)
- "Interpret TABLE-CELL element as Org syntax.
+(defun org-element-table-cell-interpreter (_ contents)
+ "Interpret table-cell element as Org syntax.
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
@@ -3423,7 +3493,7 @@ Assume point is at the target."
(save-excursion
(when (looking-at org-target-regexp)
(let ((begin (point))
- (value (org-match-string-no-properties 1))
+ (value (match-string-no-properties 1))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
@@ -3433,9 +3503,8 @@ Assume point is at the target."
:value value
:post-blank post-blank))))))
-(defun org-element-target-interpreter (target contents)
- "Interpret TARGET object as Org syntax.
-CONTENTS is nil."
+(defun org-element-target-interpreter (target _)
+ "Interpret TARGET object as Org syntax."
(format "<<%s>>" (org-element-property :value target)))
@@ -3462,7 +3531,7 @@ cdr a plist with `:type', `:raw-value', `:year-start',
Otherwise, return nil.
Assume point is at the beginning of the timestamp."
- (when (org-looking-at-p org-element--timestamp-regexp)
+ (when (looking-at-p org-element--timestamp-regexp)
(save-excursion
(let* ((begin (point))
(activep (eq (char-after) ?<))
@@ -3500,8 +3569,8 @@ Assume point is at the beginning of the timestamp."
(t 'cumulate)))
:repeater-value (string-to-number (match-string 2 raw-value))
:repeater-unit
- (case (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
(warning-props
(and (not diaryp)
(string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
@@ -3509,8 +3578,8 @@ Assume point is at the beginning of the timestamp."
:warning-type (if (match-string 1 raw-value) 'first 'all)
:warning-value (string-to-number (match-string 2 raw-value))
:warning-unit
- (case (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
year-start month-start day-start hour-start minute-start year-end
month-end day-end hour-end minute-end)
;; Parse date-start.
@@ -3550,26 +3619,24 @@ Assume point is at the beginning of the timestamp."
repeater-props
warning-props))))))
-(defun org-element-timestamp-interpreter (timestamp contents)
- "Interpret TIMESTAMP object as Org syntax.
-CONTENTS is nil."
+(defun org-element-timestamp-interpreter (timestamp _)
+ "Interpret TIMESTAMP object as Org syntax."
(let* ((repeat-string
(concat
- (case (org-element-property :repeater-type timestamp)
- (cumulate "+") (catch-up "++") (restart ".+"))
+ (pcase (org-element-property :repeater-type timestamp)
+ (`cumulate "+") (`catch-up "++") (`restart ".+"))
(let ((val (org-element-property :repeater-value timestamp)))
(and val (number-to-string val)))
- (case (org-element-property :repeater-unit timestamp)
- (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (pcase (org-element-property :repeater-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
(warning-string
(concat
- (case (org-element-property :warning-type timestamp)
- (first "--")
- (all "-"))
+ (pcase (org-element-property :warning-type timestamp)
+ (`first "--") (`all "-"))
(let ((val (org-element-property :warning-value timestamp)))
(and val (number-to-string val)))
- (case (org-element-property :warning-unit timestamp)
- (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (pcase (org-element-property :warning-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
(build-ts-string
;; Build an Org timestamp string from TIME. ACTIVEP is
;; non-nil when time stamp is active. If WITH-TIME-P is
@@ -3578,7 +3645,7 @@ CONTENTS is nil."
;; the repeater string, if any.
(lambda (time activep &optional with-time-p hour-end minute-end)
(let ((ts (format-time-string
- (funcall (if with-time-p 'cdr 'car)
+ (funcall (if with-time-p #'cdr #'car)
org-time-stamp-formats)
time)))
(when (and hour-end minute-end)
@@ -3597,8 +3664,8 @@ CONTENTS is nil."
;; Return value.
ts)))
(type (org-element-property :type timestamp)))
- (case type
- ((active inactive)
+ (pcase type
+ ((or `active `inactive)
(let* ((minute-start (org-element-property :minute-start timestamp))
(minute-end (org-element-property :minute-end timestamp))
(hour-start (org-element-property :hour-start timestamp))
@@ -3618,7 +3685,7 @@ CONTENTS is nil."
(and hour-start minute-start)
(and time-range-p hour-end)
(and time-range-p minute-end))))
- ((active-range inactive-range)
+ ((or `active-range `inactive-range)
(let ((minute-start (org-element-property :minute-start timestamp))
(minute-end (org-element-property :minute-end timestamp))
(hour-start (org-element-property :hour-start timestamp))
@@ -3644,7 +3711,7 @@ CONTENTS is nil."
(org-element-property :year-end timestamp))
(eq type 'active-range)
(and hour-end minute-end)))))
- (otherwise (org-element-property :raw-value timestamp)))))
+ (_ (org-element-property :raw-value timestamp)))))
;;;; Underline
@@ -3674,8 +3741,8 @@ Assume point is at the first underscore marker."
:contents-end contents-end
:post-blank post-blank))))))
-(defun org-element-underline-interpreter (underline contents)
- "Interpret UNDERLINE object as Org syntax.
+(defun org-element-underline-interpreter (_ contents)
+ "Interpret underline object as Org syntax.
CONTENTS is the contents of the object."
(format "_%s_" contents))
@@ -3694,7 +3761,7 @@ Assume point is at the first equal sign marker."
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
(let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
+ (value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2))
(skip-chars-forward " \t")))
(end (point)))
@@ -3704,9 +3771,8 @@ Assume point is at the first equal sign marker."
:end end
:post-blank post-blank))))))
-(defun org-element-verbatim-interpreter (verbatim contents)
- "Interpret VERBATIM object as Org syntax.
-CONTENTS is nil."
+(defun org-element-verbatim-interpreter (verbatim _)
+ "Interpret VERBATIM object as Org syntax."
(format "=%s=" (org-element-property :value verbatim)))
@@ -3808,27 +3874,35 @@ element it has to parse."
;; Keywords.
((looking-at "[ \t]*#")
(goto-char (match-end 0))
- (cond ((looking-at "\\(?: \\|$\\)")
- (beginning-of-line)
- (org-element-comment-parser limit affiliated))
- ((looking-at "\\+BEGIN_\\(\\S-+\\)")
- (beginning-of-line)
- (let ((parser (assoc (upcase (match-string 1))
- org-element-block-name-alist)))
- (if parser (funcall (cdr parser) limit affiliated)
- (org-element-special-block-parser limit affiliated))))
- ((looking-at "\\+CALL:")
- (beginning-of-line)
- (org-element-babel-call-parser limit affiliated))
- ((looking-at "\\+BEGIN:? ")
- (beginning-of-line)
- (org-element-dynamic-block-parser limit affiliated))
- ((looking-at "\\+\\S-+:")
- (beginning-of-line)
- (org-element-keyword-parser limit affiliated))
- (t
- (beginning-of-line)
- (org-element-paragraph-parser limit affiliated))))
+ (cond
+ ((looking-at "\\(?: \\|$\\)")
+ (beginning-of-line)
+ (org-element-comment-parser limit affiliated))
+ ((looking-at "\\+BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (funcall (pcase (upcase (match-string 1))
+ ("CENTER" #'org-element-center-block-parser)
+ ("COMMENT" #'org-element-comment-block-parser)
+ ("EXAMPLE" #'org-element-example-block-parser)
+ ("EXPORT" #'org-element-export-block-parser)
+ ("QUOTE" #'org-element-quote-block-parser)
+ ("SRC" #'org-element-src-block-parser)
+ ("VERSE" #'org-element-verse-block-parser)
+ (_ #'org-element-special-block-parser))
+ limit
+ affiliated))
+ ((looking-at "\\+CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit affiliated))
+ ((looking-at "\\+BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((looking-at "\\+\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit affiliated))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit affiliated))))
;; Footnote Definition.
((looking-at org-footnote-definition-re)
(org-element-footnote-definition-parser limit affiliated))
@@ -3893,7 +3967,7 @@ position of point and CDR is nil."
(dualp (member kwd org-element-dual-keywords))
(dual-value
(and dualp
- (let ((sec (org-match-string-no-properties 2)))
+ (let ((sec (match-string-no-properties 2)))
(if (or (not sec) (not parsedp)) sec
(save-match-data
(org-element--parse-objects
@@ -4010,14 +4084,11 @@ If STRING is the empty string or nil, return nil."
(dolist (v local-variables)
(ignore-errors
(if (symbolp v) (makunbound v)
- (org-set-local (car v) (cdr v)))))
+ (set (make-local-variable (car v)) (cdr v)))))
(insert string)
(restore-buffer-modified-p nil)
- (let ((data (org-element--parse-objects
- (point-min) (point-max) nil restriction)))
- (when parent
- (dolist (o data) (org-element-put-property o :parent parent)))
- data))))))
+ (org-element--parse-objects
+ (point-min) (point-max) nil restriction parent))))))
(defun org-element-map
(data types fun &optional info first-match no-recursion with-affiliated)
@@ -4087,94 +4158,93 @@ looking into captions:
(list no-recursion)))
;; Recursion depth is determined by --CATEGORY.
(--category
- (catch 'found
+ (catch :--found
(let ((category 'greater-elements)
(all-objects (cons 'plain-text org-element-all-objects)))
(dolist (type types category)
(cond ((memq type all-objects)
- ;; If one object is found, the function has to
- ;; recurse into every object.
- (throw 'found 'objects))
+ ;; If one object is found, the function has
+ ;; to recurse into every object.
+ (throw :--found 'objects))
((not (memq type org-element-greater-elements))
;; If one regular element is found, the
;; function has to recurse, at least, into
;; every element it encounters.
(and (not (eq category 'elements))
(setq category 'elements))))))))
- --acc
- --walk-tree
- (--walk-tree
- (lambda (--data)
- ;; Recursively walk DATA. INFO, if non-nil, is a plist
- ;; holding contextual information.
- (let ((--type (org-element-type --data)))
- (cond
- ((not --data))
- ;; Ignored element in an export context.
- ((and info (memq --data (plist-get info :ignore-list))))
- ;; List of elements or objects.
- ((not --type) (mapc --walk-tree --data))
- ;; Unconditionally enter parse trees.
- ((eq --type 'org-data)
- (mapc --walk-tree (org-element-contents --data)))
- (t
- ;; Check if TYPE is matching among TYPES. If so,
- ;; apply FUN to --DATA and accumulate return value
- ;; into --ACC (or exit if FIRST-MATCH is non-nil).
- (when (memq --type types)
- (let ((result (funcall fun --data)))
- (cond ((not result))
- (first-match (throw '--map-first-match result))
- (t (push result --acc)))))
- ;; If --DATA has a secondary string that can contain
- ;; objects with their type among TYPES, look into it.
- (when (and (eq --category 'objects) (not (stringp --data)))
- (dolist (p (cdr (assq --type
- org-element-secondary-value-alist)))
- (funcall --walk-tree (org-element-property p --data))))
- ;; If --DATA has any parsed affiliated keywords and
- ;; WITH-AFFILIATED is non-nil, look for objects in
- ;; them.
- (when (and with-affiliated
- (eq --category 'objects)
- (memq --type org-element-all-elements))
- (dolist (kwd-pair org-element--parsed-properties-alist)
- (let ((kwd (car kwd-pair))
- (value (org-element-property (cdr kwd-pair) --data)))
- ;; Pay attention to the type of parsed keyword.
- ;; In particular, preserve order for multiple
- ;; keywords.
- (cond
- ((not value))
- ((member kwd org-element-dual-keywords)
- (if (member kwd org-element-multiple-keywords)
- (dolist (line (reverse value))
- (funcall --walk-tree (cdr line))
- (funcall --walk-tree (car line)))
- (funcall --walk-tree (cdr value))
- (funcall --walk-tree (car value))))
- ((member kwd org-element-multiple-keywords)
- (mapc --walk-tree (reverse value)))
- (t (funcall --walk-tree value))))))
- ;; Determine if a recursion into --DATA is possible.
- (cond
- ;; --TYPE is explicitly removed from recursion.
- ((memq --type no-recursion))
- ;; --DATA has no contents.
- ((not (org-element-contents --data)))
- ;; Looking for greater elements but --DATA is simply
- ;; an element or an object.
- ((and (eq --category 'greater-elements)
- (not (memq --type org-element-greater-elements))))
- ;; Looking for elements but --DATA is an object.
- ((and (eq --category 'elements)
- (memq --type org-element-all-objects)))
- ;; In any other case, map contents.
- (t (mapc --walk-tree (org-element-contents --data))))))))))
- (catch '--map-first-match
- (funcall --walk-tree data)
- ;; Return value in a proper order.
- (nreverse --acc))))
+ --acc)
+ (letrec ((--walk-tree
+ (lambda (--data)
+ ;; Recursively walk DATA. INFO, if non-nil, is a plist
+ ;; holding contextual information.
+ (let ((--type (org-element-type --data)))
+ (cond
+ ((not --data))
+ ;; Ignored element in an export context.
+ ((and info (memq --data (plist-get info :ignore-list))))
+ ;; List of elements or objects.
+ ((not --type) (mapc --walk-tree --data))
+ ;; Unconditionally enter parse trees.
+ ((eq --type 'org-data)
+ (mapc --walk-tree (org-element-contents --data)))
+ (t
+ ;; Check if TYPE is matching among TYPES. If so,
+ ;; apply FUN to --DATA and accumulate return value
+ ;; into --ACC (or exit if FIRST-MATCH is non-nil).
+ (when (memq --type types)
+ (let ((result (funcall fun --data)))
+ (cond ((not result))
+ (first-match (throw :--map-first-match result))
+ (t (push result --acc)))))
+ ;; If --DATA has a secondary string that can contain
+ ;; objects with their type among TYPES, look inside.
+ (when (and (eq --category 'objects) (not (stringp --data)))
+ (dolist (p (cdr (assq --type
+ org-element-secondary-value-alist)))
+ (funcall --walk-tree (org-element-property p --data))))
+ ;; If --DATA has any parsed affiliated keywords and
+ ;; WITH-AFFILIATED is non-nil, look for objects in
+ ;; them.
+ (when (and with-affiliated
+ (eq --category 'objects)
+ (eq (org-element-class --data) 'element))
+ (dolist (kwd-pair org-element--parsed-properties-alist)
+ (let ((kwd (car kwd-pair))
+ (value (org-element-property (cdr kwd-pair) --data)))
+ ;; Pay attention to the type of parsed
+ ;; keyword. In particular, preserve order for
+ ;; multiple keywords.
+ (cond
+ ((not value))
+ ((member kwd org-element-dual-keywords)
+ (if (member kwd org-element-multiple-keywords)
+ (dolist (line (reverse value))
+ (funcall --walk-tree (cdr line))
+ (funcall --walk-tree (car line)))
+ (funcall --walk-tree (cdr value))
+ (funcall --walk-tree (car value))))
+ ((member kwd org-element-multiple-keywords)
+ (mapc --walk-tree (reverse value)))
+ (t (funcall --walk-tree value))))))
+ ;; Determine if a recursion into --DATA is possible.
+ (cond
+ ;; --TYPE is explicitly removed from recursion.
+ ((memq --type no-recursion))
+ ;; --DATA has no contents.
+ ((not (org-element-contents --data)))
+ ;; Looking for greater elements but --DATA is
+ ;; simply an element or an object.
+ ((and (eq --category 'greater-elements)
+ (not (memq --type org-element-greater-elements))))
+ ;; Looking for elements but --DATA is an object.
+ ((and (eq --category 'elements)
+ (eq (org-element-class --data) 'object)))
+ ;; In any other case, map contents.
+ (t (mapc --walk-tree (org-element-contents --data))))))))))
+ (catch :--map-first-match
+ (funcall --walk-tree data)
+ ;; Return value in a proper order.
+ (nreverse --acc)))))
(put 'org-element-map 'lisp-indent-function 2)
;; The following functions are internal parts of the parser.
@@ -4195,21 +4265,21 @@ otherwise. Modes can be either `first-section', `item',
`node-property', `planning', `property-drawer', `section',
`table-row' or nil."
(if parentp
- (case type
- (headline 'section)
- (inlinetask 'planning)
- (plain-list 'item)
- (property-drawer 'node-property)
- (section 'planning)
- (table 'table-row))
- (case type
- (item 'item)
- (node-property 'node-property)
- (planning 'property-drawer)
- (table-row 'table-row))))
+ (pcase type
+ (`headline 'section)
+ (`inlinetask 'planning)
+ (`plain-list 'item)
+ (`property-drawer 'node-property)
+ (`section 'planning)
+ (`table 'table-row))
+ (pcase type
+ (`item 'item)
+ (`node-property 'node-property)
+ (`planning 'property-drawer)
+ (`table-row 'table-row))))
(defun org-element--parse-elements
- (beg end mode structure granularity visible-only acc)
+ (beg end mode structure granularity visible-only acc)
"Parse elements between BEG and END positions.
MODE prioritizes some elements over the others. It can be set to
@@ -4235,49 +4305,49 @@ Elements are accumulated into ACC."
;; When parsing only headlines, skip any text before first one.
(when (and (eq granularity 'headline) (not (org-at-heading-p)))
(org-with-limited-levels (outline-next-heading)))
- ;; Main loop start.
- (while (< (point) end)
- ;; Find current element's type and parse it accordingly to
- ;; its category.
- (let* ((element (org-element--current-element
- end granularity mode structure))
- (type (org-element-type element))
- (cbeg (org-element-property :contents-begin element)))
- (goto-char (org-element-property :end element))
- ;; Visible only: skip invisible parts between siblings.
- (when (and visible-only (org-invisible-p2))
- (goto-char (min (1+ (org-find-visible)) end)))
- ;; Fill ELEMENT contents by side-effect.
- (cond
- ;; If element has no contents, don't modify it.
- ((not cbeg))
- ;; Greater element: parse it between `contents-begin' and
- ;; `contents-end'. Make sure GRANULARITY allows the
- ;; recursion, or ELEMENT is a headline, in which case going
- ;; inside is mandatory, in order to get sub-level headings.
- ((and (memq type org-element-greater-elements)
- (or (memq granularity '(element object nil))
- (and (eq granularity 'greater-element)
- (eq type 'section))
- (eq type 'headline)))
- (org-element--parse-elements
- cbeg (org-element-property :contents-end element)
- ;; Possibly switch to a special mode.
- (org-element--next-mode type t)
- (and (memq type '(item plain-list))
- (org-element-property :structure element))
- granularity visible-only element))
- ;; ELEMENT has contents. Parse objects inside, if
- ;; GRANULARITY allows it.
- ((memq granularity '(object nil))
- (org-element--parse-objects
- cbeg (org-element-property :contents-end element) element
- (org-element-restriction type))))
- (org-element-adopt-elements acc element)
- ;; Update mode.
- (setq mode (org-element--next-mode type nil))))
- ;; Return result.
- acc))
+ (let (elements)
+ (while (< (point) end)
+ ;; Find current element's type and parse it accordingly to
+ ;; its category.
+ (let* ((element (org-element--current-element
+ end granularity mode structure))
+ (type (org-element-type element))
+ (cbeg (org-element-property :contents-begin element)))
+ (goto-char (org-element-property :end element))
+ ;; Visible only: skip invisible parts between siblings.
+ (when (and visible-only (org-invisible-p2))
+ (goto-char (min (1+ (org-find-visible)) end)))
+ ;; Fill ELEMENT contents by side-effect.
+ (cond
+ ;; If element has no contents, don't modify it.
+ ((not cbeg))
+ ;; Greater element: parse it between `contents-begin' and
+ ;; `contents-end'. Make sure GRANULARITY allows the
+ ;; recursion, or ELEMENT is a headline, in which case going
+ ;; inside is mandatory, in order to get sub-level headings.
+ ((and (memq type org-element-greater-elements)
+ (or (memq granularity '(element object nil))
+ (and (eq granularity 'greater-element)
+ (eq type 'section))
+ (eq type 'headline)))
+ (org-element--parse-elements
+ cbeg (org-element-property :contents-end element)
+ ;; Possibly switch to a special mode.
+ (org-element--next-mode type t)
+ (and (memq type '(item plain-list))
+ (org-element-property :structure element))
+ granularity visible-only element))
+ ;; ELEMENT has contents. Parse objects inside, if
+ ;; GRANULARITY allows it.
+ ((memq granularity '(object nil))
+ (org-element--parse-objects
+ cbeg (org-element-property :contents-end element) element
+ (org-element-restriction type))))
+ (push (org-element-put-property element :parent acc) elements)
+ ;; Update mode.
+ (setq mode (org-element--next-mode type nil))))
+ ;; Return result.
+ (apply #'org-element-set-contents acc (nreverse elements)))))
(defun org-element--object-lex (restriction)
"Return next object in current buffer or nil.
@@ -4285,27 +4355,41 @@ RESTRICTION is a list of object types, as symbols, that should be
looked after. This function assumes that the buffer is narrowed
to an appropriate container (e.g., a paragraph)."
(if (memq 'table-cell restriction) (org-element-table-cell-parser)
- (save-excursion
- (let ((limit (and org-target-link-regexp
- (save-excursion
- (or (bolp) (backward-char))
- (re-search-forward org-target-link-regexp nil t))
- (match-beginning 1)))
- found)
+ (let* ((start (point))
+ (limit
+ (save-excursion
+ (cond ((not org-target-link-regexp) nil)
+ ((not (memq 'link restriction)) nil)
+ ((progn
+ (unless (bolp) (forward-char -1))
+ (not (re-search-forward org-target-link-regexp nil t)))
+ nil)
+ ;; Since we moved backward, we do not want to
+ ;; match again an hypothetical 1-character long
+ ;; radio link before us. Realizing that this can
+ ;; only happen if such a radio link starts at
+ ;; beginning of line, we prevent this here.
+ ((and (= start (1+ (line-beginning-position)))
+ (= start (match-end 1)))
+ (and (re-search-forward org-target-link-regexp nil t)
+ (match-beginning 1)))
+ (t (match-beginning 1)))))
+ found)
+ (save-excursion
(while (and (not found)
- (re-search-forward org-element--object-regexp limit t))
+ (re-search-forward org-element--object-regexp limit 'move))
(goto-char (match-beginning 0))
(let ((result (match-string 0)))
(setq found
(cond
- ((eq (compare-strings result nil nil "call_" nil nil t) t)
+ ((string-prefix-p "call_" result t)
(and (memq 'inline-babel-call restriction)
(org-element-inline-babel-call-parser)))
- ((eq (compare-strings result nil nil "src_" nil nil t) t)
+ ((string-prefix-p "src_" result t)
(and (memq 'inline-src-block restriction)
(org-element-inline-src-block-parser)))
(t
- (case (char-after)
+ (pcase (char-after)
(?^ (and (memq 'superscript restriction)
(org-element-superscript-parser)))
(?_ (or (and (memq 'subscript restriction)
@@ -4336,7 +4420,8 @@ to an appropriate container (e.g., a paragraph)."
(org-element-target-parser)))
(or (and (memq 'timestamp restriction)
(org-element-timestamp-parser))
- (and (memq 'link restriction)
+ (and (or (memq 'link restriction)
+ (memq 'simple-link restriction))
(org-element-link-parser)))))
(?\\
(if (eq (aref result 1) ?\\)
@@ -4357,60 +4442,63 @@ to an appropriate container (e.g., a paragraph)."
(and (memq 'statistics-cookie restriction)
(org-element-statistics-cookie-parser)))))
;; This is probably a plain link.
- (otherwise (and (or (memq 'link restriction)
- (memq 'plain-link restriction))
- (org-element-link-parser)))))))
+ (_ (and (or (memq 'link restriction)
+ (memq 'simple-link restriction))
+ (org-element-link-parser)))))))
(or (eobp) (forward-char))))
(cond (found)
- ;; Radio link.
- ((and limit (memq 'link restriction))
- (goto-char limit) (org-element-link-parser)))))))
+ (limit (org-element-link-parser)) ;radio link
+ (t nil))))))
-(defun org-element--parse-objects (beg end acc restriction)
+(defun org-element--parse-objects (beg end acc restriction &optional parent)
"Parse objects between BEG and END and return recursive structure.
-Objects are accumulated in ACC.
+Objects are accumulated in ACC. RESTRICTION is a list of object
+successors which are allowed in the current object.
-RESTRICTION is a list of object successors which are allowed in
-the current object."
+ACC becomes the parent for all parsed objects. However, if ACC
+is nil (i.e., a secondary string is being parsed) and optional
+argument PARENT is non-nil, use it as the parent for all objects.
+Eventually, if both ACC and PARENT are nil, the common parent is
+the list of objects itself."
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
- (let (next-object)
+ (let (next-object contents)
(while (and (not (eobp))
(setq next-object (org-element--object-lex restriction)))
- ;; 1. Text before any object. Untabify it.
+ ;; Text before any object.
(let ((obj-beg (org-element-property :begin next-object)))
(unless (= (point) obj-beg)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) obj-beg))))))
- ;; 2. Object...
+ (let ((text (buffer-substring-no-properties (point) obj-beg)))
+ (push (if acc (org-element-put-property text :parent acc) text)
+ contents))))
+ ;; Object...
(let ((obj-end (org-element-property :end next-object))
(cont-beg (org-element-property :contents-begin next-object)))
- ;; Fill contents of NEXT-OBJECT by side-effect, if it has
- ;; a recursive type.
- (when (and cont-beg
- (memq (car next-object) org-element-recursive-objects))
- (org-element--parse-objects
- cont-beg (org-element-property :contents-end next-object)
- next-object (org-element-restriction next-object)))
- (setq acc (org-element-adopt-elements acc next-object))
- (goto-char obj-end))))
- ;; 3. Text after last object. Untabify it.
- (unless (eobp)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) end)))))
- ;; Result.
- acc)))
+ (when acc (org-element-put-property next-object :parent acc))
+ (push (if cont-beg
+ ;; Fill contents of NEXT-OBJECT if possible.
+ (org-element--parse-objects
+ cont-beg
+ (org-element-property :contents-end next-object)
+ next-object
+ (org-element-restriction next-object))
+ next-object)
+ contents)
+ (goto-char obj-end)))
+ ;; Text after last object.
+ (unless (eobp)
+ (let ((text (buffer-substring-no-properties (point) end)))
+ (push (if acc (org-element-put-property text :parent acc) text)
+ contents)))
+ ;; Result. Set appropriate parent.
+ (if acc (apply #'org-element-set-contents acc (nreverse contents))
+ (let* ((contents (nreverse contents))
+ (parent (or parent contents)))
+ (dolist (datum contents contents)
+ (org-element-put-property datum :parent parent))))))))
@@ -4429,73 +4517,70 @@ the current object."
"Interpret DATA as Org syntax.
DATA is a parse tree, an element, an object or a secondary string
to interpret. Return Org syntax as a string."
- (org-element--interpret-data-1 data nil))
-
-(defun org-element--interpret-data-1 (data parent)
- "Interpret DATA as Org syntax.
-
-DATA is a parse tree, an element, an object or a secondary string
-to interpret. PARENT is used for recursive calls. It contains
-the element or object containing data, or nil.
-
-Return Org syntax as a string."
- (let* ((type (org-element-type data))
- ;; Find interpreter for current object or element. If it
- ;; doesn't exist (e.g. this is a pseudo object or element),
- ;; return contents, if any.
- (interpret
- (let ((fun (intern (format "org-element-%s-interpreter" type))))
- (if (fboundp fun) fun (lambda (data contents) contents))))
- (results
- (cond
- ;; Secondary string.
- ((not type)
- (mapconcat
- (lambda (obj) (org-element--interpret-data-1 obj parent)) data ""))
- ;; Full Org document.
- ((eq type 'org-data)
- (mapconcat (lambda (obj) (org-element--interpret-data-1 obj parent))
- (org-element-contents data) ""))
- ;; Plain text: return it.
- ((stringp data) data)
- ;; Element or object without contents.
- ((not (org-element-contents data)) (funcall interpret data nil))
- ;; Element or object with contents.
- (t
- (funcall interpret data
- ;; Recursively interpret contents.
- (mapconcat
- (lambda (obj) (org-element--interpret-data-1 obj data))
- (org-element-contents
- (if (not (memq type '(paragraph verse-block)))
- data
- ;; Fix indentation of elements containing
- ;; objects. We ignore `table-row' elements
- ;; as they are one line long anyway.
- (org-element-normalize-contents
- data
- ;; When normalizing first paragraph of an
- ;; item or a footnote-definition, ignore
- ;; first line's indentation.
- (and (eq type 'paragraph)
- (equal data (car (org-element-contents parent)))
- (memq (org-element-type parent)
- '(footnote-definition item))))))
- ""))))))
- (if (memq type '(org-data plain-text nil)) results
- ;; Build white spaces. If no `:post-blank' property is
- ;; specified, assume its value is 0.
- (let ((post-blank (or (org-element-property :post-blank data) 0)))
- (if (or (memq type org-element-all-objects)
- (and parent
- (let ((type (org-element-type parent)))
- (or (not type)
- (memq type org-element-object-containers)))))
- (concat results (make-string post-blank ?\s))
- (concat
- (org-element--interpret-affiliated-keywords data)
- (org-element-normalize-string results)
- (make-string post-blank ?\n)))))))
+ (letrec ((fun
+ (lambda (data parent)
+ (let* ((type (org-element-type data))
+ ;; Find interpreter for current object or
+ ;; element. If it doesn't exist (e.g. this is
+ ;; a pseudo object or element), return contents,
+ ;; if any.
+ (interpret
+ (let ((fun (intern
+ (format "org-element-%s-interpreter" type))))
+ (if (fboundp fun) fun (lambda (_ contents) contents))))
+ (results
+ (cond
+ ;; Secondary string.
+ ((not type)
+ (mapconcat (lambda (obj) (funcall fun obj parent))
+ data
+ ""))
+ ;; Full Org document.
+ ((eq type 'org-data)
+ (mapconcat (lambda (obj) (funcall fun obj parent))
+ (org-element-contents data)
+ ""))
+ ;; Plain text: return it.
+ ((stringp data) data)
+ ;; Element or object without contents.
+ ((not (org-element-contents data))
+ (funcall interpret data nil))
+ ;; Element or object with contents.
+ (t
+ (funcall
+ interpret
+ data
+ ;; Recursively interpret contents.
+ (mapconcat
+ (lambda (datum) (funcall fun datum data))
+ (org-element-contents
+ (if (not (memq type '(paragraph verse-block)))
+ data
+ ;; Fix indentation of elements containing
+ ;; objects. We ignore `table-row'
+ ;; elements as they are one line long
+ ;; anyway.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing first paragraph of
+ ;; an item or a footnote-definition,
+ ;; ignore first line's indentation.
+ (and (eq type 'paragraph)
+ (memq (org-element-type parent)
+ '(footnote-definition item))
+ (eq data
+ (car (org-element-contents parent)))))))
+ ""))))))
+ (if (memq type '(org-data plain-text nil)) results
+ ;; Build white spaces. If no `:post-blank' property
+ ;; is specified, assume its value is 0.
+ (let ((blank (or (org-element-property :post-blank data) 0)))
+ (if (eq (org-element-class data parent) 'object)
+ (concat results (make-string blank ?\s))
+ (concat (org-element--interpret-affiliated-keywords data)
+ (org-element-normalize-string results)
+ (make-string blank ?\n)))))))))
+ (funcall fun data nil)))
(defun org-element--interpret-affiliated-keywords (element)
"Return ELEMENT's affiliated keywords as Org syntax.
@@ -4529,14 +4614,14 @@ If there is no affiliated keyword, return the empty string."
;; List all ELEMENT's properties matching an attribute line or an
;; affiliated keyword, but ignore translated keywords since they
;; cannot belong to the property list.
- (loop for prop in (nth 1 element) by 'cddr
- when (let ((keyword (upcase (substring (symbol-name prop) 1))))
- (or (string-match "^ATTR_" keyword)
- (and
- (member keyword org-element-affiliated-keywords)
- (not (assoc keyword
- org-element-keyword-translation-alist)))))
- collect prop)
+ (cl-loop for prop in (nth 1 element) by 'cddr
+ when (let ((keyword (upcase (substring (symbol-name prop) 1))))
+ (or (string-match "^ATTR_" keyword)
+ (and
+ (member keyword org-element-affiliated-keywords)
+ (not (assoc keyword
+ org-element-keyword-translation-alist)))))
+ collect prop)
"")))
;; Because interpretation of the parse tree must return the same
@@ -4572,75 +4657,89 @@ If optional argument IGNORE-FIRST is non-nil, ignore first line's
indentation to compute maximal common indentation.
Return the normalized element that is element with global
-indentation removed from its contents. The function assumes that
-indentation is not done with TAB characters."
- (let* ((min-ind most-positive-fixnum)
- find-min-ind ; For byte-compiler.
- (find-min-ind
- ;; Return minimal common indentation within BLOB. This is
- ;; done by walking recursively BLOB and updating MIN-IND
- ;; along the way. FIRST-FLAG is non-nil when the next
- ;; object is expected to be a string that doesn't start with
- ;; a newline character. It happens for strings at the
- ;; beginnings of the contents or right after a line break.
- (lambda (blob first-flag)
- (dolist (object (org-element-contents blob))
- (when first-flag
- (setq first-flag nil)
- ;; Objects cannot start with spaces: in this case,
- ;; indentation is 0.
- (if (not (stringp object)) (throw 'zero (setq min-ind 0))
- (string-match "\\` *" object)
- (let ((len (match-end 0)))
- ;; An indentation of zero means no string will be
- ;; modified. Quit the process.
- (if (zerop len) (throw 'zero (setq min-ind 0))
- (setq min-ind (min len min-ind))))))
- (cond
- ((stringp object)
- (dolist (line (cdr (org-split-string object " *\n")))
- (unless (string= line "")
- (setq min-ind (min (org-get-indentation line) min-ind)))))
- ((eq (org-element-type object) 'line-break) (setq first-flag t))
- ((memq (org-element-type object) org-element-recursive-objects)
- (funcall find-min-ind object first-flag)))))))
- ;; Find minimal indentation in ELEMENT.
- (catch 'zero (funcall find-min-ind element (not ignore-first)))
+indentation removed from its contents."
+ (letrec ((find-min-ind
+ ;; Return minimal common indentation within BLOB. This is
+ ;; done by walking recursively BLOB and updating MIN-IND
+ ;; along the way. FIRST-FLAG is non-nil when the next
+ ;; object is expected to be a string that doesn't start
+ ;; with a newline character. It happens for strings at
+ ;; the beginnings of the contents or right after a line
+ ;; break.
+ (lambda (blob first-flag min-ind)
+ (catch 'zero
+ (dolist (datum (org-element-contents blob) min-ind)
+ (when first-flag
+ (setq first-flag nil)
+ (cond
+ ;; Objects cannot start with spaces: in this
+ ;; case, indentation is 0.
+ ((not (stringp datum)) (throw 'zero 0))
+ ((not (string-match
+ "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum))
+ (throw 'zero 0))
+ ((equal (match-string 2 datum) "\n")
+ (put-text-property
+ (match-beginning 1) (match-end 1) 'org-ind 'empty datum))
+ (t
+ (let ((i (string-width (match-string 1 datum))))
+ (put-text-property
+ (match-beginning 1) (match-end 1) 'org-ind i datum)
+ (setq min-ind (min i min-ind))))))
+ (cond
+ ((stringp datum)
+ (let ((s 0))
+ (while (string-match
+ "\n\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s)
+ (setq s (match-end 1))
+ (if (equal (match-string 2 datum) "\n")
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'org-ind 'empty
+ datum)
+ (let ((i (string-width (match-string 1 datum))))
+ (put-text-property
+ (match-beginning 1) (match-end 1) 'org-ind i datum)
+ (setq min-ind (min i min-ind)))))))
+ ((eq (org-element-type datum) 'line-break)
+ (setq first-flag t))
+ ((memq (org-element-type datum) org-element-recursive-objects)
+ (setq min-ind
+ (funcall find-min-ind datum first-flag min-ind))))))))
+ (min-ind (funcall find-min-ind
+ element (not ignore-first) most-positive-fixnum)))
(if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element
;; Build ELEMENT back, replacing each string with the same
;; string minus common indentation.
- (let* (build ; For byte compiler.
- (build
- (lambda (blob first-flag)
- ;; Return BLOB with all its strings indentation
- ;; shortened from MIN-IND white spaces. FIRST-FLAG is
- ;; non-nil when the next object is expected to be
- ;; a string that doesn't start with a newline
- ;; character.
- (setcdr (cdr blob)
- (mapcar
- (lambda (object)
- (when first-flag
- (setq first-flag nil)
- (when (stringp object)
- (setq object
- (replace-regexp-in-string
- (format "\\` \\{%d\\}" min-ind)
- "" object))))
- (cond
- ((stringp object)
- (replace-regexp-in-string
- (format "\n \\{%d\\}" min-ind) "\n" object))
- ((memq (org-element-type object)
- org-element-recursive-objects)
- (funcall build object first-flag))
- ((eq (org-element-type object) 'line-break)
- (setq first-flag t)
- object)
- (t object)))
- (org-element-contents blob)))
- blob)))
- (funcall build element (not ignore-first))))))
+ (letrec ((build
+ (lambda (datum)
+ ;; Return DATUM with all its strings indentation
+ ;; shortened from MIN-IND white spaces.
+ (setcdr
+ (cdr datum)
+ (mapcar
+ (lambda (object)
+ (cond
+ ((stringp object)
+ (with-temp-buffer
+ (insert object)
+ (let ((s (point-min)))
+ (while (setq s (text-property-not-all
+ s (point-max) 'org-ind nil))
+ (goto-char s)
+ (let ((i (get-text-property s 'org-ind)))
+ (delete-region s (progn
+ (skip-chars-forward " \t")
+ (point)))
+ (when (integerp i) (indent-to (- i min-ind))))))
+ (buffer-string)))
+ ((memq (org-element-type object)
+ org-element-recursive-objects)
+ (funcall build object))
+ (t object)))
+ (org-element-contents datum)))
+ datum)))
+ (funcall build element)))))
@@ -4722,7 +4821,7 @@ with `org-element--cache-compare'. This cache is used in
Key is an element, as returned by `org-element-at-point', and
value is an alist where each association is:
- \(PARENT COMPLETEP . OBJECTS)
+ (PARENT COMPLETEP . OBJECTS)
where PARENT is an element or object, COMPLETEP is a boolean,
non-nil when all direct children of parent are already cached and
@@ -4736,12 +4835,12 @@ contained within a paragraph
If the paragraph is completely parsed, OBJECTS-DATA will be
- \((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
- \(BOLD-OBJECT t ENTITY-OBJECT))
+ ((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
+ (BOLD-OBJECT t ENTITY-OBJECT))
whereas in a partially parsed paragraph, it could be
- \((PARAGRAPH nil ENTITY-OBJECT))
+ ((PARAGRAPH nil ENTITY-OBJECT))
This cache is used in `org-element-context'.")
@@ -4830,16 +4929,16 @@ the following rules:
gets a new level. Its value is the mean between LOWER and
UPPER:
- \(1 2) + (1 4) --> (1 3)
+ (1 2) + (1 4) --> (1 3)
- If LOWER has no value to compare with, it is assumed that its
value is `most-negative-fixnum'. E.g.,
- \(1 1) + (1 1 2)
+ (1 1) + (1 1 2)
is equivalent to
- \(1 1 m) + (1 1 2)
+ (1 1 m) + (1 1 2)
where m is `most-negative-fixnum'. Likewise, if UPPER is
short of levels, the current value is `most-positive-fixnum'.
@@ -4847,18 +4946,18 @@ the following rules:
- If they differ from only one, the new key inherits from
current LOWER level and fork it at the next level. E.g.,
- \(2 1) + (3 3)
+ (2 1) + (3 3)
is equivalent to
- \(2 1) + (2 M)
+ (2 1) + (2 M)
where M is `most-positive-fixnum'.
- If the key is only one level long, it is returned as an
integer:
- \(1 2) + (3 2) --> 2
+ (1 2) + (3 2) --> 2
When they are not equals, the function assumes that LOWER is
lesser than UPPER, per `org-element--cache-key-less-p'."
@@ -4976,10 +5075,10 @@ the cache."
(setq node nil
lower element
upper element)))))
- (case side
- (both (cons lower upper))
- ((nil) lower)
- (otherwise upper))))
+ (pcase side
+ (`both (cons lower upper))
+ (`nil lower)
+ (_ upper))))
(defun org-element--cache-put (element &optional data)
"Store ELEMENT in current buffer's cache, if allowed.
@@ -5053,8 +5152,8 @@ Properties are modified by side-effect."
(not (eq (org-element-type (plist-get properties :parent))
'item)))
(dolist (item (plist-get properties :structure))
- (incf (car item) offset)
- (incf (nth 6 item) offset)))
+ (cl-incf (car item) offset)
+ (cl-incf (nth 6 item) offset)))
(dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
(let ((value (and (or (not props) (memq key props))
(plist-get properties key))))
@@ -5093,7 +5192,7 @@ updated before current modification are actually submitted."
;; Request processed. Merge current and next offsets and
;; transfer ending position.
(when next
- (incf (aref next 3) (aref request 3))
+ (cl-incf (aref next 3) (aref request 3))
(aset next 2 (aref request 2)))
(setq org-element--cache-sync-requests
(cdr org-element--cache-sync-requests))))
@@ -5483,12 +5582,12 @@ that range. See `after-change-functions' for more information."
;; to both previous and current state. We make a special
;; case for headline editing: if a headline is modified but
;; not removed, do not extend.
- (when (case org-element--cache-change-warning
- ((t) t)
- (headline
+ (when (pcase org-element--cache-change-warning
+ (`t t)
+ (`headline
(not (and (org-with-limited-levels (org-at-heading-p))
(= (line-end-position) bottom))))
- (otherwise
+ (_
(let ((case-fold-search t))
(re-search-forward
org-element--cache-sensitive-re bottom t))))
@@ -5569,7 +5668,7 @@ change, as an integer."
;; Current changes can be merged with first sync request: we
;; can save a partial cache synchronization.
(progn
- (incf (aref next 3) offset)
+ (cl-incf (aref next 3) offset)
;; If last change happened within area to be removed, extend
;; boundaries of robust parents, if any. Otherwise, find
;; first element to remove and update request accordingly.
@@ -5619,7 +5718,8 @@ change, as an integer."
;; No element to remove. No need to re-parent either.
;; Simply shift additional elements, if any, by OFFSET.
(when org-element--cache-sync-requests
- (incf (aref (car org-element--cache-sync-requests) 3) offset)))))))
+ (cl-incf (aref (car org-element--cache-sync-requests) 3)
+ offset)))))))
;;;; Public Functions
@@ -5633,14 +5733,14 @@ buffers."
(dolist (buffer (if all (buffer-list) (list (current-buffer))))
(with-current-buffer buffer
(when (and org-element-use-cache (derived-mode-p 'org-mode))
- (org-set-local 'org-element--cache
- (avl-tree-create #'org-element--cache-compare))
- (org-set-local 'org-element--cache-objects (make-hash-table :test #'eq))
- (org-set-local 'org-element--cache-sync-keys
- (make-hash-table :weakness 'key :test #'eq))
- (org-set-local 'org-element--cache-change-warning nil)
- (org-set-local 'org-element--cache-sync-requests nil)
- (org-set-local 'org-element--cache-sync-timer nil)
+ (setq-local org-element--cache
+ (avl-tree-create #'org-element--cache-compare))
+ (setq-local org-element--cache-objects (make-hash-table :test #'eq))
+ (setq-local org-element--cache-sync-keys
+ (make-hash-table :weakness 'key :test #'eq))
+ (setq-local org-element--cache-change-warning nil)
+ (setq-local org-element--cache-sync-requests nil)
+ (setq-local org-element--cache-sync-timer nil)
(add-hook 'before-change-functions
#'org-element--cache-before-change nil t)
(add-hook 'after-change-functions
@@ -5772,15 +5872,16 @@ Providing it allows for quicker computation."
(throw 'objects-forbidden element)))))
;; At an headline or inlinetask, objects are in title.
((memq type '(headline inlinetask))
- (goto-char (org-element-property :begin element))
- (looking-at org-complex-heading-regexp)
- (let ((end (match-end 4)))
- (if (not end) (throw 'objects-forbidden element)
- (goto-char (match-beginning 4))
- (when (let (case-fold-search) (looking-at org-comment-string))
- (goto-char (match-end 0)))
- (if (>= (point) end) (throw 'objects-forbidden element)
- (narrow-to-region (point) end)))))
+ (let ((case-fold-search nil))
+ (goto-char (org-element-property :begin element))
+ (looking-at org-complex-heading-regexp)
+ (let ((end (match-end 4)))
+ (if (not end) (throw 'objects-forbidden element)
+ (goto-char (match-beginning 4))
+ (when (looking-at org-comment-string)
+ (goto-char (match-end 0)))
+ (if (>= (point) end) (throw 'objects-forbidden element)
+ (narrow-to-region (point) end))))))
;; At a paragraph, a table-row or a verse block, objects are
;; located within their contents.
((memq type '(paragraph table-row verse-block))
@@ -5988,7 +6089,7 @@ end of ELEM-A."
(goto-char beg-B)
(when specialp
(setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
- (org-indent-to-column ind-B))
+ (indent-to-column ind-B))
(insert body-A)
;; Restore ex ELEM-A overlays.
(let ((offset (- beg-B beg-A)))
@@ -6002,36 +6103,6 @@ end of ELEM-A."
(move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
(goto-char (org-element-property :end elem-B)))))
-(defun org-element-remove-indentation (s &optional n)
- "Remove maximum common indentation in string S and return it.
-When optional argument N is a positive integer, remove exactly
-that much characters from indentation, if possible, or return
-S as-is otherwise. Unlike to `org-remove-indentation', this
-function doesn't call `untabify' on S."
- (catch 'exit
- (with-temp-buffer
- (insert s)
- (goto-char (point-min))
- ;; Find maximum common indentation, if not specified.
- (setq n (or n
- (let ((min-ind (point-max)))
- (save-excursion
- (while (re-search-forward "^[ \t]*\\S-" nil t)
- (let ((ind (1- (current-column))))
- (if (zerop ind) (throw 'exit s)
- (setq min-ind (min min-ind ind))))))
- min-ind)))
- (if (zerop n) s
- ;; Remove exactly N indentation, but give up if not possible.
- (while (not (eobp))
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
- (cond ((eolp) (delete-region (line-beginning-position) (point)))
- ((< ind n) (throw 'exit s))
- (t (org-indent-line-to (- ind n))))
- (forward-line)))
- (buffer-string)))))
-
-
(provide 'org-element)
diff --git a/lisp/org-entities.el b/lisp/org-entities.el
index 89c5962..79b28e2 100644
--- a/lisp/org-entities.el
+++ b/lisp/org-entities.el
@@ -1,4 +1,4 @@
-;;; org-entities.el --- Support for special entities in Org-mode
+;;; org-entities.el --- Support for Special Entities -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -30,29 +30,24 @@
(declare-function org-toggle-pretty-entities "org" ())
(declare-function org-table-align "org-table" ())
-(eval-when-compile
- (require 'cl))
-
(defgroup org-entities nil
- "Options concerning entities in Org-mode."
+ "Options concerning entities in Org mode."
:tag "Org Entities"
:group 'org)
(defun org-entities--user-safe-p (v)
"Non-nil if V is a safe value for `org-entities-user'."
- (or (null v)
- (and (listp v)
- (= (length v) 7)
- (stringp (nth 0 v))
- (stringp (nth 1 v))
- (booleanp (nth 2 v))
- (stringp (nth 3 v))
- (stringp (nth 4 v))
- (stringp (nth 5 v))
- (stringp (nth 6 v)))))
+ (pcase v
+ (`nil t)
+ (`(,(and (pred stringp)
+ (pred (string-match-p "\\`[a-zA-Z][a-zA-Z0-9]*\\'")))
+ ,(pred stringp) ,(pred booleanp) ,(pred stringp)
+ ,(pred stringp) ,(pred stringp) ,(pred stringp))
+ t)
+ (_ nil)))
(defcustom org-entities-user nil
- "User-defined entities used in Org-mode to produce special characters.
+ "User-defined entities used in Org to produce special characters.
Each entry in this list is a list of strings. It associates the name
of the entity that can be inserted into an Org file as \\name with the
appropriate replacements for the different export backends. The order
@@ -93,6 +88,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("aacute" "\\'{a}" nil "&aacute;" "a" "á" "á")
("Acirc" "\\^{A}" nil "&Acirc;" "A" "Â" "Â")
("acirc" "\\^{a}" nil "&acirc;" "a" "â" "â")
+ ("Amacr" "\\bar{A}" nil "&Amacr;" "A" "Ã" "Ã")
+ ("amacr" "\\bar{a}" nil "&amacr;" "a" "ã" "ã")
("Atilde" "\\~{A}" nil "&Atilde;" "A" "Ã" "Ã")
("atilde" "\\~{a}" nil "&atilde;" "a" "ã" "ã")
("Auml" "\\\"{A}" nil "&Auml;" "Ae" "Ä" "Ä")
@@ -168,7 +165,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("beta" "\\beta" t "&beta;" "beta" "beta" "β")
("Gamma" "\\Gamma" t "&Gamma;" "Gamma" "Gamma" "Γ")
("gamma" "\\gamma" t "&gamma;" "gamma" "gamma" "γ")
- ("Delta" "\\Delta" t "&Delta;" "Delta" "Gamma" "Δ")
+ ("Delta" "\\Delta" t "&Delta;" "Delta" "Delta" "Δ")
("delta" "\\delta" t "&delta;" "delta" "delta" "δ")
("Epsilon" "E" nil "&Epsilon;" "Epsilon" "Epsilon" "Ε")
("epsilon" "\\epsilon" t "&epsilon;" "epsilon" "epsilon" "ε")
@@ -208,8 +205,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("upsih" "\\Upsilon" t "&upsih;" "upsilon" "upsilon" "ϒ")
("upsilon" "\\upsilon" t "&upsilon;" "upsilon" "upsilon" "υ")
("Phi" "\\Phi" t "&Phi;" "Phi" "Phi" "Φ")
- ("phi" "\\phi" t "&phi;" "phi" "phi" "φ")
- ("varphi" "\\varphi" t "&varphi;" "varphi" "varphi" "ɸ")
+ ("phi" "\\phi" t "&phi;" "phi" "phi" "ɸ")
+ ("varphi" "\\varphi" t "&varphi;" "varphi" "varphi" "φ")
("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
@@ -265,8 +262,9 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
"* Other"
"** Misc. (often used)"
- ("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
+ ("circ" "\\^{}" nil "&circ;" "^" "^" "∘")
("vert" "\\vert{}" t "&vert;" "|" "|" "|")
+ ("vbar" "|" nil "|" "|" "|" "|")
("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
("S" "\\S" nil "&sect;" "paragraph" "§" "§")
("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
@@ -285,7 +283,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("ddag" "\\ddag{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
"** Whitespace"
- ("nbsp" "~" nil "&nbsp;" " " " " " ")
+ ("nbsp" "~" nil "&nbsp;" " " "\x00A0" "\x00A0")
("ensp" "\\hspace*{.5em}" nil "&ensp;" " " " " " ")
("emsp" "\\hspace*{1em}" nil "&emsp;" " " " " " ")
("thinsp" "\\hspace*{.2em}" nil "&thinsp;" " " " " " ")
@@ -514,9 +512,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("loz" "\\lozenge" t "&loz;" "[lozenge]" "[lozenge]" "⧫"))
;; Add "\_ "-entity family for spaces.
(let (space-entities html-spaces (entity "_"))
- (dotimes (n 20 (nreverse space-entities))
- (let ((n (+ 1 n))
- (spaces (make-string n ?\s)))
+ (dolist (n (number-sequence 1 20) (nreverse space-entities))
+ (let ((spaces (make-string n ?\s)))
(push (list (setq entity (concat entity " "))
(format "\\hspace*{%sem}" (* n .5))
nil
@@ -539,29 +536,22 @@ This first checks the user list, then the built-in list."
(defun org-entities-create-table ()
"Create an Org mode table with all entities."
(interactive)
- (let ((pos (point)) e latex mathp html latin utf8 name ascii)
+ (let ((pos (point)))
(insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n")
- (mapc (lambda (e) (when (listp e)
- (setq name (car e)
- latex (nth 1 e)
- mathp (nth 2 e)
- html (nth 3 e)
- ascii (nth 4 e)
- latin (nth 5 e)
- utf8 (nth 6 e))
- (if (equal ascii "|") (setq ascii "\\vert"))
- (if (equal latin "|") (setq latin "\\vert"))
- (if (equal utf8 "|") (setq utf8 "\\vert"))
- (if (equal ascii "=>") (setq ascii "= >"))
- (if (equal latin "=>") (setq latin "= >"))
- (insert "|" name
- "|" (format "=%s=" latex)
- "|" (format (if mathp "$%s$" "$\\mbox{%s}$")
- latex)
- "|" (format "=%s=" html) "|" html
- "|" ascii "|" latin "|" utf8
- "|\n")))
- org-entities)
+ (dolist (e org-entities)
+ (pcase e
+ (`(,name ,latex ,mathp ,html ,ascii ,latin ,utf8)
+ (if (equal ascii "|") (setq ascii "\\vert"))
+ (if (equal latin "|") (setq latin "\\vert"))
+ (if (equal utf8 "|") (setq utf8 "\\vert"))
+ (if (equal ascii "=>") (setq ascii "= >"))
+ (if (equal latin "=>") (setq latin "= >"))
+ (insert "|" name
+ "|" (format "=%s=" latex)
+ "|" (format (if mathp "$%s$" "$\\mbox{%s}$") latex)
+ "|" (format "=%s=" html) "|" html
+ "|" ascii "|" latin "|" utf8
+ "|\n"))))
(goto-char pos)
(org-table-align)))
@@ -570,31 +560,27 @@ This first checks the user list, then the built-in list."
"Create a Help buffer with all available entities."
(interactive)
(with-output-to-temp-buffer "*Org Entity Help*"
- (princ "Org-mode entities\n=================\n\n")
+ (princ "Org mode entities\n=================\n\n")
(let ((ll (append '("* User-defined additions (variable org-entities-user)")
org-entities-user
org-entities))
- e latex mathp html latin utf8 name ascii
(lastwasstring t)
(head (concat
"\n"
" Symbol Org entity LaTeX code HTML code\n"
" -----------------------------------------------------------\n")))
- (while ll
- (setq e (pop ll))
- (if (stringp e)
- (progn
- (princ e)
- (princ "\n")
- (setq lastwasstring t))
- (if lastwasstring (princ head))
- (setq lastwasstring nil)
- (setq name (car e)
- latex (nth 1 e)
- html (nth 3 e)
- utf8 (nth 6 e))
- (princ (format " %-8s \\%-16s %-22s %-13s\n"
- utf8 name latex html))))))
+ (dolist (e ll)
+ (pcase e
+ (`(,name ,latex ,_ ,html ,_ ,_ ,utf8)
+ (when lastwasstring
+ (princ head)
+ (setq lastwasstring nil))
+ (princ (format " %-8s \\%-16s %-22s %-13s\n"
+ utf8 name latex html)))
+ ((pred stringp)
+ (princ e)
+ (princ "\n")
+ (setq lastwasstring t))))))
(with-current-buffer "*Org Entity Help*"
(org-mode)
(when org-pretty-entities
diff --git a/lisp/org-eshell.el b/lisp/org-eshell.el
index 9c1c4a1..6f9a18a 100644
--- a/lisp/org-eshell.el
+++ b/lisp/org-eshell.el
@@ -1,4 +1,4 @@
-;;; org-eshell.el - Support for links to working directories in eshell
+;;; org-eshell.el - Support for Links to Working Directories in Eshell -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@@ -27,8 +27,9 @@
(require 'eshell)
(require 'esh-mode)
-(org-add-link-type "eshell" 'org-eshell-open)
-(add-hook 'org-store-link-functions 'org-eshell-store-link)
+(org-link-set-parameters "eshell"
+ :follow #'org-eshell-open
+ :store #'org-eshell-store-link)
(defun org-eshell-open (link)
"Switch to am eshell buffer and execute a command line.
@@ -43,7 +44,7 @@
(eshell-buffer-name (car buffer-and-command))
(command (cadr buffer-and-command)))
(if (get-buffer eshell-buffer-name)
- (org-pop-to-buffer-same-window eshell-buffer-name)
+ (pop-to-buffer-same-window eshell-buffer-name)
(eshell))
(goto-char (point-max))
(eshell-kill-input)
diff --git a/lisp/org-eww.el b/lisp/org-eww.el
new file mode 100644
index 0000000..01ec905
--- /dev/null
+++ b/lisp/org-eww.el
@@ -0,0 +1,172 @@
+;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
+;; Keywords: link, eww
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+
+;; When this module is active `org-store-link' (often on key C-c l) in
+;; a eww buffer stores a link to the current url of the eww buffer.
+
+;; In an eww buffer function `org-eww-copy-for-org-mode' kills either
+;; a region or the whole buffer if no region is set and transforms the
+;; text on the fly so that it can be pasted into an Org buffer with
+;; hot links.
+
+;; C-c C-x C-w (and also C-c C-x M-w) trigger
+;; `org-eww-copy-for-org-mode'.
+
+;; Hint: A lot of code of this module comes from module org-w3m which
+;; has been written by Andy Steward based on the idea of Richard
+;; Riley. Thanks!
+
+;; Potential: Since the code for w3m and eww is so similar one could
+;; try to refactor.
+
+
+;;; Code:
+(require 'org)
+(require 'cl-lib)
+
+(defvar eww-current-title)
+(defvar eww-current-url)
+(defvar eww-data)
+(defvar eww-mode-map)
+
+(declare-function eww-current-url "eww")
+
+
+;; Store Org-link in eww-mode buffer
+(org-link-set-parameters "eww" :follow #'eww :store #'org-eww-store-link)
+(defun org-eww-store-link ()
+ "Store a link to the url of a Eww buffer."
+ (when (eq major-mode 'eww-mode)
+ (org-store-link-props
+ :type "eww"
+ :link (if (< emacs-major-version 25)
+ eww-current-url
+ (eww-current-url))
+ :url (url-view-url t)
+ :description (if (< emacs-major-version 25)
+ (or eww-current-title eww-current-url)
+ (or (plist-get eww-data :title)
+ (eww-current-url))))))
+
+
+;; Some auxiliary functions concerning links in eww buffers
+(defun org-eww-goto-next-url-property-change ()
+ "Move to the start of next link if exists.
+Otherwise point is not moved. Return point."
+ (goto-char
+ (or (next-single-property-change (point) 'shr-url)
+ (point))))
+
+(defun org-eww-has-further-url-property-change-p ()
+ "Non-nil if there is a next url property change."
+ (save-excursion
+ (not (eq (point) (org-eww-goto-next-url-property-change)))))
+
+(defun org-eww-url-below-point ()
+ "Return the url below point if there is an url; otherwise, return nil."
+ (get-text-property (point) 'shr-url))
+
+
+(defun org-eww-copy-for-org-mode ()
+ "Copy current buffer content or active region with `org-mode' style links.
+This will encode `link-title' and `link-location' with
+`org-make-link-string', and insert the transformed test into the kill ring,
+so that it can be yanked into an Org mode buffer with links working correctly.
+
+Further lines starting with a star get quoted with a comma to keep
+the structure of the Org file."
+ (interactive)
+ (let* ((regionp (org-region-active-p))
+ (transform-start (point-min))
+ (transform-end (point-max))
+ return-content
+ link-location link-title
+ temp-position out-bound)
+ (when regionp
+ (setq transform-start (region-beginning))
+ (setq transform-end (region-end))
+ ;; Deactivate mark if current mark is activate.
+ (when (fboundp 'deactivate-mark) (deactivate-mark)))
+ (message "Transforming links...")
+ (save-excursion
+ (goto-char transform-start)
+ (while (and (not out-bound) ; still inside region to copy
+ (org-eww-has-further-url-property-change-p)) ; there is a next link
+ ;; Store current point before jump next anchor.
+ (setq temp-position (point))
+ ;; Move to next anchor when current point is not at anchor.
+ (or (org-eww-url-below-point)
+ (org-eww-goto-next-url-property-change))
+ (cl-assert
+ (org-eww-url-below-point) t
+ "program logic error: point must have an url below but it hasn't")
+ (if (<= (point) transform-end) ; if point is inside transform bound
+ (progn
+ ;; Get content between two links.
+ (when (< temp-position (point))
+ (setq return-content (concat return-content
+ (buffer-substring
+ temp-position (point)))))
+ ;; Get link location at current point.
+ (setq link-location (org-eww-url-below-point))
+ ;; Get link title at current point.
+ (setq link-title
+ (buffer-substring
+ (point)
+ (org-eww-goto-next-url-property-change)))
+ ;; concat `org-mode' style url to `return-content'.
+ (setq return-content (concat return-content
+ (org-make-link-string
+ link-location link-title))))
+ (goto-char temp-position) ; reset point before jump next anchor
+ (setq out-bound t) ; for break out `while' loop
+ ))
+ ;; Add the rest until end of the region to be copied.
+ (when (< (point) transform-end)
+ (setq return-content
+ (concat return-content
+ (buffer-substring (point) transform-end))))
+ ;; Quote lines starting with *.
+ (org-kill-new (replace-regexp-in-string "^\\*" ",*" return-content))
+ (message "Transforming links...done, use C-y to insert text into Org mode file"))))
+
+
+;; Additional keys for eww-mode
+
+(defun org-eww-extend-eww-keymap ()
+ (define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode)
+ (define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode))
+
+(when (and (boundp 'eww-mode-map)
+ (keymapp eww-mode-map)) ; eww is already up.
+ (org-eww-extend-eww-keymap))
+
+(add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap)
+
+
+(provide 'org-eww)
+
+;;; org-eww.el ends here
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
index 941a604..96f7b8e 100644
--- a/lisp/org-faces.el
+++ b/lisp/org-faces.el
@@ -1,4 +1,4 @@
-;;; org-faces.el --- Face definitions for Org-mode.
+;;; org-faces.el --- Face definitions -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -28,19 +28,12 @@
;;; Code:
-(require 'org-macs)
-(require 'org-compat)
-
-(when (featurep 'xemacs)
- (put 'mode-line 'face-alias 'modeline))
-
(defgroup org-faces nil
- "Faces in Org-mode."
+ "Faces in Org mode."
:tag "Org Faces"
:group 'org-appearance)
-(defface org-default
- (org-compatible-face 'default nil)
+(defface org-default '((t :inherit default))
"Face used for default text."
:group 'org-faces)
@@ -52,99 +45,49 @@ The foreground color of this face should be equal to the background
color of the frame."
:group 'org-faces)
-(defface org-level-1 ;; originally copied from font-lock-function-name-face
- (org-compatible-face 'outline-1
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :bold t))
- (t (:bold t))))
+(defface org-level-1 '((t :inherit outline-1))
"Face used for level 1 headlines."
:group 'org-faces)
-(defface org-level-2 ;; originally copied from font-lock-variable-name-face
- (org-compatible-face 'outline-2
- '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 8) (background light)) (:foreground "yellow"))
- (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t))
- (t (:bold t))))
+(defface org-level-2 '((t :inherit outline-2))
"Face used for level 2 headlines."
:group 'org-faces)
-(defface org-level-3 ;; originally copied from font-lock-keyword-face
- (org-compatible-face 'outline-3
- '((((class color) (min-colors 88) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
- (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
- (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t))
- (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t))
- (t (:bold t))))
+(defface org-level-3 '((t :inherit outline-3))
"Face used for level 3 headlines."
:group 'org-faces)
-(defface org-level-4 ;; originally copied from font-lock-comment-face
- (org-compatible-face 'outline-4
- '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
- (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
- (((class color) (min-colors 16) (background light)) (:foreground "red"))
- (((class color) (min-colors 16) (background dark)) (:foreground "red1"))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:bold t))))
+(defface org-level-4 '((t :inherit outline-4))
"Face used for level 4 headlines."
:group 'org-faces)
-(defface org-level-5 ;; originally copied from font-lock-type-face
- (org-compatible-face 'outline-5
- '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
- (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))))
+(defface org-level-5 '((t :inherit outline-5))
"Face used for level 5 headlines."
:group 'org-faces)
-(defface org-level-6 ;; originally copied from font-lock-constant-face
- (org-compatible-face 'outline-6
- '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 8)) (:foreground "magenta"))))
+(defface org-level-6 '((t :inherit outline-6))
"Face used for level 6 headlines."
:group 'org-faces)
-(defface org-level-7 ;; originally copied from font-lock-builtin-face
- (org-compatible-face 'outline-7
- '((((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
- (((class color) (min-colors 8)) (:foreground "blue"))))
+(defface org-level-7 '((t :inherit outline-7))
"Face used for level 7 headlines."
:group 'org-faces)
-(defface org-level-8 ;; originally copied from font-lock-string-face
- (org-compatible-face 'outline-8
- '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (((class color) (min-colors 8)) (:foreground "green"))))
+(defface org-level-8 '((t :inherit outline-8))
"Face used for level 8 headlines."
:group 'org-faces)
-(defface org-special-keyword ;; originally copied from font-lock-string-face
- (org-compatible-face 'font-lock-keyword-face
- '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (t (:italic t))))
+(defface org-special-keyword '((t :inherit font-lock-keyword-face))
"Face used for special keywords."
:group 'org-faces)
-(defface org-drawer ;; originally copied from font-lock-function-name-face
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :bold t))
- (t (:bold t))))
+(defface org-drawer ;Copied from `font-lock-function-name-face'
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue" :bold t))
+ (t (:bold t)))
"Face used for drawers."
:group 'org-faces)
@@ -153,18 +96,17 @@ color of the frame."
:group 'org-faces)
(defface org-column
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light))
- (:background "grey90" :weight normal :slant normal :strike-through nil
- :underline nil))
- (((class color) (min-colors 16) (background dark))
- (:background "grey30" :weight normal :slant normal :strike-through nil
- :underline nil))
- (((class color) (min-colors 8))
- (:background "cyan" :foreground "black"
- :weight normal :slant normal :strike-through nil
- :underline nil))
- (t (:inverse-video t))))
+ '((((class color) (min-colors 16) (background light))
+ (:background "grey90" :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (((class color) (min-colors 16) (background dark))
+ (:background "grey30" :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black"
+ :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (t (:inverse-video t)))
"Face for column display of entry properties.
This is actually only part of the face definition for the text in column view.
The following faces apply, with this priority.
@@ -185,59 +127,33 @@ character (this might for example be the a TODO keyword) might still
shine through in some properties. So when your column view looks
funny, with \"random\" colors, weight, strike-through, try to explicitly
set the properties in the `org-column' face. For example, set
-:underline to nil, or the :slant to `normal'.
-
-Under XEmacs, the rules are simpler, because the XEmacs version of
-column view defines special faces for each outline level. See the file
-`org-colview-xemacs.el' in Org's contrib/ directory for details."
+:underline to nil, or the :slant to `normal'."
:group 'org-faces)
(defface org-column-title
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light))
- (:background "grey90" :underline t :weight bold))
- (((class color) (min-colors 16) (background dark))
- (:background "grey30" :underline t :weight bold))
- (((class color) (min-colors 8))
- (:background "cyan" :foreground "black" :underline t :weight bold))
- (t (:inverse-video t))))
+ '((((class color) (min-colors 16) (background light))
+ (:background "grey90" :underline t :weight bold))
+ (((class color) (min-colors 16) (background dark))
+ (:background "grey30" :underline t :weight bold))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black" :underline t :weight bold))
+ (t (:inverse-video t)))
"Face for column display of entry properties."
:group 'org-faces)
-(defface org-agenda-column-dateline
- (org-compatible-face 'org-column
- '((t nil)))
+(defface org-agenda-column-dateline '((t :inherit org-column))
"Face used in agenda column view for datelines with summaries."
:group 'org-faces)
-(defface org-warning
- (org-compatible-face 'font-lock-warning-face
- '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:bold t))))
+(defface org-warning '((t :inherit font-lock-warning-face))
"Face for deadlines and TODO keywords."
:group 'org-faces)
-(defface org-archived ; similar to shadow
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
+(defface org-archived '((t :inherit shadow))
"Face for headline with the ARCHIVE tag."
:group 'org-faces)
-(defface org-link
- (org-compatible-face 'link
- '((((class color) (background light)) (:foreground "Purple" :underline t))
- (((class color) (background dark)) (:foreground "Cyan" :underline t))
- (t (:underline t))))
+(defface org-link '((t :inherit link))
"Face for links."
:group 'org-faces)
@@ -270,12 +186,11 @@ column view defines special faces for each outline level. See the file
:group 'org-faces)
(defface org-date-selected
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t))
- (t (:inverse-video t))))
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t))
+ (t (:inverse-video t)))
"Face for highlighting the calendar day when using `org-read-date'.
Using a bold face here might cause discrepancies while displaying the
calendar."
@@ -288,43 +203,38 @@ calendar."
"Face for diary-like sexp date specifications."
:group 'org-faces)
-(defface org-tag
- '((t (:bold t)))
+(defface org-tag '((t (:bold t)))
"Default face for tags.
Note that the variable `org-tag-faces' can be used to overrule this face for
specific tags."
:group 'org-faces)
-(defface org-list-dt
- '((t (:bold t)))
+(defface org-list-dt '((t (:bold t)))
"Default face for definition terms in lists."
:group 'org-faces)
-(defface org-todo ; font-lock-warning-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:inverse-video t :bold t))))
+(defface org-todo ;Copied from `font-lock-warning-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:inverse-video t :bold t)))
"Face for TODO keywords."
:group 'org-faces)
-(defface org-done ;; originally copied from font-lock-type-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t))
- (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:bold t))))
+(defface org-done ;Copied from `font-lock-type-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t)))
"Face used for todo keywords that indicate DONE items."
:group 'org-faces)
-(defface org-agenda-done ;; originally copied from font-lock-type-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
- (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:bold nil))))
+(defface org-agenda-done ;Copied from `font-lock-type-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold nil)))
"Face used in agenda, to indicate lines switched to DONE.
This face is used to de-emphasize items that where brightly colored in the
agenda because they were things to do, or overdue. The DONE state itself
@@ -333,11 +243,10 @@ is of course immediately visible, but for example a passed deadline is
of the frame, for example."
:group 'org-faces)
-(defface org-headline-done ;; originally copied from font-lock-string-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (((class color) (min-colors 8) (background light)) (:bold nil))))
+(defface org-headline-done ;Copied from `font-lock-string-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
+ (((class color) (min-colors 8) (background light)) (:bold nil)))
"Face used to indicate that a headline is DONE.
This face is only used if `org-fontify-done-headline' is set. If applies
to the part of the headline after the DONE keyword."
@@ -375,11 +284,7 @@ determines if it is a foreground or a background color."
(string :tag "Color")
(sexp :tag "Face")))))
-(defface org-priority ;; originally copied from font-lock-string-face
- (org-compatible-face 'font-lock-keyword-face
- '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (t (:italic t))))
+(defface org-priority '((t :inherit font-lock-keyword-face))
"Face used for priority cookies."
:group 'org-faces)
@@ -408,19 +313,15 @@ determines if it is a foreground or a background color."
(setq org-tags-special-faces-re
(concat ":\\(" (mapconcat 'car value "\\|") "\\):"))))
-(defface org-checkbox
- (org-compatible-face 'bold
- '((t (:bold t))))
+(defface org-checkbox '((t :inherit bold))
"Face for checkboxes."
:group 'org-faces)
-(defface org-checkbox-statistics-todo
- '((t (:inherit org-todo)))
+(defface org-checkbox-statistics-todo '((t (:inherit org-todo)))
"Face used for unfinished checkbox statistics."
:group 'org-faces)
-(defface org-checkbox-statistics-done
- '((t (:inherit org-done)))
+(defface org-checkbox-statistics-done '((t (:inherit org-done)))
"Face used for finished checkbox statistics."
:group 'org-faces)
@@ -444,43 +345,31 @@ changes."
(string :tag "Foreground color")
(sexp :tag "Face")))))
-(defface org-table ;; originally copied from font-lock-function-name-face
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8) (background light)) (:foreground "blue"))
- (((class color) (min-colors 8) (background dark)))))
+(defface org-table ;Copied from `font-lock-function-name-face'
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8) (background light)) (:foreground "blue"))
+ (((class color) (min-colors 8) (background dark))))
"Face used for tables."
:group 'org-faces)
(defface org-formula
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
- (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
- (((class color) (min-colors 8) (background light)) (:foreground "red"))
- (((class color) (min-colors 8) (background dark)) (:foreground "red"))
- (t (:bold t :italic t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red"))
+ (t (:bold t :italic t)))
"Face for formulas."
:group 'org-faces)
-(defface org-code
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
+(defface org-code '((t :inherit shadow))
"Face for fixed-width text like code snippets."
:group 'org-faces
:version "22.1")
-(defface org-meta-line
- (org-compatible-face 'font-lock-comment-face nil)
+(defface org-meta-line '((t :inherit font-lock-comment-face))
"Face for meta lines starting with \"#+\"."
:group 'org-faces
:version "22.1")
@@ -500,64 +389,35 @@ changes."
follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
:group 'org-faces)
-(defface org-document-info-keyword
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
+(defface org-document-info-keyword '((t :inherit shadow))
"Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords."
:group 'org-faces)
-(defface org-block
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
- "Face text in #+begin ... #+end blocks."
+(defface org-block '((t :inherit shadow))
+ "Face text in #+begin ... #+end blocks.
+For source-blocks `org-src-block-faces' takes precedence.
+See also `org-fontify-quote-and-verse-blocks'."
:group 'org-faces
- :version "22.1")
+ :version "25.2")
-(defface org-block-begin-line
- '((t (:inherit org-meta-line)))
+(defface org-block-begin-line '((t (:inherit org-meta-line)))
"Face used for the line delimiting the begin of source blocks."
:group 'org-faces)
-(defface org-block-end-line
- '((t (:inherit org-block-begin-line)))
+(defface org-block-end-line '((t (:inherit org-block-begin-line)))
"Face used for the line delimiting the end of source blocks."
:group 'org-faces)
-(defface org-verbatim
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50" :underline t))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70" :underline t))
- (((class color) (min-colors 8) (background light))
- (:foreground "green" :underline t))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow" :underline t))))
- "Face for fixed-with text like code snippets."
+(defface org-verbatim '((t (:inherit shadow)))
+ "Face for fixed-with text like code snippets"
:group 'org-faces
:version "22.1")
-(defface org-quote
- '((t (:inherit org-block)))
+(defface org-quote '((t (:inherit org-block)))
"Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks."
:group 'org-faces)
-(defface org-verse
- '((t (:inherit org-block)))
+(defface org-verse '((t (:inherit org-block)))
"Face for #+BEGIN_VERSE ... #+END_VERSE blocks."
:group 'org-faces)
@@ -569,35 +429,32 @@ content of these blocks will still be treated as Org syntax."
:version "24.1"
:type 'boolean)
-(defface org-clock-overlay ;; copied from secondary-selection
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light))
- (:background "LightGray" :foreground "black"))
- (((class color) (min-colors 88) (background dark))
- (:background "SkyBlue4" :foreground "white"))
- (((class color) (min-colors 16) (background light))
- (:background "gray" :foreground "black"))
- (((class color) (min-colors 16) (background dark))
- (:background "SkyBlue4" :foreground "white"))
- (((class color) (min-colors 8))
- (:background "cyan" :foreground "black"))
- (t (:inverse-video t))))
+(defface org-clock-overlay ;Copied from `secondary-selection'
+ '((((class color) (min-colors 88) (background light))
+ (:background "LightGray" :foreground "black"))
+ (((class color) (min-colors 88) (background dark))
+ (:background "SkyBlue4" :foreground "white"))
+ (((class color) (min-colors 16) (background light))
+ (:background "gray" :foreground "black"))
+ (((class color) (min-colors 16) (background dark))
+ (:background "SkyBlue4" :foreground "white"))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black"))
+ (t (:inverse-video t)))
"Basic face for displaying the secondary selection."
:group 'org-faces)
-(defface org-agenda-structure ;; originally copied from font-lock-function-name-face
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :bold t))
- (t (:bold t))))
+(defface org-agenda-structure ;Copied from `font-lock-function-name-face'
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue" :bold t))
+ (t (:bold t)))
"Face used in agenda for captions and dates."
:group 'org-faces)
-(defface org-agenda-date
- '((t (:inherit org-agenda-structure)))
+(defface org-agenda-date '((t (:inherit org-agenda-structure)))
"Face used in agenda for normal days."
:group 'org-faces)
@@ -606,13 +463,11 @@ content of these blocks will still be treated as Org syntax."
"Face used in agenda for today."
:group 'org-faces)
-(defface org-agenda-clocking
- '((t (:inherit secondary-selection)))
+(defface org-agenda-clocking '((t (:inherit secondary-selection)))
"Face marking the current clock item in the agenda."
:group 'org-faces)
-(defface org-agenda-date-weekend
- '((t (:inherit org-agenda-date :weight bold)))
+(defface org-agenda-date-weekend '((t (:inherit org-agenda-date :weight bold)))
"Face used in agenda for weekend days.
See the variable `org-agenda-weekend-days' for a definition of
@@ -620,20 +475,18 @@ which days belong to the weekend."
:group 'org-faces)
(defface org-scheduled
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
- (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:bold t :italic t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t :italic t)))
"Face for items scheduled for a certain day."
:group 'org-faces)
(defface org-scheduled-today
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
- (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:bold t :italic t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t :italic t)))
"Face for items scheduled for a certain day."
:group 'org-faces)
@@ -644,22 +497,20 @@ which days belong to the weekend."
:group 'org-faces)
(defface org-scheduled-previously
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
- (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
- (((class color) (min-colors 8) (background light)) (:foreground "red"))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:bold t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t)))
"Face for items scheduled previously, and not yet done."
:group 'org-faces)
(defface org-upcoming-deadline
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
- (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
- (((class color) (min-colors 8) (background light)) (:foreground "red"))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:bold t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t)))
"Face for items scheduled previously, and not yet done."
:group 'org-faces)
@@ -689,67 +540,57 @@ month and 365.24 days for a year)."
(sexp :tag "Face"))))
(defface org-agenda-restriction-lock
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:background "#eeeeee"))
- (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C"))
- (((class color) (min-colors 16) (background light)) (:background "#eeeeee"))
- (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C"))
- (((class color) (min-colors 8)) (:background "cyan" :foreground "black"))
- (t (:inverse-video t))))
+ '((((class color) (min-colors 88) (background light)) (:background "#eeeeee"))
+ (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C"))
+ (((class color) (min-colors 16) (background light)) (:background "#eeeeee"))
+ (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C"))
+ (((class color) (min-colors 8)) (:background "cyan" :foreground "black"))
+ (t (:inverse-video t)))
"Face for showing the agenda restriction lock."
:group 'org-faces)
-(defface org-agenda-filter-tags
- (org-compatible-face 'mode-line nil)
+(defface org-agenda-filter-tags '((t :inherit mode-line))
"Face for tag(s) in the mode-line when filtering the agenda."
:group 'org-faces)
-(defface org-agenda-filter-regexp
- (org-compatible-face 'mode-line nil)
+(defface org-agenda-filter-regexp '((t :inherit mode-line))
"Face for regexp(s) in the mode-line when filtering the agenda."
:group 'org-faces)
-(defface org-agenda-filter-category
- (org-compatible-face 'mode-line nil)
+(defface org-agenda-filter-category '((t :inherit mode-line))
"Face for categories(s) in the mode-line when filtering the agenda."
:group 'org-faces)
-(defface org-time-grid ;; originally copied from font-lock-variable-name-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
+(defface org-time-grid ;Copied from `font-lock-variable-name-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
+ (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))
"Face used for time grids."
:group 'org-faces)
-(defface org-agenda-current-time
- '((t (:inherit org-time-grid)))
+(defface org-agenda-current-time '((t (:inherit org-time-grid)))
"Face used to show the current time in the time grid."
:group 'org-faces)
-(defface org-agenda-diary
- (org-compatible-face 'default nil)
+(defface org-agenda-diary '((t :inherit default))
"Face used for agenda entries that come from the Emacs diary."
:group 'org-faces)
-(defface org-agenda-calendar-event
- (org-compatible-face 'default nil)
+(defface org-agenda-calendar-event '((t :inherit default))
"Face used to show events and appointments in the agenda."
:group 'org-faces)
-(defface org-agenda-calendar-sexp
- (org-compatible-face 'default nil)
+(defface org-agenda-calendar-sexp '((t :inherit default))
"Face used to show events computed from a S-expression."
:group 'org-faces)
(defconst org-level-faces
'(org-level-1 org-level-2 org-level-3 org-level-4
- org-level-5 org-level-6 org-level-7 org-level-8
- ))
+ org-level-5 org-level-6 org-level-7 org-level-8))
(defcustom org-n-level-faces (length org-level-faces)
"The number of different faces to be used for headlines.
-Org-mode defines 8 different headline faces, so this can be at most 8.
+Org mode defines 8 different headline faces, so this can be at most 8.
If it is less than 8, the level-1 face gets re-used for level N+1 etc."
:type 'integer
:group 'org-faces)
@@ -782,22 +623,19 @@ level org-n-level-faces"
:version "24.4"
:package-version '(Org . "8.0"))
-(defface org-macro
- (org-compatible-face 'org-latex-and-related nil)
+(defface org-macro '((t :inherit org-latex-and-related))
"Face for macros."
:group 'org-faces
:version "24.4"
:package-version '(Org . "8.0"))
-(defface org-tag-group
- (org-compatible-face 'org-tag nil)
+(defface org-tag-group '((t :inherit org-tag))
"Face for group tags."
:group 'org-faces
:version "24.4"
:package-version '(Org . "8.0"))
-(defface org-mode-line-clock
- '((t (:inherit mode-line)))
+(defface org-mode-line-clock '((t (:inherit mode-line)))
"Face used for clock display in mode line."
:group 'org-faces)
diff --git a/lisp/org-feed.el b/lisp/org-feed.el
index 0600f63..0c3cd05 100644
--- a/lisp/org-feed.el
+++ b/lisp/org-feed.el
@@ -1,4 +1,4 @@
-;;; org-feed.el --- Add RSS feed items to Org files
+;;; org-feed.el --- Add RSS feed items to Org files -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;;
@@ -24,11 +24,11 @@
;;
;;; Commentary:
;;
-;; This module allows entries to be created and changed in an Org-mode
-;; file triggered by items in an RSS feed. The basic functionality is
-;; geared toward simply adding new items found in a feed as outline nodes
-;; to an Org file. Using hooks, arbitrary actions can be triggered for
-;; new or changed items.
+;; This module allows entries to be created and changed in an Org mode
+;; file triggered by items in an RSS feed. The basic functionality
+;; is geared toward simply adding new items found in a feed as
+;; outline nodes to an Org file. Using hooks, arbitrary actions can
+;; be triggered for new or changed items.
;;
;; Selecting feeds and target locations
;; ------------------------------------
@@ -77,10 +77,8 @@
;; org-feed.el needs to keep track of which feed items have been handled
;; before, so that they will not be handled again. For this, org-feed.el
;; stores information in a special drawer, FEEDSTATUS, under the heading
-;; that received the input of the feed. You should add FEEDSTATUS
-;; to your list of drawers in the files that receive feed input:
+;; that received the input of the feed.
;;
-;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS
;;
;; Acknowledgments
;; ---------------
@@ -93,7 +91,8 @@
(require 'org)
(require 'sha1)
-(declare-function url-retrieve-synchronously "url" (url))
+(declare-function url-retrieve-synchronously "url"
+ (url &optional silent inhibit-cookies timeout))
(declare-function xml-node-children "xml" (node))
(declare-function xml-get-children "xml" (node child-name))
(declare-function xml-get-attribute "xml" (node attribute))
@@ -101,8 +100,8 @@
(declare-function xml-substitute-special "xml" (string))
(declare-function org-capture-escaped-% "org-capture" ())
+(declare-function org-capture-expand-embedded-elisp "org-capture" (&optional mark))
(declare-function org-capture-inside-embedded-elisp-p "org-capture" ())
-(declare-function org-capture-expand-embedded-elisp "org-capture" ())
(defgroup org-feed nil
"Options concerning RSS feeds as inputs for Org files."
@@ -314,7 +313,7 @@ it can be a list structured like an entry in `org-feed-alist'."
(parse-entry (or (nth 1 (memq :parse-entry feed))
'org-feed-parse-rss-entry))
feed-buffer inbox-pos new-formatted
- entries old-status status new changed guid-alist e guid olds)
+ entries old-status status new changed guid-alist guid olds)
(setq feed-buffer (org-feed-get-feed url))
(unless (and feed-buffer (bufferp (get-buffer feed-buffer)))
(error "Cannot get feed %s" name))
@@ -407,7 +406,7 @@ it can be a list structured like an entry in `org-feed-alist'."
;; Normalize the visibility of the inbox tree
(goto-char inbox-pos)
(outline-hide-subtree)
- (outline-show-children)
+ (org-show-children)
(org-cycle-hide-drawers 'children)
;; Hooks and messages
@@ -441,7 +440,7 @@ it can be a list structured like an entry in `org-feed-alist'."
(if (stringp feed) (setq feed (assoc feed org-feed-alist)))
(unless feed
(error "No such feed in `org-feed-alist"))
- (org-pop-to-buffer-same-window
+ (pop-to-buffer-same-window
(org-feed-update feed 'retrieve-only))
(goto-char (point-min)))
@@ -476,8 +475,7 @@ This will find DRAWER and extract the alist."
"Write the feed STATUS to DRAWER in entry at POS."
(save-excursion
(goto-char pos)
- (let ((end (save-excursion (org-end-of-subtree t t)))
- guid)
+ (let ((end (save-excursion (org-end-of-subtree t t))))
(if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n")
end t)
(progn
@@ -513,66 +511,77 @@ ENTRY is a property list. This function adds a `:formatted-for-org' property
and returns the full property list.
If that property is already present, nothing changes."
(require 'org-capture)
- (if formatter
- (funcall formatter entry)
- (let (dlines time escape name tmp
- v-h v-t v-T v-u v-U v-a)
- (setq dlines (org-split-string (or (plist-get entry :description) "???")
- "\n")
- v-h (or (plist-get entry :title) (car dlines) "???")
- time (or (if (plist-get entry :pubDate)
- (org-read-date t t (plist-get entry :pubDate)))
- (current-time))
- v-t (format-time-string (org-time-stamp-format nil nil) time)
- v-T (format-time-string (org-time-stamp-format t nil) time)
- v-u (format-time-string (org-time-stamp-format nil t) time)
- v-U (format-time-string (org-time-stamp-format t t) time)
- v-a (if (setq tmp (or (and (plist-get entry :guid-permalink)
- (plist-get entry :guid))
- (plist-get entry :link)))
- (concat "[[" tmp "]]\n")
- ""))
+ (if formatter (funcall formatter entry)
+ (let* ((dlines
+ (org-split-string (or (plist-get entry :description) "???")
+ "\n"))
+ (time (or (if (plist-get entry :pubDate)
+ (org-read-date t t (plist-get entry :pubDate)))
+ (current-time)))
+ (v-h (or (plist-get entry :title) (car dlines) "???"))
+ (v-t (format-time-string (org-time-stamp-format nil nil) time))
+ (v-T (format-time-string (org-time-stamp-format t nil) time))
+ (v-u (format-time-string (org-time-stamp-format nil t) time))
+ (v-U (format-time-string (org-time-stamp-format t t) time))
+ (v-a (let ((tmp (or (and (plist-get entry :guid-permalink)
+ (plist-get entry :guid))
+ (plist-get entry :link))))
+ (if tmp (format "[[%s]]\n" tmp ) ""))))
(with-temp-buffer
- (insert template)
-
- ;; Simple %-escapes
- ;; before embedded elisp to support simple %-escapes as
- ;; arguments for embedded elisp
- (goto-char (point-min))
- (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
- (unless (org-capture-escaped-%)
- (setq name (match-string 1)
- escape (org-capture-inside-embedded-elisp-p))
- (cond
- ((member name '("h" "t" "T" "u" "U" "a"))
- (setq tmp (symbol-value (intern (concat "v-" name)))))
- ((setq tmp (plist-get entry (intern (concat ":" name))))
- (save-excursion
- (save-match-data
- (beginning-of-line 1)
- (when (looking-at
- (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
- (setq tmp (org-feed-make-indented-block
- tmp (org-get-indentation))))))))
- (when tmp
- ;; escape string delimiters `"' when inside %() embedded lisp
- (when escape
- (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp)))
- (replace-match tmp t t))))
-
- ;; %() embedded elisp
- (org-capture-expand-embedded-elisp)
-
- (decode-coding-string
- (buffer-string) (detect-coding-region (point-min) (point-max) t))))))
+ (insert template)
+ (goto-char (point-min))
+
+ ;; Mark %() embedded elisp for later evaluation.
+ (org-capture-expand-embedded-elisp 'mark)
+
+ ;; Simple %-escapes. `org-capture-escaped-%' may modify
+ ;; buffer and cripple match-data. Use markers instead.
+ (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
+ (let ((key (match-string 1))
+ (beg (copy-marker (match-beginning 0)))
+ (end (copy-marker (match-end 0))))
+ (unless (org-capture-escaped-%)
+ (delete-region beg end)
+ (set-marker beg nil)
+ (set-marker end nil)
+ (let ((replacement
+ (pcase key
+ ("h" v-h)
+ ("t" v-t)
+ ("T" v-T)
+ ("u" v-u)
+ ("U" v-U)
+ ("a" v-a)
+ (name
+ (let ((v (plist-get entry (intern (concat ":" name)))))
+ (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (if (looking-at
+ (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
+ (org-feed-make-indented-block
+ v (org-get-indentation))
+ v))))))))
+ (when replacement
+ (insert
+ ;; Escape string delimiters within embedded lisp.
+ (if (org-capture-inside-embedded-elisp-p)
+ (replace-regexp-in-string "\"" "\\\\\"" replacement)
+ replacement)))))))
+
+ ;; %() embedded elisp
+ (org-capture-expand-embedded-elisp)
+
+ (decode-coding-string
+ (buffer-string) (detect-coding-region (point-min) (point-max) t))))))
(defun org-feed-make-indented-block (s n)
"Add indentation of N spaces to a multiline string S."
(if (not (string-match "\n" s))
s
(mapconcat 'identity
- (org-split-string s "\n")
- (concat "\n" (make-string n ?\ )))))
+ (org-split-string s "\n")
+ (concat "\n" (make-string n ?\ )))))
(defun org-feed-skip-http-headers (buffer)
"Remove HTTP headers from BUFFER, and return it.
@@ -616,7 +625,7 @@ containing the properties `:guid' and `:item-full-text'."
(match-beginning 0)))
(setq item (buffer-substring beg end)
guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item)
- (xml-substitute-special (org-match-string-no-properties 1 item))))
+ (xml-substitute-special (match-string-no-properties 1 item))))
(setq entry (list :guid guid :item-full-text item))
(push entry entries)
(widen)
diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el
index 800b5df..5b60a19 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -1,4 +1,4 @@
-;;; org-footnote.el --- Footnote support in Org and elsewhere
+;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;;
@@ -24,33 +24,28 @@
;;
;;; Commentary:
-;; This file contains the code dealing with footnotes in Org-mode.
-;; The code can also be used in arbitrary text modes to provide
-;; footnotes. Compared to Steven L Baur's footnote.el it provides
-;; better support for resuming editing. It is less configurable than
-;; Steve's code, though.
+;; This file contains the code dealing with footnotes in Org mode.
;;; Code:
-(eval-when-compile
- (require 'cl))
+;;;; Declarations
+
+(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
-(declare-function message-point-in-header-p "message" ())
(declare-function org-at-comment-p "org" ())
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-back-over-empty-lines "org" ())
-(declare-function org-back-to-heading "org" (&optional invisible-ok))
-(declare-function org-combine-plists "org" (&rest plists))
(declare-function org-edit-footnote-reference "org-src" ())
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-class "org-element" (datum &optional parent))
(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-fill-paragraph "org" (&optional justify))
-(declare-function org-icompleting-read "org" (&rest args))
-(declare-function org-id-uuid "org-id" ())
(declare-function org-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-in-verbatim-emphasis "org" ())
@@ -58,45 +53,39 @@
(declare-function org-inside-latex-macro-p "org" ())
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-show-context "org" (&optional key))
-(declare-function org-skip-whitespace "org" ())
-(declare-function org-skip-whitespace "org" ())
-(declare-function org-trim "org" (s))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function outline-next-heading "outline")
-(defvar message-cite-prefix-regexp) ; defined in message.el
-(defvar message-signature-separator) ; defined in message.el
+(defvar electric-indent-mode)
+(defvar org-blank-before-new-entry) ; defined in org.el
(defvar org-bracket-link-regexp) ; defined in org.el
(defvar org-complex-heading-regexp) ; defined in org.el
-(defvar org-element-all-elements) ; defined in org-element.el
-(defvar org-element-all-objects) ; defined in org-element.el
(defvar org-odd-levels-only) ; defined in org.el
+(defvar org-outline-regexp) ; defined in org.el
(defvar org-outline-regexp-bol) ; defined in org.el
+
+;;;; Constants
+
(defconst org-footnote-re
- ;; Only [1]-like footnotes are closed in this regexp, as footnotes
- ;; from other types might contain square brackets (i.e. links) in
- ;; their definition.
- ;;
- ;; `org-re' is used for regexp compatibility with XEmacs.
- (concat "\\[\\(?:"
- ;; Match inline footnotes.
- (org-re "fn:\\([-_[:word:]]+\\)?:\\|")
- ;; Match other footnotes.
- "\\(?:\\([0-9]+\\)\\]\\)\\|"
- (org-re "\\(fn:[-_[:word:]]+\\)")
- "\\)")
- "Regular expression for matching footnotes.")
-
-(defconst org-footnote-definition-re
- (org-re "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]")
- "Regular expression matching the definition of a footnote.")
-
-(defconst org-footnote-forbidden-blocks
- '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src")
+ "\\[fn:\\(?:\\(?1:[-_[:word:]]+\\)?\\(:\\)\\|\\(?1:[-_[:word:]]+\\)\\]\\)"
+ "Regular expression for matching footnotes.
+Match group 1 contains footnote's label. It is nil for anonymous
+footnotes. Match group 2 is non-nil only when footnote is
+inline, i.e., it contains its own definition.")
+
+(defconst org-footnote-definition-re "^\\[fn:\\([-_[:word:]]+\\)\\]"
+ "Regular expression matching the definition of a footnote.
+Match group 1 contains definition's label.")
+
+(defconst org-footnote-forbidden-blocks '("comment" "example" "export" "src")
"Names of blocks where footnotes are not allowed.")
+
+;;;; Customization
+
(defgroup org-footnote nil
- "Footnotes in Org-mode."
+ "Footnotes in Org mode."
:tag "Org Footnote"
:group 'org)
@@ -118,7 +107,7 @@ this heading will be ignored.
If you don't use the customize interface to change this variable,
you will need to run the following command after the change:
- \\[universal-argument] \\[org-element-cache-reset]"
+ `\\[universal-argument] \\[org-element-cache-reset]'"
:group 'org-footnote
:initialize 'custom-initialize-default
:set (lambda (var val)
@@ -129,20 +118,6 @@ you will need to run the following command after the change:
(string :tag "Collect footnotes under heading")
(const :tag "Define footnotes locally" nil)))
-(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:"
- "Tag marking the beginning of footnote section.
-The Org footnote engine can be used in arbitrary text files as well
-as in Org-mode. Outside Org mode, new footnotes are always placed at
-the end of the file. When you normalize the notes, any line containing
-only this tag will be removed, a new one will be inserted at the end
-of the file, followed by the collected and normalized footnotes.
-
-If you don't want any tag in such buffers, set this variable to nil."
- :group 'org-footnote
- :type '(choice
- (string :tag "Collect footnotes under tag")
- (const :tag "Don't use a tag" nil)))
-
(defcustom org-footnote-define-inline nil
"Non-nil means define footnotes inline, at reference location.
When nil, footnotes will be defined in a special section near
@@ -160,15 +135,13 @@ t Create unique labels of the form [fn:1], [fn:2], etc.
confirm Like t, but let the user edit the created value.
The label can be removed from the minibuffer to create
an anonymous footnote.
-random Automatically generate a unique, random label.
-plain Automatically create plain number labels like [1]."
+random Automatically generate a unique, random label."
:group 'org-footnote
:type '(choice
(const :tag "Prompt for label" nil)
(const :tag "Create automatic [fn:N]" t)
(const :tag "Offer automatic [fn:N] for editing" confirm)
- (const :tag "Create a random label" random)
- (const :tag "Create automatic [N]" plain)))
+ (const :tag "Create a random label" random)))
(defcustom org-footnote-auto-adjust nil
"Non-nil means automatically adjust footnotes after insert/delete.
@@ -196,6 +169,9 @@ extracted will be filled again."
:group 'org-footnote
:type 'boolean)
+
+;;;; Predicates
+
(defun org-footnote-in-valid-context-p ()
"Is point in a context where footnotes are allowed?"
(save-match-data
@@ -206,12 +182,6 @@ extracted will be filled again."
(save-excursion
(beginning-of-line)
(looking-at "[ \t]*:[ \t]+"))
- ;; Avoid cited text and headers in message-mode.
- (and (derived-mode-p 'message-mode)
- (or (save-excursion
- (beginning-of-line)
- (looking-at message-cite-prefix-regexp))
- (message-point-in-header-p)))
;; Avoid forbidden blocks.
(org-in-block-p org-footnote-forbidden-blocks)))))
@@ -224,13 +194,9 @@ positions, and the definition, when inlined."
(or (looking-at org-footnote-re)
(org-in-regexp org-footnote-re)
(save-excursion (re-search-backward org-footnote-re nil t)))
- (/= (match-beginning 0) (point-at-bol)))
+ (/= (match-beginning 0) (line-beginning-position)))
(let* ((beg (match-beginning 0))
- (label (or (org-match-string-no-properties 2)
- (org-match-string-no-properties 3)
- ;; Anonymous footnotes don't have labels
- (and (match-string 1)
- (concat "fn:" (org-match-string-no-properties 1)))))
+ (label (match-string-no-properties 1))
;; Inline footnotes don't end at (match-end 0) as
;; `org-footnote-re' stops just after the second colon.
;; Find the real ending with `scan-sexps', so Org doesn't
@@ -238,7 +204,8 @@ positions, and the definition, when inlined."
(end (ignore-errors (scan-sexps beg 1))))
;; Point is really at a reference if it's located before true
;; ending of the footnote.
- (when (and end (< (point) end)
+ (when (and end
+ (< (point) end)
;; Verify match isn't a part of a link.
(not (save-excursion
(goto-char beg)
@@ -250,9 +217,10 @@ positions, and the definition, when inlined."
(not (org-inside-latex-macro-p)))
(list label beg end
;; Definition: ensure this is an inline footnote first.
- (and (or (not label) (match-string 1))
- (org-trim (buffer-substring-no-properties
- (match-end 0) (1- end)))))))))
+ (and (match-end 2)
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (1- end)))))))))
(defun org-footnote-at-definition-p ()
"Is point within a footnote definition?
@@ -275,26 +243,224 @@ otherwise."
(concat org-outline-regexp-bol
"\\|^\\([ \t]*\n\\)\\{2,\\}") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
- (let ((label (org-match-string-no-properties 1))
+ (let ((label (match-string-no-properties 1))
(beg (match-beginning 0))
(beg-def (match-end 0))
- ;; In message-mode, do not search after signature.
- (end (let ((bound (and (derived-mode-p 'message-mode)
- (save-excursion
- (goto-char (point-max))
- (re-search-backward
- message-signature-separator nil t)))))
- (if (progn
- (end-of-line)
- (re-search-forward
- (concat org-outline-regexp-bol "\\|"
- org-footnote-definition-re "\\|"
- "^\\([ \t]*\n\\)\\{2,\\}") bound 'move))
- (match-beginning 0)
- (point)))))
+ (end (if (progn
+ (end-of-line)
+ (re-search-forward
+ (concat org-outline-regexp-bol "\\|"
+ org-footnote-definition-re "\\|"
+ "^\\([ \t]*\n\\)\\{2,\\}") nil 'move))
+ (match-beginning 0)
+ (point))))
(list label beg end
(org-trim (buffer-substring-no-properties beg-def end)))))))))
+
+;;;; Internal functions
+
+(defun org-footnote--allow-reference-p ()
+ "Non-nil when a footnote reference can be inserted at point."
+ ;; XXX: This is similar to `org-footnote-in-valid-context-p' but
+ ;; more accurate and usually faster, except in some corner cases.
+ ;; It may replace it after doing proper benchmarks as it would be
+ ;; used in fontification.
+ (unless (bolp)
+ (let* ((context (org-element-context))
+ (type (org-element-type context)))
+ (cond
+ ;; No footnote reference in attributes.
+ ((let ((post (org-element-property :post-affiliated context)))
+ (and post (< (point) post)))
+ nil)
+ ;; Paragraphs and blank lines at top of document are fine.
+ ((memq type '(nil paragraph)))
+ ;; So are contents of verse blocks.
+ ((eq type 'verse-block)
+ (and (>= (point) (org-element-property :contents-begin context))
+ (< (point) (org-element-property :contents-end context))))
+ ;; In an headline or inlinetask, point must be either on the
+ ;; heading itself or on the blank lines below.
+ ((memq type '(headline inlinetask))
+ (or (not (org-at-heading-p))
+ (and (save-excursion
+ (beginning-of-line)
+ (and (let ((case-fold-search t))
+ (not (looking-at-p "\\*+ END[ \t]*$")))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))))
+ (match-beginning 4)
+ (>= (point) (match-beginning 4))
+ (or (not (match-beginning 5))
+ (< (point) (match-beginning 5))))))
+ ;; White spaces after an object or blank lines after an element
+ ;; are OK.
+ ((>= (point)
+ (save-excursion (goto-char (org-element-property :end context))
+ (skip-chars-backward " \r\t\n")
+ (if (eq (org-element-class context) 'object) (point)
+ (1+ (line-beginning-position 2))))))
+ ;; Other elements are invalid.
+ ((eq (org-element-class context) 'element) nil)
+ ;; Just before object is fine.
+ ((= (point) (org-element-property :begin context)))
+ ;; Within recursive object too, but not in a link.
+ ((eq type 'link) nil)
+ ((let ((cbeg (org-element-property :contents-begin context))
+ (cend (org-element-property :contents-end context)))
+ (and cbeg (>= (point) cbeg) (<= (point) cend))))))))
+
+(defun org-footnote--clear-footnote-section ()
+ "Remove all footnote sections in buffer and create a new one.
+New section is created at the end of the buffer, before any file
+local variable definition. Leave point within the new section."
+ (when org-footnote-section
+ (goto-char (point-min))
+ (let ((regexp
+ (format "^\\*+ +%s[ \t]*$"
+ (regexp-quote org-footnote-section))))
+ (while (re-search-forward regexp nil t)
+ (delete-region
+ (match-beginning 0)
+ (progn (org-end-of-subtree t t)
+ (if (not (eobp)) (point)
+ (org-footnote--goto-local-insertion-point)
+ (skip-chars-forward " \t\n")
+ (if (eobp) (point) (line-beginning-position)))))))
+ (goto-char (point-max))
+ (org-footnote--goto-local-insertion-point)
+ (when (and (cdr (assq 'heading org-blank-before-new-entry))
+ (zerop (save-excursion (org-back-over-empty-lines))))
+ (insert "\n"))
+ (insert "* " org-footnote-section "\n")))
+
+(defun org-footnote--set-label (label)
+ "Set label of footnote at point to string LABEL.
+Assume point is at the beginning of the reference or definition
+to rename."
+ (forward-char 4)
+ (cond ((eq (char-after) ?:) (insert label))
+ ((looking-at "\\([-_[:word:]]+\\)") (replace-match label nil nil nil 1))
+ (t nil)))
+
+(defun org-footnote--collect-references (&optional anonymous)
+ "Collect all labelled footnote references in current buffer.
+
+Return an alist where associations follow the pattern
+
+ (LABEL MARKER TOP-LEVEL SIZE)
+
+with
+
+ LABEL the label of the of the definition,
+ MARKER a marker pointing to its beginning,
+ TOP-LEVEL a boolean, nil when the footnote is contained within
+ another one,
+ SIZE the length of the inline definition, in characters,
+ or nil for non-inline references.
+
+When optional ANONYMOUS is non-nil, also collect anonymous
+references. In such cases, LABEL is nil.
+
+References are sorted according to a deep-reading order."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((regexp (if anonymous org-footnote-re "\\[fn:[-_[:word:]]+[]:]"))
+ references nested)
+ (save-excursion
+ (while (re-search-forward regexp nil t)
+ ;; Ignore definitions.
+ (unless (and (eq (char-before) ?\])
+ (= (line-beginning-position) (match-beginning 0)))
+ ;; Ensure point is within the reference before parsing it.
+ (backward-char)
+ (let ((object (org-element-context)))
+ (when (eq (org-element-type object) 'footnote-reference)
+ (let* ((label (org-element-property :label object))
+ (begin (org-element-property :begin object))
+ (size
+ (and (eq (org-element-property :type object) 'inline)
+ (- (org-element-property :contents-end object)
+ (org-element-property :contents-begin object)))))
+ (let ((d (org-element-lineage object '(footnote-definition))))
+ (push (list label (copy-marker begin) (not d) size)
+ references)
+ (when d
+ ;; Nested references are stored in alist NESTED.
+ ;; Associations there follow the pattern
+ ;;
+ ;; (DEFINITION-LABEL . REFERENCES)
+ (let* ((def-label (org-element-property :label d))
+ (labels (assoc def-label nested)))
+ (if labels (push label (cdr labels))
+ (push (list def-label label) nested)))))))))))
+ ;; Sort the list of references. Nested footnotes have priority
+ ;; over top-level ones.
+ (letrec ((ordered nil)
+ (add-reference
+ (lambda (ref allow-nested)
+ (when (or allow-nested (nth 2 ref))
+ (push ref ordered)
+ (dolist (r (mapcar (lambda (l) (assoc l references))
+ (reverse
+ (cdr (assoc (nth 0 ref) nested)))))
+ (funcall add-reference r t))))))
+ (dolist (r (reverse references) (nreverse ordered))
+ (funcall add-reference r nil))))))
+
+(defun org-footnote--collect-definitions (&optional delete)
+ "Collect all footnote definitions in current buffer.
+
+Return an alist where associations follow the pattern
+
+ (LABEL . DEFINITION)
+
+with LABEL and DEFINITION being, respectively, the label and the
+definition of the footnote, as strings.
+
+When optional argument DELETE is non-nil, delete the definition
+while collecting them."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (definitions seen)
+ (while (re-search-forward org-footnote-definition-re nil t)
+ (backward-char)
+ (let ((element (org-element-at-point)))
+ (let ((label (org-element-property :label element)))
+ (when (and (eq (org-element-type element) 'footnote-definition)
+ (not (member label seen)))
+ (push label seen)
+ (let* ((beg (progn
+ (goto-char (org-element-property :begin element))
+ (skip-chars-backward " \r\t\n")
+ (if (bobp) (point) (line-beginning-position 2))))
+ (end (progn
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ (def (org-trim (buffer-substring-no-properties beg end))))
+ (push (cons label def) definitions)
+ (when delete (delete-region beg end)))))))
+ definitions)))
+
+(defun org-footnote--goto-local-insertion-point ()
+ "Find insertion point for footnote, just before next outline heading.
+Assume insertion point is within currently accessible part of the buffer."
+ (org-with-limited-levels (outline-next-heading))
+ ;; Skip file local variables. See `modify-file-local-variable'.
+ (when (eobp)
+ (let ((case-fold-search t))
+ (re-search-backward "^[ \t]*# +Local Variables:"
+ (max (- (point-max) 3000) (point-min))
+ t)))
+ (skip-chars-backward " \t\n")
+ (forward-line)
+ (unless (bolp) (insert "\n")))
+
+
+;;;; Navigation
+
(defun org-footnote-get-next-reference (&optional label backward limit)
"Return complete reference of the next footnote.
@@ -305,7 +471,7 @@ the buffer position bounding the search.
Return value is a list like those provided by `org-footnote-at-reference-p'.
If no footnote is found, return nil."
(save-excursion
- (let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re)))
+ (let* ((label-fmt (if label (format "\\[fn:%s[]:]" label) org-footnote-re)))
(catch 'exit
(while t
(unless (funcall (if backward #'re-search-backward #'re-search-forward)
@@ -329,45 +495,19 @@ If no footnote is found, return nil."
(unless (re-search-forward org-footnote-re limit t)
(goto-char origin)
(throw 'exit nil))
- ;; Beware: with [1]-like footnotes point will be just after
+ ;; Beware: with non-inline footnotes point will be just after
;; the closing square bracket.
(backward-char)
(cond
((setq ref (org-footnote-at-reference-p))
(throw 'exit ref))
- ;; Definition: also grab the last square bracket, only
- ;; matched in `org-footnote-re' for [1]-like footnotes.
+ ;; Definition: also grab the last square bracket, matched in
+ ;; `org-footnote-re' for non-inline footnotes.
((save-match-data (org-footnote-at-definition-p))
(let ((end (match-end 0)))
(throw 'exit
(list nil (match-beginning 0)
- (if (eq (char-before end) 93) end (1+ end)))))))))))
-
-(defun org-footnote-get-definition (label)
- "Return label, boundaries and definition of the footnote LABEL."
- (let* ((label (regexp-quote (org-footnote-normalize-label label)))
- (re (format "^\\[%s\\]\\|.\\[%s:" label label)))
- (org-with-wide-buffer
- (goto-char (point-min))
- (catch 'found
- (while (re-search-forward re nil t)
- (let* ((datum (progn (backward-char) (org-element-context)))
- (type (org-element-type datum)))
- (when (memq type '(footnote-definition footnote-reference))
- (throw 'found
- (list
- label
- (org-element-property :begin datum)
- (org-element-property :end datum)
- (let ((cbeg (org-element-property :contents-begin datum)))
- (if (not cbeg) ""
- (replace-regexp-in-string
- "[ \t\n]*\\'"
- ""
- (buffer-substring-no-properties
- cbeg
- (org-element-property :contents-end datum))))))))))
- nil))))
+ (if (eq (char-before end) ?\]) end (1+ end)))))))))))
(defun org-footnote-goto-definition (label &optional location)
"Move point to the definition of the footnote LABEL.
@@ -379,7 +519,8 @@ Throw an error if there is no definition or if it cannot be
reached from current narrowed part of buffer. Return a non-nil
value if point was successfully moved."
(interactive "sLabel: ")
- (let ((def-start (or location (nth 1 (org-footnote-get-definition label)))))
+ (let* ((label (org-footnote-normalize-label label))
+ (def-start (or location (nth 1 (org-footnote-get-definition label)))))
(cond
((not def-start)
(user-error "Cannot find definition of footnote %s" label))
@@ -387,21 +528,21 @@ value if point was successfully moved."
(user-error "Definition is outside narrowed part of buffer")))
(org-mark-ring-push)
(goto-char def-start)
- (looking-at (format "\\[%s[]:] ?" label))
+ (looking-at (format "\\[fn:%s[]:] ?" (regexp-quote label)))
(goto-char (match-end 0))
(org-show-context 'link-search)
(when (derived-mode-p 'org-mode)
- (message
- (substitute-command-keys
- "Edit definition and go back with `\\[org-mark-ring-goto]' or, if \
-unique, with `\\[org-ctrl-c-ctrl-c]'.")))
+ (message "%s" (substitute-command-keys
+ "Edit definition and go back with \
+`\\[org-mark-ring-goto]' or, if unique, with `\\[org-ctrl-c-ctrl-c]'.")))
t))
(defun org-footnote-goto-previous-reference (label)
"Find the first closest (to point) reference of footnote with label LABEL."
(interactive "sLabel: ")
(org-mark-ring-push)
- (let* ((label (org-footnote-normalize-label label)) ref)
+ (let ((label (org-footnote-normalize-label label))
+ ref)
(save-excursion
(setq ref (or (org-footnote-get-next-reference label t)
(org-footnote-get-next-reference label)
@@ -415,111 +556,74 @@ unique, with `\\[org-ctrl-c-ctrl-c]'.")))
(goto-char (nth 1 ref))
(org-show-context 'link-search))))
+
+;;;; Getters
+
(defun org-footnote-normalize-label (label)
- "Return LABEL as an appropriate string."
- (cond
- ((numberp label) (number-to-string label))
- ((equal "" label) nil)
- ((not (string-match "^[0-9]+$\\|^fn:" label))
- (concat "fn:" label))
- (t label)))
-
-(defun org-footnote-all-labels (&optional with-defs)
- "Return list with all defined foot labels used in the buffer.
-
-If WITH-DEFS is non-nil, also associate the definition to each
-label. The function will then return an alist whose key is label
-and value definition."
- (let* (rtn
- (push-to-rtn
- (function
- ;; Depending on WITH-DEFS, store label or (label . def) of
- ;; footnote reference/definition given as argument in RTN.
- (lambda (el)
- (let ((lbl (car el)))
- (push (if with-defs (cons lbl (nth 3 el)) lbl) rtn))))))
- (save-excursion
- (save-restriction
- (widen)
- ;; Find all labels found in definitions.
- (goto-char (point-min))
- (let (def)
- (while (re-search-forward org-footnote-definition-re nil t)
- (when (setq def (org-footnote-at-definition-p))
- (funcall push-to-rtn def))))
- ;; Find all labels found in references.
- (goto-char (point-min))
- (let (ref)
- (while (setq ref (org-footnote-get-next-reference))
- (goto-char (nth 2 ref))
- (and (car ref) ; ignore anonymous footnotes
- (not (funcall (if with-defs #'assoc #'member) (car ref) rtn))
- (funcall push-to-rtn ref))))))
- rtn))
+ "Return LABEL without \"fn:\" prefix.
+If LABEL is the empty string or constituted of white spaces only,
+return nil instead."
+ (pcase (org-trim label)
+ ("" nil)
+ ((pred (string-prefix-p "fn:")) (substring label 3))
+ (_ label)))
+
+(defun org-footnote-get-definition (label)
+ "Return label, boundaries and definition of the footnote LABEL."
+ (let* ((label (regexp-quote (org-footnote-normalize-label label)))
+ (re (format "^\\[fn:%s\\]\\|.\\[fn:%s:" label label)))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (catch 'found
+ (while (re-search-forward re nil t)
+ (let* ((datum (progn (backward-char) (org-element-context)))
+ (type (org-element-type datum)))
+ (when (memq type '(footnote-definition footnote-reference))
+ (throw 'found
+ (list
+ label
+ (org-element-property :begin datum)
+ (org-element-property :end datum)
+ (let ((cbeg (org-element-property :contents-begin datum)))
+ (if (not cbeg) ""
+ (replace-regexp-in-string
+ "[ \t\n]*\\'"
+ ""
+ (buffer-substring-no-properties
+ cbeg
+ (org-element-property :contents-end datum))))))))))
+ nil))))
+
+(defun org-footnote-all-labels ()
+ "List all defined footnote labels used throughout the buffer.
+This function ignores narrowing, if any."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (all)
+ (while (re-search-forward org-footnote-re nil t)
+ (backward-char)
+ (let ((context (org-element-context)))
+ (when (memq (org-element-type context)
+ '(footnote-definition footnote-reference))
+ (let ((label (org-element-property :label context)))
+ (when label (cl-pushnew label all :test #'equal))))))
+ all)))
(defun org-footnote-unique-label (&optional current)
"Return a new unique footnote label.
-The function returns the first \"fn:N\" or \"N\" label that is
-currently not used.
+The function returns the first numeric label currently unused.
Optional argument CURRENT is the list of labels active in the
buffer."
- (unless current (setq current (org-footnote-all-labels)))
- (let ((fmt (if (eq org-footnote-auto-label 'plain) "%d" "fn:%d"))
- (cnt 1))
- (while (member (format fmt cnt) current)
- (incf cnt))
- (format fmt cnt)))
+ (let ((current (or current (org-footnote-all-labels))))
+ (let ((count 1))
+ (while (member (number-to-string count) current)
+ (cl-incf count))
+ (number-to-string count))))
-(defun org-footnote--allow-reference-p ()
- "Non-nil when a footnote reference can be inserted at point."
- ;; XXX: This is similar to `org-footnote-in-valid-context-p' but
- ;; more accurate and usually faster, except in some corner cases.
- ;; It may replace it after doing proper benchmarks as it would be
- ;; used in fontification.
- (unless (bolp)
- (let* ((context (org-element-context))
- (type (org-element-type context)))
- (cond
- ;; No footnote reference in attributes.
- ((let ((post (org-element-property :post-affiliated context)))
- (and post (< (point) post)))
- nil)
- ;; Paragraphs and blank lines at top of document are fine.
- ((memq type '(nil paragraph)))
- ;; So are contents of verse blocks.
- ((eq type 'verse-block)
- (and (>= (point) (org-element-property :contents-begin context))
- (< (point) (org-element-property :contents-end context))))
- ;; In an headline or inlinetask, point must be either on the
- ;; heading itself or on the blank lines below.
- ((memq type '(headline inlinetask))
- (or (not (org-at-heading-p))
- (and (save-excursion (beginning-of-line)
- (and (let ((case-fold-search t))
- (not (looking-at "\\*+ END[ \t]*$")))
- (looking-at org-complex-heading-regexp)))
- (match-beginning 4)
- (>= (point) (match-beginning 4))
- (or (not (match-beginning 5))
- (< (point) (match-beginning 5))))))
- ;; White spaces after an object or blank lines after an element
- ;; are OK.
- ((>= (point)
- (save-excursion (goto-char (org-element-property :end context))
- (skip-chars-backward " \r\t\n")
- (if (memq type org-element-all-objects) (point)
- (1+ (line-beginning-position 2))))))
- ;; Other elements are invalid.
- ((memq type org-element-all-elements) nil)
- ;; Just before object is fine.
- ((= (point) (org-element-property :begin context)))
- ;; Within recursive object too, but not in a link.
- ((eq type 'link) nil)
- ((let ((cbeg (org-element-property :contents-begin context))
- (cend (org-element-property :contents-end context)))
- (and cbeg (>= (point) cbeg) (<= (point) cend))))))))
+
+;;;; Adding, Deleting Footnotes
(defun org-footnote-new ()
"Insert a new footnote.
@@ -531,12 +635,12 @@ or new, let the user edit the definition of the footnote."
(user-error "Cannot insert a footnote here"))
(let* ((all (org-footnote-all-labels))
(label
- (org-footnote-normalize-label
- (if (eq org-footnote-auto-label 'random)
- (format "fn:%x" (random most-positive-fixnum))
+ (if (eq org-footnote-auto-label 'random)
+ (format "%x" (random most-positive-fixnum))
+ (org-footnote-normalize-label
(let ((propose (org-footnote-unique-label all)))
- (if (memq org-footnote-auto-label '(t plain)) propose
- (org-icompleting-read
+ (if (eq org-footnote-auto-label t) propose
+ (completing-read
"Label (leave empty for anonymous): "
(mapcar #'list all) nil nil
(and (eq org-footnote-auto-label 'confirm) propose))))))))
@@ -544,14 +648,14 @@ or new, let the user edit the definition of the footnote."
(insert "[fn::]")
(backward-char 1))
((member label all)
- (insert "[" label "]")
+ (insert "[fn:" label "]")
(message "New reference to existing note"))
(org-footnote-define-inline
- (insert "[" label ":]")
+ (insert "[fn:" label ":]")
(backward-char 1)
(org-footnote-auto-adjust-maybe))
(t
- (insert "[" label "]")
+ (insert "[fn:" label "]")
(let ((p (org-footnote-create-definition label)))
;; `org-footnote-goto-definition' needs to be called
;; after `org-footnote-auto-adjust-maybe'. Otherwise
@@ -566,324 +670,27 @@ or new, let the user edit the definition of the footnote."
(org-footnote-auto-adjust-maybe)
(org-edit-footnote-reference)))))))
-(defvar org-blank-before-new-entry) ; Silence byte-compiler.
(defun org-footnote-create-definition (label)
"Start the definition of a footnote with label LABEL.
-Return buffer position at the beginning of the definition. In an
-Org buffer, this function doesn't move point."
+Return buffer position at the beginning of the definition. This
+function doesn't move point."
(let ((label (org-footnote-normalize-label label))
electric-indent-mode) ; Prevent wrong indentation.
- (cond
- ;; In an Org document.
- ((derived-mode-p 'org-mode)
- ;; If `org-footnote-section' is defined, find it, or create it
- ;; at the end of the buffer.
- (org-with-wide-buffer
- (cond
- ((not org-footnote-section)
- (org-footnote--goto-local-insertion-point))
- ((save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$")
- nil t))
- (goto-char (match-end 0))
- (forward-line)
- (unless (bolp) (insert "\n")))
- (t
- (goto-char (point-max))
- (unless (bolp) (insert "\n"))
- ;; Insert new section. Separate it from the previous one
- ;; with a blank line, unless `org-blank-before-new-entry'
- ;; explicitly says no.
- (when (and (cdr (assq 'heading org-blank-before-new-entry))
- (zerop (save-excursion (org-back-over-empty-lines))))
- (insert "\n"))
- (insert "* " org-footnote-section "\n")))
- (when (zerop (org-back-over-empty-lines)) (insert "\n"))
- (insert "[" label "] \n")
- (line-beginning-position 0)))
- (t
- ;; In a non-Org file. Search for footnote tag, or create it if
- ;; specified (at the end of buffer, or before signature if in
- ;; Message mode). Set point after any definition already there.
- (let ((tag (and org-footnote-tag-for-non-org-mode-files
- (concat "^" (regexp-quote
- org-footnote-tag-for-non-org-mode-files)
- "[ \t]*$")))
- (max (if (and (derived-mode-p 'message-mode)
- (goto-char (point-max))
- (re-search-backward
- message-signature-separator nil t))
- (progn
- ;; Ensure one blank line separates last
- ;; footnote from signature.
- (beginning-of-line)
- (open-line 2)
- (point-marker))
- (point-max-marker))))
- (set-marker-insertion-type max t)
- (goto-char max)
- ;; Check if the footnote tag is defined but missing. In this
- ;; case, insert it, before any footnote or one blank line
- ;; after any previous text.
- (when (and tag (not (re-search-backward tag nil t)))
- (skip-chars-backward " \t\r\n")
- (while (re-search-backward org-footnote-definition-re nil t))
- (unless (bolp) (newline 2))
- (insert org-footnote-tag-for-non-org-mode-files "\n\n"))
- ;; Remove superfluous white space and clear marker.
- (goto-char max)
- (skip-chars-backward " \t\r\n")
- (delete-region (point) max)
- (unless (bolp) (newline))
- (set-marker max nil))
- (when (zerop (org-back-over-empty-lines)) (insert "\n"))
- (insert "[" label "] \n")
- (backward-char)
- (line-beginning-position)))))
-
-;;;###autoload
-(defun org-footnote-action (&optional special)
- "Do the right thing for footnotes.
-
-When at a footnote reference, jump to the definition.
-
-When at a definition, jump to the references if they exist, offer
-to create them otherwise.
-
-When neither at definition or reference, create a new footnote,
-interactively if possible.
-
-With prefix arg SPECIAL, or when no footnote can be created,
-offer additional commands in a menu."
- (interactive "P")
- (let* ((context (and (not special) (org-element-context)))
- (type (org-element-type context)))
- (cond
- ;; On white space after element, insert a new footnote.
- ((and context
- (> (point)
- (save-excursion
- (goto-char (org-element-property :end context))
- (skip-chars-backward " \t")
- (point))))
- (org-footnote-new))
- ((eq type 'footnote-reference)
- (let ((label (org-element-property :label context)))
- (cond
- ;; Anonymous footnote: move point at the beginning of its
- ;; definition.
- ((not label)
- (goto-char (org-element-property :contents-begin context)))
- ;; Check if a definition exists: then move to it.
- ((let ((p (nth 1 (org-footnote-get-definition label))))
- (when p (org-footnote-goto-definition label p))))
- ;; No definition exists: offer to create it.
- ((yes-or-no-p (format "No definition for %s. Create one? " label))
- (let ((p (org-footnote-create-definition label)))
- (or (ignore-errors (org-footnote-goto-definition label p))
- ;; Since definition was created outside current scope,
- ;; edit it remotely.
- (org-edit-footnote-reference)))))))
- ((eq type 'footnote-definition)
- (org-footnote-goto-previous-reference
- (org-element-property :label context)))
- ((or special (not (org-footnote--allow-reference-p)))
- (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s | \
-->[n]umeric | [d]elete")
- (let ((c (read-char-exclusive)))
- (cond
- ((eq c ?s) (org-footnote-normalize 'sort))
- ((eq c ?r) (org-footnote-renumber-fn:N))
- ((eq c ?S)
- (org-footnote-renumber-fn:N)
- (org-footnote-normalize 'sort))
- ((eq c ?n) (org-footnote-normalize))
- ((eq c ?d) (org-footnote-delete))
- (t (error "No such footnote command %c" c)))))
- (t (org-footnote-new)))))
-
-;;;###autoload
-(defun org-footnote-normalize (&optional sort-only)
- "Collect the footnotes in various formats and normalize them.
-
-This finds the different sorts of footnotes allowed in Org, and
-normalizes them to the usual [N] format.
-
-When SORT-ONLY is set, only sort the footnote definitions into the
-referenced sequence."
- ;; This is based on Paul's function, but rewritten.
- ;;
- ;; Re-create `org-with-limited-levels', but not limited to Org
- ;; buffers.
- (let* ((limit-level
- (and (boundp 'org-inlinetask-min-level)
- org-inlinetask-min-level
- (1- org-inlinetask-min-level)))
- (nstars (and limit-level
- (if org-odd-levels-only (1- (* limit-level 2))
- limit-level)))
- (org-outline-regexp
- (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))
- (count 0)
- ins-point ref ref-table)
(org-with-wide-buffer
- ;; 1. Find every footnote reference, extract the definition, and
- ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also
- ;; normalize references.
- (goto-char (point-min))
- (while (setq ref (org-footnote-get-next-reference))
- (let* ((lbl (car ref))
- (pos (nth 1 ref))
- ;; When footnote isn't anonymous, check if it's label
- ;; (REF) is already stored in REF-TABLE. In that case,
- ;; extract number used to identify it (MARKER). If
- ;; footnote is unknown, increment the global counter
- ;; (COUNT) to create an unused identifier.
- (a (and lbl (assoc lbl ref-table)))
- (marker (or (nth 1 a) (incf count)))
- ;; Is the reference inline or pointing to an inline
- ;; footnote?
- (inlinep (or (stringp (nth 3 ref)) (nth 3 a))))
- ;; Replace footnote reference with [MARKER]. Maybe fill
- ;; paragraph once done. If SORT-ONLY is non-nil, only move
- ;; to the end of reference found to avoid matching it twice.
- (if sort-only (goto-char (nth 2 ref))
- (delete-region (nth 1 ref) (nth 2 ref))
- (goto-char (nth 1 ref))
- (insert (format "[%d]" marker))
- (and inlinep
- org-footnote-fill-after-inline-note-extraction
- (org-fill-paragraph)))
- ;; Add label (REF), identifier (MARKER), definition (DEF)
- ;; type (INLINEP) and position (POS) to REF-TABLE if data was
- ;; unknown.
- (unless a
- (let ((def (or (nth 3 ref) ; Inline definition.
- (nth 3 (org-footnote-get-definition lbl)))))
- (push (list lbl marker def
- ;; Reference beginning position is a marker
- ;; to preserve it during further buffer
- ;; modifications.
- inlinep (copy-marker pos)) ref-table)))))
- ;; 2. Find and remove the footnote section, if any. Also
- ;; determine where footnotes shall be inserted (INS-POINT).
(cond
- ((and org-footnote-section (derived-mode-p 'org-mode))
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
- "[ \t]*$") nil t)
- (delete-region (match-beginning 0) (org-end-of-subtree t t)))
- ;; A new footnote section is inserted by default at the end of
- ;; the buffer.
- (goto-char (point-max))
- (skip-chars-backward " \r\t\n")
+ ((not org-footnote-section) (org-footnote--goto-local-insertion-point))
+ ((save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$")
+ nil t))
+ (goto-char (match-end 0))
(forward-line)
- (unless (bolp) (newline)))
- ;; No footnote section set: Footnotes will be added at the end
- ;; of the section containing their first reference.
- ((derived-mode-p 'org-mode))
- (t
- ;; Remove any left-over tag in the buffer, if one is set up.
- (when org-footnote-tag-for-non-org-mode-files
- (let ((tag (concat "^" (regexp-quote
- org-footnote-tag-for-non-org-mode-files)
- "[ \t]*$")))
- (goto-char (point-min))
- (while (re-search-forward tag nil t)
- (replace-match "")
- (delete-region (point) (progn (forward-line) (point))))))
- ;; In Message mode, ensure footnotes are inserted before the
- ;; signature.
- (if (and (derived-mode-p 'message-mode)
- (goto-char (point-max))
- (re-search-backward message-signature-separator nil t))
- (beginning-of-line)
- (goto-char (point-max)))))
- (setq ins-point (point-marker))
- ;; 3. Clean-up REF-TABLE.
- (setq ref-table
- (delq nil
- (mapcar
- (lambda (x)
- (cond
- ;; When only sorting, ignore inline footnotes.
- ;; Also clear position marker.
- ((and sort-only (nth 3 x))
- (set-marker (nth 4 x) nil) nil)
- ;; No definition available: provide one.
- ((not (nth 2 x))
- (append
- (list (car x) (nth 1 x)
- (format "DEFINITION NOT FOUND: %s" (car x)))
- (nthcdr 3 x)))
- (t x)))
- ref-table)))
- (setq ref-table (nreverse ref-table))
- ;; 4. Remove left-over definitions in the buffer.
- (dolist (x ref-table)
- (unless (nth 3 x) (org-footnote-delete-definitions (car x))))
- ;; 5. Insert the footnotes again in the buffer, at the
- ;; appropriate spot.
- (goto-char ins-point)
- (cond
- ;; No footnote: exit.
- ((not ref-table))
- ;; Cases when footnotes should be inserted in one place.
- ((or (not (derived-mode-p 'org-mode)) org-footnote-section)
- ;; Insert again the section title, if any. Ensure that title,
- ;; or the subsequent footnotes, will be separated by a blank
- ;; lines from the rest of the document. In an Org buffer,
- ;; separate section with a blank line, unless explicitly stated
- ;; in `org-blank-before-new-entry'.
- (if (not (derived-mode-p 'org-mode))
- (progn (skip-chars-backward " \t\n\r")
- (delete-region (point) ins-point)
- (unless (bolp) (newline))
- (when org-footnote-tag-for-non-org-mode-files
- (insert "\n" org-footnote-tag-for-non-org-mode-files "\n")))
- (when (and (cdr (assq 'heading org-blank-before-new-entry))
- (zerop (save-excursion (org-back-over-empty-lines))))
- (insert "\n"))
- (insert "* " org-footnote-section "\n"))
- (set-marker ins-point nil)
- ;; Insert the footnotes, separated by a blank line.
- (insert
- (mapconcat
- (lambda (x)
- ;; Clean markers.
- (set-marker (nth 4 x) nil)
- (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x)))
- ref-table "\n"))
- (unless (eobp) (insert "\n\n")))
- ;; Each footnote definition has to be inserted at the end of the
- ;; section where its first reference belongs.
- (t
- (dolist (x ref-table)
- (let ((pos (nth 4 x)))
- (goto-char pos)
- ;; Clean marker.
- (set-marker pos nil))
- (org-footnote--goto-local-insertion-point)
- (insert (format "\n[%s] %s\n"
- (nth (if sort-only 0 1) x)
- (nth 2 x)))))))))
-
-(defun org-footnote--goto-local-insertion-point ()
- "Find insertion point for footnote, just before next outline heading.
-Assume insertion point is within currently accessible part of the buffer."
- (org-with-limited-levels (outline-next-heading))
- ;; Skip file local variables. See `modify-file-local-variable'.
- (when (eobp)
- (let ((case-fold-search t))
- (re-search-backward "^[ \t]*# +Local Variables:"
- (max (- (point-max) 3000) (point-min))
- t)))
- (skip-chars-backward " \t\n")
- (forward-line)
- (unless (bolp) (insert "\n")))
+ (unless (bolp) (insert "\n")))
+ (t (org-footnote--clear-footnote-section)))
+ (when (zerop (org-back-over-empty-lines)) (insert "\n"))
+ (insert "[fn:" label "] \n")
+ (line-beginning-position 0))))
(defun org-footnote-delete-references (label)
"Delete every reference to footnote LABEL.
@@ -894,7 +701,7 @@ Return the number of footnotes removed."
(while (setq ref (org-footnote-get-next-reference label))
(goto-char (nth 1 ref))
(delete-region (nth 1 ref) (nth 2 ref))
- (incf nref))
+ (cl-incf nref))
nref)))
(defun org-footnote-delete-definitions (label)
@@ -902,7 +709,7 @@ Return the number of footnotes removed."
Return the number of footnotes removed."
(save-excursion
(goto-char (point-min))
- (let ((def-re (concat "^\\[" (regexp-quote label) "\\]"))
+ (let ((def-re (format "^\\[fn:%s\\]" (regexp-quote label)))
(ndef 0))
(while (re-search-forward def-re nil t)
(let ((full-def (org-footnote-at-definition-p)))
@@ -912,7 +719,7 @@ Return the number of footnotes removed."
(skip-chars-backward " \r\t\n")
(unless (bolp) (forward-line))
(delete-region (point) (nth 2 full-def))
- (incf ndef))))
+ (cl-incf ndef))))
ndef)))
(defun org-footnote-delete (&optional label)
@@ -948,24 +755,165 @@ If LABEL is non-nil, delete that footnote instead."
(message "%d definition(s) of and %d reference(s) of footnote %s removed"
ndef nref label))))
+
+;;;; Sorting, Renumbering, Normalizing
+
(defun org-footnote-renumber-fn:N ()
- "Renumber the simple footnotes like fn:17 into a sequence in the document."
+ "Order numbered footnotes into a sequence in the document."
(interactive)
- (let (map (n 0))
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t)
- (save-excursion
- (goto-char (match-beginning 0))
- ;; Ensure match is a footnote reference or definition.
- (when (save-match-data (if (bolp)
- (org-footnote-at-definition-p)
- (org-footnote-at-reference-p)))
- (let ((new-val (or (cdr (assoc (match-string 1) map))
- (number-to-string (incf n)))))
- (unless (assoc (match-string 1) map)
- (push (cons (match-string 1) new-val) map))
- (replace-match new-val nil nil nil 1))))))))
+ (let ((references (org-footnote--collect-references)))
+ (unwind-protect
+ (let* ((c 0)
+ (references (cl-remove-if-not
+ (lambda (r) (string-match-p "\\`[0-9]+\\'" (car r)))
+ references))
+ (alist (mapcar (lambda (l) (cons l (number-to-string (cl-incf c))))
+ (delete-dups (mapcar #'car references)))))
+ (org-with-wide-buffer
+ ;; Re-number references.
+ (dolist (ref references)
+ (goto-char (nth 1 ref))
+ (org-footnote--set-label (cdr (assoc (nth 0 ref) alist))))
+ ;; Re-number definitions.
+ (goto-char (point-min))
+ (while (re-search-forward "^\\[fn:\\([0-9]+\\)\\]" nil t)
+ (replace-match (or (cdr (assoc (match-string 1) alist))
+ ;; Un-referenced definitions get
+ ;; higher numbers.
+ (number-to-string (cl-incf c)))
+ nil nil nil 1))))
+ (dolist (r references) (set-marker (nth 1 r) nil)))))
+
+(defun org-footnote-sort ()
+ "Rearrange footnote definitions in the current buffer.
+Sort footnote definitions so they match order of footnote
+references. Also relocate definitions at the end of their
+relative section or within a single footnote section, according
+to `org-footnote-section'. Inline definitions are ignored."
+ (let ((references (org-footnote--collect-references)))
+ (unwind-protect
+ (let ((definitions (org-footnote--collect-definitions 'delete)))
+ (org-with-wide-buffer
+ (org-footnote--clear-footnote-section)
+ ;; Insert footnote definitions at the appropriate location,
+ ;; separated by a blank line. Each definition is inserted
+ ;; only once throughout the buffer.
+ (let (inserted)
+ (dolist (cell references)
+ (let ((label (car cell))
+ (nested (not (nth 2 cell)))
+ (inline (nth 3 cell)))
+ (unless (or (member label inserted) inline)
+ (push label inserted)
+ (unless (or org-footnote-section nested)
+ ;; If `org-footnote-section' is non-nil, or
+ ;; reference is nested, point is already at the
+ ;; correct position. Otherwise, move at the
+ ;; appropriate location within the section
+ ;; containing the reference.
+ (goto-char (nth 1 cell))
+ (org-footnote--goto-local-insertion-point))
+ (insert "\n"
+ (or (cdr (assoc label definitions))
+ (format "[fn:%s] DEFINITION NOT FOUND." label))
+ "\n"))))
+ ;; Insert un-referenced footnote definitions at the end.
+ (let ((unreferenced
+ (cl-remove-if (lambda (d) (member (car d) inserted))
+ definitions)))
+ (dolist (d unreferenced) (insert "\n" (cdr d) "\n"))))))
+ ;; Clear dangling markers in the buffer.
+ (dolist (r references) (set-marker (nth 1 r) nil)))))
+
+(defun org-footnote-normalize ()
+ "Turn every footnote in buffer into a numbered one."
+ (interactive)
+ (let ((references (org-footnote--collect-references 'anonymous)))
+ (unwind-protect
+ (let ((n 0)
+ (translations nil)
+ (definitions nil))
+ (org-with-wide-buffer
+ ;; Update label for reference. We need to do this before
+ ;; clearing definitions in order to rename nested footnotes
+ ;; before they are deleted.
+ (dolist (cell references)
+ (let* ((label (car cell))
+ (anonymous (not label))
+ (new
+ (cond
+ ;; In order to differentiate anonymous
+ ;; references from regular ones, set their
+ ;; labels to integers, not strings.
+ (anonymous (setcar cell (cl-incf n)))
+ ((cdr (assoc label translations)))
+ (t (let ((l (number-to-string (cl-incf n))))
+ (push (cons label l) translations)
+ l)))))
+ (goto-char (nth 1 cell)) ; Move to reference's start.
+ (org-footnote--set-label
+ (if anonymous (number-to-string new) new))
+ (let ((size (nth 3 cell)))
+ ;; Transform inline footnotes into regular references
+ ;; and retain their definition for later insertion as
+ ;; a regular footnote definition.
+ (when size
+ (let ((def (concat
+ (format "[fn:%s] " new)
+ (org-trim
+ (substring
+ (delete-and-extract-region
+ (point) (+ (point) size 1))
+ 1)))))
+ (push (cons (if anonymous new label) def) definitions)
+ (when org-footnote-fill-after-inline-note-extraction
+ (org-fill-paragraph)))))))
+ ;; Collect definitions. Update labels according to ALIST.
+ (let ((definitions
+ (nconc definitions
+ (org-footnote--collect-definitions 'delete)))
+ (inserted))
+ (org-footnote--clear-footnote-section)
+ (dolist (cell references)
+ (let* ((label (car cell))
+ (anonymous (integerp label))
+ (pos (nth 1 cell)))
+ ;; Move to appropriate location, if required. When
+ ;; there is a footnote section or reference is
+ ;; nested, point is already at the expected location.
+ (unless (or org-footnote-section (not (nth 2 cell)))
+ (goto-char pos)
+ (org-footnote--goto-local-insertion-point))
+ ;; Insert new definition once label is updated.
+ (unless (member label inserted)
+ (push label inserted)
+ (let ((stored (cdr (assoc label definitions)))
+ ;; Anonymous footnotes' label is already
+ ;; up-to-date.
+ (new (if anonymous label
+ (cdr (assoc label translations)))))
+ (insert "\n"
+ (cond
+ ((not stored)
+ (format "[fn:%s] DEFINITION NOT FOUND." new))
+ (anonymous stored)
+ (t
+ (replace-regexp-in-string
+ "\\`\\[fn:\\(.*?\\)\\]" new stored nil nil 1)))
+ "\n")))))
+ ;; Insert un-referenced footnote definitions at the end.
+ (let ((unreferenced
+ (cl-remove-if (lambda (d) (member (car d) inserted))
+ definitions)))
+ (dolist (d unreferenced)
+ (insert "\n"
+ (replace-regexp-in-string
+ org-footnote-definition-re
+ (format "[fn:%d]" (cl-incf n))
+ (cdr d))
+ "\n"))))))
+ ;; Clear dangling markers.
+ (dolist (r references) (set-marker (nth 1 r) nil)))))
(defun org-footnote-auto-adjust-maybe ()
"Renumber and/or sort footnotes according to user settings."
@@ -973,14 +921,77 @@ If LABEL is non-nil, delete that footnote instead."
(org-footnote-renumber-fn:N))
(when (memq org-footnote-auto-adjust '(t sort))
(let ((label (car (org-footnote-at-definition-p))))
- (org-footnote-normalize 'sort)
+ (org-footnote-sort)
(when label
(goto-char (point-min))
- (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]")
+ (and (re-search-forward (format "^\\[fn:%s\\]" (regexp-quote label))
nil t)
(progn (insert " ")
(just-one-space)))))))
+
+;;;; End-user interface
+
+;;;###autoload
+(defun org-footnote-action (&optional special)
+ "Do the right thing for footnotes.
+
+When at a footnote reference, jump to the definition.
+
+When at a definition, jump to the references if they exist, offer
+to create them otherwise.
+
+When neither at definition or reference, create a new footnote,
+interactively if possible.
+
+With prefix arg SPECIAL, or when no footnote can be created,
+offer additional commands in a menu."
+ (interactive "P")
+ (let* ((context (and (not special) (org-element-context)))
+ (type (org-element-type context)))
+ (cond
+ ;; On white space after element, insert a new footnote.
+ ((and context
+ (> (point)
+ (save-excursion
+ (goto-char (org-element-property :end context))
+ (skip-chars-backward " \t")
+ (point))))
+ (org-footnote-new))
+ ((eq type 'footnote-reference)
+ (let ((label (org-element-property :label context)))
+ (cond
+ ;; Anonymous footnote: move point at the beginning of its
+ ;; definition.
+ ((not label)
+ (goto-char (org-element-property :contents-begin context)))
+ ;; Check if a definition exists: then move to it.
+ ((let ((p (nth 1 (org-footnote-get-definition label))))
+ (when p (org-footnote-goto-definition label p))))
+ ;; No definition exists: offer to create it.
+ ((yes-or-no-p (format "No definition for %s. Create one? " label))
+ (let ((p (org-footnote-create-definition label)))
+ (or (ignore-errors (org-footnote-goto-definition label p))
+ ;; Since definition was created outside current scope,
+ ;; edit it remotely.
+ (org-edit-footnote-reference)))))))
+ ((eq type 'footnote-definition)
+ (org-footnote-goto-previous-reference
+ (org-element-property :label context)))
+ ((or special (not (org-footnote--allow-reference-p)))
+ (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s | [n]ormalize | \
+\[d]elete")
+ (pcase (read-char-exclusive)
+ (?s (org-footnote-sort))
+ (?r (org-footnote-renumber-fn:N))
+ (?S (org-footnote-renumber-fn:N)
+ (org-footnote-sort))
+ (?n (org-footnote-normalize))
+ (?d (org-footnote-delete))
+ (char (error "No such footnote command %c" char))))
+ (t (org-footnote-new)))))
+
+
(provide 'org-footnote)
;; Local variables:
diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el
index a574c0f..a0de1c1 100644
--- a/lisp/org-gnus.el
+++ b/lisp/org-gnus.el
@@ -1,4 +1,4 @@
-;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode
+;;; org-gnus.el --- Support for Links to Gnus Groups and Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -25,8 +25,8 @@
;;
;;; Commentary:
-;; This file implements links to Gnus groups and messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to Gnus groups and messages from within Org.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
@@ -39,18 +39,17 @@
(declare-function message-fetch-field "message" (header &optional not-all))
(declare-function message-narrow-to-head-1 "message" nil)
-(declare-function nnimap-group-overview-filename "nnimap" (group server))
(declare-function gnus-summary-last-subject "gnus-sum" nil)
(declare-function nnvirtual-map-article "nnvirtual" (article))
;; Customization variables
-(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
+(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
(defcustom org-gnus-prefer-web-links nil
"If non-nil, `org-store-link' creates web links to Google groups or Gmane.
-When nil, Gnus will be used for such links.
-Using a prefix arg to the command \\[org-store-link] (`org-store-link')
+\\<org-mode-map>When nil, Gnus will be used for such links.
+Using a prefix argument to the command `\\[org-store-link]' (`org-store-link')
negates this setting for the duration of the command."
:group 'org-link-store
:type 'boolean)
@@ -75,8 +74,7 @@ this variable to t."
:type 'boolean)
;; Install the link type
-(org-add-link-type "gnus" 'org-gnus-open)
-(add-hook 'org-store-link-functions 'org-gnus-store-link)
+(org-link-set-parameters "gnus" :follow #'org-gnus-open :store #'org-gnus-store-link)
;; Implementation
@@ -85,8 +83,12 @@ this variable to t."
MESSAGE-ID is the message-id header field that identifies the
message. If the uid is not cached, return nil."
(with-temp-buffer
- (let ((nov (nnimap-group-overview-filename group server)))
- (when (file-exists-p nov)
+ (let ((nov (and (fboundp 'nnimap-group-overview-filename)
+ ;; nnimap-group-overview-filename was removed from
+ ;; Gnus in September 2010, and therefore should
+ ;; only be present in Emacs 23.1.
+ (nnimap-group-overview-filename group server))))
+ (when (and nov (file-exists-p nov))
(mm-insert-file-contents nov)
(set-buffer-modified-p nil)
(goto-char (point-min))
@@ -105,7 +107,7 @@ Otherwise create a link to the group inside Gnus.
If `org-store-link' was called with a prefix arg the meaning of
`org-gnus-prefer-web-links' is reversed."
(let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group)))
- (if (and (string-match "^nntp" group) ;; Only for nntp groups
+ (if (and (string-prefix-p "nntp" group) ;; Only for nntp groups
(org-xor current-prefix-arg
org-gnus-prefer-web-links))
(concat (if (string-match "gmane" unprefixed-group)
@@ -157,25 +159,17 @@ If `org-store-link' was called with a prefix arg the meaning of
(header (with-current-buffer gnus-summary-buffer
(gnus-summary-article-header)))
(from (mail-header-from header))
- (message-id (org-remove-angle-brackets (mail-header-id header)))
+ (message-id (org-unbracket-string "<" ">" (mail-header-id header)))
(date (org-trim (mail-header-date header)))
- (date-ts (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t)
- (date-to-time date)))))
- (date-ts-ia (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date)))))
(subject (copy-sequence (mail-header-subject header)))
(to (cdr (assq 'To (mail-header-extra header))))
newsgroups x-no-archive desc link)
- (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name))
- 'nnvirtual)
- (setq group (car (nnvirtual-map-article
- (gnus-summary-article-number)))))
+ (cl-case (car (gnus-find-method-for-group gnus-newsgroup-name))
+ (nnvirtual
+ (setq group (car (nnvirtual-map-article
+ (gnus-summary-article-number)))))
+ (nnir
+ (setq group (nnir-article-group (gnus-summary-article-number)))))
;; Remove text properties of subject string to avoid Emacs bug
;; #3506
(set-text-properties 0 (length subject) nil subject)
@@ -188,11 +182,8 @@ If `org-store-link' was called with a prefix arg the meaning of
(setq to (or to (gnus-fetch-original-field "To"))
newsgroups (gnus-fetch-original-field "Newsgroups")
x-no-archive (gnus-fetch-original-field "x-no-archive")))
- (org-store-link-props :type "gnus" :from from :subject subject
+ (org-store-link-props :type "gnus" :from from :date date :subject subject
:message-id message-id :group group :to to)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description)
link (org-gnus-article-link
group newsgroups message-id x-no-archive))
@@ -211,7 +202,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(let ((gcc (car (last
(message-unquote-tokens
(message-tokenize-header (mail-fetch-field "gcc" nil t) " ,")))))
- (id (org-remove-angle-brackets (mail-fetch-field "Message-ID")))
+ (id (org-unbracket-string "<" ">" (mail-fetch-field "Message-ID")))
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))
diff --git a/lisp/org-habit.el b/lisp/org-habit.el
index 25bc160..081627e 100644
--- a/lisp/org-habit.el
+++ b/lisp/org-habit.el
@@ -1,4 +1,4 @@
-;;; org-habit.el --- The habit tracking code for Org-mode
+;;; org-habit.el --- The habit tracking code for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
@@ -24,18 +24,16 @@
;;
;;; Commentary:
-;; This file contains the habit tracking code for Org-mode
+;; This file contains the habit tracking code for Org mode
;;; Code:
+(require 'cl-lib)
(require 'org)
(require 'org-agenda)
-(eval-when-compile
- (require 'cl))
-
(defgroup org-habit nil
- "Options concerning habit tracking in Org-mode."
+ "Options concerning habit tracking in Org mode."
:tag "Org Habit"
:group 'org-progress)
@@ -170,7 +168,7 @@ Returns a list with the following elements:
This list represents a \"habit\" for the rest of this module."
(save-excursion
(if pom (goto-char pom))
- (assert (org-is-habit-p (point)))
+ (cl-assert (org-is-habit-p (point)))
(let* ((scheduled (org-get-scheduled-time (point)))
(scheduled-repeat (org-get-repeat org-scheduled-string))
(end (org-entry-end-position))
@@ -185,7 +183,7 @@ This list represents a \"habit\" for the rest of this module."
habit-entry))
(setq sr-days (org-habit-duration-to-days scheduled-repeat)
sr-type (progn (string-match "[\\.+]?\\+" scheduled-repeat)
- (org-match-string-no-properties 0 scheduled-repeat)))
+ (match-string-no-properties 0 scheduled-repeat)))
(unless (> sr-days 0)
(error "Habit %s scheduled repeat period is less than 1d" habit-entry))
(when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)
@@ -222,8 +220,8 @@ This list represents a \"habit\" for the rest of this module."
(while (and (< count maxdays) (funcall search re limit t))
(push (time-to-days
(org-time-string-to-time
- (or (org-match-string-no-properties 1)
- (org-match-string-no-properties 2))))
+ (or (match-string-no-properties 1)
+ (match-string-no-properties 2))))
closed-dates)
(setq count (1+ count))))
(list scheduled sr-days deadline dr-days closed-dates sr-type))))
@@ -286,7 +284,6 @@ Habits are assigned colors on the following basis:
schedule's repeat period."
(let* ((scheduled (or scheduled-days (org-habit-scheduled habit)))
(s-repeat (org-habit-scheduled-repeat habit))
- (scheduled-end (+ scheduled (1- s-repeat)))
(d-repeat (org-habit-deadline-repeat habit))
(deadline (if scheduled-days
(+ scheduled-days (- d-repeat s-repeat))
@@ -310,13 +307,14 @@ Habits are assigned colors on the following basis:
CURRENT gives the current time between STARTING and ENDING, for
the purpose of drawing the graph. It need not be the actual
current time."
- (let* ((done-dates (sort (org-habit-done-dates habit) '<))
+ (let* ((all-done-dates (sort (org-habit-done-dates habit) #'<))
+ (done-dates all-done-dates)
(scheduled (org-habit-scheduled habit))
(s-repeat (org-habit-scheduled-repeat habit))
(start (time-to-days starting))
(now (time-to-days current))
(end (time-to-days ending))
- (graph (make-string (1+ (- end start)) ?\ ))
+ (graph (make-string (1+ (- end start)) ?\s))
(index 0)
last-done-date)
(while (and done-dates (< (car done-dates) start))
@@ -325,35 +323,55 @@ current time."
(while (< start end)
(let* ((in-the-past-p (< start now))
(todayp (= start now))
- (donep (and done-dates
- (= start (car done-dates))))
- (faces (if (and in-the-past-p
- (not last-done-date)
- (not (< scheduled now)))
- '(org-habit-clear-face . org-habit-clear-future-face)
- (org-habit-get-faces
- habit start
- (and in-the-past-p last-done-date
- ;; Compute scheduled time for habit at the
- ;; time START was current.
- (let ((type (org-habit-repeat-type habit)))
- (cond
- ((equal type ".+")
- (+ last-done-date s-repeat))
- ((equal type "+")
- ;; Since LAST-DONE-DATE, each done
- ;; mark shifted scheduled date by
- ;; S-REPEAT.
- (- scheduled (* (length done-dates) s-repeat)))
- (t
- ;; Scheduled time was the first time
- ;; past LAST-DONE-STATE which can jump
- ;; to current SCHEDULED time by
- ;; S-REPEAT hops.
- (- scheduled
- (* (/ (- scheduled last-done-date) s-repeat)
- s-repeat))))))
- donep)))
+ (donep (and done-dates (= start (car done-dates))))
+ (faces
+ (if (and in-the-past-p
+ (not last-done-date)
+ (not (< scheduled now)))
+ '(org-habit-clear-face . org-habit-clear-future-face)
+ (org-habit-get-faces
+ habit start
+ (and in-the-past-p
+ last-done-date
+ ;; Compute scheduled time for habit at the time
+ ;; START was current.
+ (let ((type (org-habit-repeat-type habit)))
+ (cond
+ ;; At the last done date, use current
+ ;; scheduling in all cases.
+ ((null done-dates) scheduled)
+ ((equal type ".+") (+ last-done-date s-repeat))
+ ((equal type "+")
+ ;; Since LAST-DONE-DATE, each done mark
+ ;; shifted scheduled date by S-REPEAT.
+ (- scheduled (* (length done-dates) s-repeat)))
+ (t
+ ;; Compute the scheduled time after the
+ ;; first repeat. This is the closest time
+ ;; past FIRST-DONE which can reach SCHEDULED
+ ;; by a number of S-REPEAT hops.
+ ;;
+ ;; Then, play TODO state change history from
+ ;; the beginning in order to find current
+ ;; scheduled time.
+ (let* ((first-done (car all-done-dates))
+ (s (let ((shift (mod (- scheduled first-done)
+ s-repeat)))
+ (+ (if (= shift 0) s-repeat shift)
+ first-done))))
+ (if (= first-done last-done-date) s
+ (catch :exit
+ (dolist (done (cdr all-done-dates) s)
+ ;; Each repeat shifts S by any
+ ;; number of S-REPEAT hops it takes
+ ;; to get past DONE, with a minimum
+ ;; of one hop.
+ (cl-incf s (* (1+ (/ (max (- done s) 0)
+ s-repeat))
+ s-repeat))
+ (when (= done last-done-date)
+ (throw :exit s))))))))))
+ donep)))
markedp face)
(if donep
(let ((done-time (time-add
@@ -386,7 +404,7 @@ current time."
(defun org-habit-insert-consistency-graphs (&optional line)
"Insert consistency graph for any habitual tasks."
- (let ((inhibit-read-only t) l c
+ (let ((inhibit-read-only t)
(buffer-invisibility-spec '(org-link))
(moment (time-subtract (current-time)
(list 0 (* 3600 org-extend-today-until) 0))))
diff --git a/lisp/org-id.el b/lisp/org-id.el
index 107ac39..cf26851 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -1,4 +1,4 @@
-;;; org-id.el --- Global identifiers for Org-mode entries
+;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;;
@@ -24,7 +24,7 @@
;;
;;; Commentary:
-;; This file implements globally unique identifiers for Org-mode entries.
+;; This file implements globally unique identifiers for Org entries.
;; Identifiers are stored in the entry as an :ID: property. Functions
;; are provided that create and retrieve such identifiers, and that find
;; entries based on the identifier.
@@ -73,18 +73,14 @@
(require 'org)
(declare-function message-make-fqdn "message" ())
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
;;; Customization
(defgroup org-id nil
- "Options concerning global entry identifiers in Org-mode."
+ "Options concerning global entry identifiers in Org mode."
:tag "Org ID"
:group 'org)
-(define-obsolete-variable-alias
- 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3")
(defcustom org-id-link-to-org-use-id nil
"Non-nil means storing a link to an Org file will use entry IDs.
\\<org-mode-map>\
@@ -102,7 +98,7 @@ create-if-interactive
call `org-capture' that automatically and preemptively creates a
link. If you do want to get an ID link in a capture template to
an entry not having an ID, create it first by explicitly creating
- a link to it, using `\\[org-insert-link]' first.
+ a link to it, using `\\[org-store-link]' first.
create-if-interactive-and-no-custom-id
Like create-if-interactive, but do not create an ID if there is
@@ -204,7 +200,7 @@ This variable is only relevant when `org-id-track-globally' is set."
When Org reparses files to remake the list of files and IDs it is tracking,
it will normally scan the agenda files, the archives related to agenda files,
any files that are listed as ID containing in the current register, and
-any Org-mode files currently visited by Emacs.
+any Org file currently visited by Emacs.
You can list additional files here.
This variable is only relevant when `org-id-track-globally' is set."
:group 'org-id
@@ -278,7 +274,7 @@ If necessary, the ID is created."
(move-marker pom nil))))
;;;###autoload
-(defun org-id-get-with-outline-drilling (&optional targets)
+(defun org-id-get-with-outline-drilling ()
"Use an outline-cycling interface to retrieve the ID of an entry.
This only finds entries in the current buffer, using `org-get-location'.
It returns the ID of the entry. If necessary, the ID is created."
@@ -295,7 +291,7 @@ Move the cursor to that entry in that buffer."
(let ((m (org-id-find id 'marker)))
(unless m
(error "Cannot find entry with ID \"%s\"" id))
- (org-pop-to-buffer-same-window (marker-buffer m))
+ (pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)))
@@ -448,8 +444,7 @@ and time is the usual three-integer representation of time."
Store the relation between files and corresponding IDs.
This will scan all agenda files, all associated archives, and all
files currently mentioned in `org-id-locations'.
-When FILES is given, scan these files instead.
-When CHECK is given, prepare detailed information about duplicate IDs."
+When FILES is given, scan these files instead."
(interactive)
(if (not org-id-track-globally)
(error "Please turn on `org-id-track-globally' if you want to track IDs")
@@ -467,7 +462,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(if (symbolp org-id-extra-files)
(symbol-value org-id-extra-files)
org-id-extra-files)
- ;; Files associated with live org-mode buffers
+ ;; Files associated with live Org buffers
(delq nil
(mapcar (lambda (b)
(with-current-buffer b
@@ -495,7 +490,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$"
nil t)
- (setq id (org-match-string-no-properties 1))
+ (setq id (match-string-no-properties 1))
(if (member id found)
(progn
(message "Duplicate ID \"%s\", also in file %s"
@@ -679,7 +674,7 @@ optional argument MARKERP, return the position as a new marker."
(move-marker m nil)
(org-show-context)))
-(org-add-link-type "id" 'org-id-open)
+(org-link-set-parameters "id" :follow #'org-id-open)
(provide 'org-id)
diff --git a/lisp/org-indent.el b/lisp/org-indent.el
index 83c5aac..fd58c69 100644
--- a/lisp/org-indent.el
+++ b/lisp/org-indent.el
@@ -1,4 +1,5 @@
-;;; org-indent.el --- Dynamic indentation for Org-mode
+;;; org-indent.el --- Dynamic indentation for Org -*- lexical-binding: t; -*-
+
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
@@ -39,8 +40,7 @@
(require 'org-compat)
(require 'org)
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(declare-function org-inlinetask-get-task-level "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
@@ -68,7 +68,7 @@ Delay used when the buffer to initialize is current.")
Delay used when the buffer to initialize isn't current.")
(defvar org-indent-agent-resume-delay '(0 0 100000)
"Minimal time for other idle processes before switching back to agent.")
-(defvar org-indent-initial-marker nil
+(defvar org-indent--initial-marker nil
"Position of initialization before interrupt.
This is used locally in each buffer being initialized.")
(defvar org-hide-leading-stars-before-indent-mode nil
@@ -127,32 +127,23 @@ buffer, which can take a few seconds on large buffers, is done
during idle time."
nil " Ind" nil
(cond
- ((and org-indent-mode (featurep 'xemacs))
- (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
- (setq org-indent-mode nil))
- ((and org-indent-mode
- (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
- (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
- (ding)
- (sit-for 1)
- (setq org-indent-mode nil))
(org-indent-mode
;; mode was turned on.
- (org-set-local 'indent-tabs-mode nil)
- (org-set-local 'org-indent-initial-marker (copy-marker 1))
+ (setq-local indent-tabs-mode nil)
+ (setq-local org-indent--initial-marker (copy-marker 1))
(when org-indent-mode-turns-off-org-adapt-indentation
- (org-set-local 'org-adapt-indentation nil))
+ (setq-local org-adapt-indentation nil))
(when org-indent-mode-turns-on-hiding-stars
- (org-set-local 'org-hide-leading-stars-before-indent-mode
- org-hide-leading-stars)
- (org-set-local 'org-hide-leading-stars t))
- (org-add-hook 'filter-buffer-substring-functions
+ (setq-local org-hide-leading-stars-before-indent-mode
+ org-hide-leading-stars)
+ (setq-local org-hide-leading-stars t))
+ (add-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
(funcall fun start end delete)))
nil t)
- (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
- (org-add-hook 'before-change-functions
+ (add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
+ (add-hook 'before-change-functions
'org-indent-notify-modified-headline nil 'local)
(and font-lock-mode (org-restart-font-lock))
(org-indent-remove-properties (point-min) (point-max))
@@ -169,11 +160,11 @@ during idle time."
(kill-local-variable 'org-adapt-indentation)
(setq org-indent-agentized-buffers
(delq (current-buffer) org-indent-agentized-buffers))
- (when (markerp org-indent-initial-marker)
- (set-marker org-indent-initial-marker nil))
+ (when (markerp org-indent--initial-marker)
+ (set-marker org-indent--initial-marker nil))
(when (boundp 'org-hide-leading-stars-before-indent-mode)
- (org-set-local 'org-hide-leading-stars
- org-hide-leading-stars-before-indent-mode))
+ (setq-local org-hide-leading-stars
+ org-hide-leading-stars-before-indent-mode))
(remove-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
@@ -209,7 +200,7 @@ When no more buffer is being watched, the agent suppress itself."
(when org-indent-agent-resume-timer
(cancel-timer org-indent-agent-resume-timer))
(setq org-indent-agentized-buffers
- (org-remove-if-not #'buffer-live-p org-indent-agentized-buffers))
+ (cl-remove-if-not #'buffer-live-p org-indent-agentized-buffers))
(cond
;; Job done: kill agent.
((not org-indent-agentized-buffers) (cancel-timer org-indent-agent-timer))
@@ -233,13 +224,15 @@ a time value."
(let ((interruptp
;; Always nil unless interrupted.
(catch 'interrupt
- (and org-indent-initial-marker
- (marker-position org-indent-initial-marker)
- (org-indent-add-properties org-indent-initial-marker
+ (and org-indent--initial-marker
+ (marker-position org-indent--initial-marker)
+ (equal (marker-buffer org-indent--initial-marker)
+ buffer)
+ (org-indent-add-properties org-indent--initial-marker
(point-max)
delay)
nil))))
- (move-marker org-indent-initial-marker interruptp)
+ (move-marker org-indent--initial-marker interruptp)
;; Job is complete: un-agentize buffer.
(unless interruptp
(setq org-indent-agentized-buffers
@@ -260,7 +253,7 @@ have `org-warning' face."
?*)))
(line
(cond
- ((and (org-bound-and-true-p org-inlinetask-show-first-star)
+ ((and (bound-and-true-p org-inlinetask-show-first-star)
(eq heading 'inlinetask))
(concat org-indent-inlinetask-first-star
(org-add-props (substring stars 1) nil 'face 'org-hide)))
@@ -319,7 +312,7 @@ stopped."
;; Headline or inline task.
((looking-at org-outline-regexp)
(let* ((nstars (- (match-end 0) (match-beginning 0) 1))
- (type (or (org-looking-at-p limited-re) 'inlinetask)))
+ (type (or (looking-at-p limited-re) 'inlinetask)))
(org-indent-set-line-properties nstars 0 type)
;; At an headline, define new value for LEVEL.
(unless (eq type 'inlinetask) (setq level nstars))))
@@ -349,7 +342,7 @@ headline."
(re-search-forward
(org-with-limited-levels org-outline-regexp-bol) end t)))))))
-(defun org-indent-refresh-maybe (beg end dummy)
+(defun org-indent-refresh-maybe (beg end _)
"Refresh indentation properties in an adequate portion of buffer.
BEG and END are the positions of the beginning and end of the
range of inserted text. DUMMY is an unused argument.
diff --git a/lisp/org-info.el b/lisp/org-info.el
index 270c19f..d82168e 100644
--- a/lisp/org-info.el
+++ b/lisp/org-info.el
@@ -1,4 +1,4 @@
-;;; org-info.el --- Support for links to Info nodes from within Org-Mode
+;;; org-info.el --- Support for Links to Info Nodes -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -24,8 +24,8 @@
;;
;;; Commentary:
-;; This file implements links to Info nodes from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to Info nodes from within Org mode.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
@@ -34,25 +34,26 @@
;; Declare external functions and variables
-(declare-function Info-find-node "info" (filename nodename
- &optional no-going-back))
+(declare-function Info-find-node "info"
+ (filename nodename &optional no-going-back strict-case))
(defvar Info-current-file)
(defvar Info-current-node)
;; Install the link type
-(org-add-link-type "info" 'org-info-open 'org-info-export)
-(add-hook 'org-store-link-functions 'org-info-store-link)
+(org-link-set-parameters "info"
+ :follow #'org-info-open
+ :export #'org-info-export
+ :store #'org-info-store-link)
;; Implementation
(defun org-info-store-link ()
"Store a link to an Info file and node."
(when (eq major-mode 'Info-mode)
- (let (link desc)
- (setq link (concat "info:"
- (file-name-nondirectory Info-current-file)
- "#" Info-current-node))
- (setq desc (concat (file-name-nondirectory Info-current-file)
- "#" Info-current-node))
+ (let ((link (concat "info:"
+ (file-name-nondirectory Info-current-file)
+ "#" Info-current-node))
+ (desc (concat (file-name-nondirectory Info-current-file)
+ "#" Info-current-node)))
(org-store-link-props :type "info" :file Info-current-file
:node Info-current-node
:link link :desc desc)
@@ -81,16 +82,47 @@
nodename-or-index)))))
(user-error "Could not open: %s" name)))
+(defconst org-info-emacs-documents
+ '("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x"
+ "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eieio" "eintr" "elisp"
+ "emacs-gnutls" "emacs-mime" "emacs" "epa" "erc" "ert" "eshell" "eudc" "eww"
+ "flymake" "forms" "gnus" "htmlfontify" "idlwave" "ido" "info" "mairix-el"
+ "message" "mh-e" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs"
+ "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve"
+ "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper"
+ "widget" "wisent" "woman")
+ "List of emacs documents available.
+Taken from <http://www.gnu.org/software/emacs/manual/html_mono/.>")
+
+(defconst org-info-other-documents
+ '(("libc" . "http://www.gnu.org/software/libc/manual/html_mono/libc.html")
+ ("make" . "http://www.gnu.org/software/make/manual/make.html"))
+ "Alist of documents generated from texinfo source.
+
+When converting info links to html, links to any one of these manuals are
+converted to use these URL's.")
+
+(defun org-info-map-html-url (filename)
+ "Given info FILENAME, either return it (plus '.html' suffix added) or convert
+it to URL pointing to the official page on internet, e.g., use gnu.org for all
+emacs related documents. See `org-info-official-gnu-document' and
+`org-info-other-documents' for details."
+ (if (member filename org-info-emacs-documents)
+ (format "http://www.gnu.org/software/emacs/manual/html_mono/%s.html"
+ filename)
+ (let ((url (cdr (assoc filename org-info-other-documents))))
+ (or url (concat filename ".html")))))
+
(defun org-info-export (path desc format)
"Export an info link.
-See `org-add-link-type' for details about PATH, DESC and FORMAT."
+See `org-link-parameters' for details about PATH, DESC and FORMAT."
(when (eq format 'html)
(or (string-match "\\(.*\\)[#:]:?\\(.*\\)" path)
(string-match "\\(.*\\)" path))
(let ((filename (match-string 1 path))
(node (or (match-string 2 path) "Top")))
- (format "<a href=\"%s.html#%s\">%s</a>"
- filename
+ (format "<a href=\"%s#%s\">%s</a>"
+ (org-info-map-html-url filename)
(replace-regexp-in-string " " "-" node)
(or desc path)))))
diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el
index 26d2e3d..910b1a0 100644
--- a/lisp/org-inlinetask.el
+++ b/lisp/org-inlinetask.el
@@ -1,4 +1,4 @@
-;;; org-inlinetask.el --- Tasks independent of outline hierarchy
+;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;;
@@ -26,7 +26,7 @@
;;
;;; Commentary:
;;
-;; This module implements inline tasks in Org-mode. Inline tasks are
+;; This module implements inline tasks in Org mode. Inline tasks are
;; tasks that have all the properties of normal outline nodes,
;; including the ability to store meta data like scheduling dates,
;; TODO state, tags and properties. However, these nodes are treated
@@ -167,9 +167,9 @@ The number of levels is controlled by `org-inlinetask-min-level'."
(stars-re (org-inlinetask-outline-regexp))
(task-beg-re (concat stars-re "\\(?:.*\\)"))
(task-end-re (concat stars-re "END[ \t]*$")))
- (or (org-looking-at-p task-beg-re)
+ (or (looking-at-p task-beg-re)
(and (re-search-forward "^\\*+[ \t]+" nil t)
- (progn (beginning-of-line) (org-looking-at-p task-end-re)))))))
+ (progn (beginning-of-line) (looking-at-p task-end-re)))))))
(defun org-inlinetask-goto-beginning ()
"Go to the beginning of the inline task at point."
@@ -177,7 +177,7 @@ The number of levels is controlled by `org-inlinetask-min-level'."
(let ((case-fold-search t)
(inlinetask-re (org-inlinetask-outline-regexp)))
(re-search-backward inlinetask-re nil t)
- (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$"))
+ (when (looking-at-p (concat inlinetask-re "END[ \t]*$"))
(re-search-backward inlinetask-re nil t))))
(defun org-inlinetask-goto-end ()
@@ -189,17 +189,16 @@ Return point."
(inlinetask-re (org-inlinetask-outline-regexp))
(task-end-re (concat inlinetask-re "END[ \t]*$")))
(cond
- ((looking-at task-end-re) (forward-line))
+ ((looking-at task-end-re))
((looking-at inlinetask-re)
(forward-line)
(cond
- ((looking-at task-end-re) (forward-line))
+ ((looking-at task-end-re))
((looking-at inlinetask-re))
((org-inlinetask-in-task-p)
- (re-search-forward inlinetask-re nil t)
- (forward-line))))
- (t (re-search-forward inlinetask-re nil t)
- (forward-line)))
+ (re-search-forward inlinetask-re nil t))))
+ (t (re-search-forward inlinetask-re nil t)))
+ (end-of-line)
(point))))
(defun org-inlinetask-get-task-level ()
@@ -272,8 +271,7 @@ If the task has an end part, also demote it."
(defvar org-indent-indentation-per-level) ; defined in org-indent.el
-(defface org-inlinetask
- (org-compatible-face 'shadow '((t (:bold t))))
+(defface org-inlinetask '((t :inherit shadow))
"Face for inlinetask headlines."
:group 'org-faces)
@@ -287,7 +285,7 @@ If the task has an end part, also demote it."
",\\}\\)\\(\\*\\* .*\\)"))
;; Virtual indentation will add the warning face on the first
;; star. Thus, in that case, only hide it.
- (start-face (if (and (org-bound-and-true-p org-indent-mode)
+ (start-face (if (and (bound-and-true-p org-indent-mode)
(> org-indent-indentation-per-level 1))
'org-hide
'org-warning)))
@@ -322,15 +320,15 @@ If the task has an end part, also demote it."
(defun org-inlinetask-hide-tasks (state)
"Hide inline tasks in buffer when STATE is `contents' or `children'.
This function is meant to be used in `org-cycle-hook'."
- (case state
- (contents
+ (pcase state
+ (`contents
(let ((regexp (org-inlinetask-outline-regexp)))
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(org-inlinetask-toggle-visibility)
(org-inlinetask-goto-end)))))
- (children
+ (`children
(save-excursion
(while (and (outline-next-heading) (org-inlinetask-at-task-p))
(org-inlinetask-toggle-visibility)
diff --git a/lisp/org-irc.el b/lisp/org-irc.el
index 333c4b1..2447793 100644
--- a/lisp/org-irc.el
+++ b/lisp/org-irc.el
@@ -1,4 +1,4 @@
-;;; org-irc.el --- Store links to IRC sessions
+;;; org-irc.el --- Store Links to IRC Sessions -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;;
@@ -22,8 +22,8 @@
;;; Commentary:
-;; This file implements links to an IRC session from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to an IRC session from within Org mode.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;
;; Please customize the variable `org-modules' to select
@@ -59,8 +59,6 @@
(declare-function erc-server-buffer "erc" ())
(declare-function erc-get-server-nickname-list "erc" ())
(declare-function erc-cmd-JOIN "erc" (channel &optional key))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
(defvar org-irc-client 'erc
"The IRC client to act on.")
@@ -73,9 +71,7 @@
;; Generic functions/config (extend these for other clients)
-(add-to-list 'org-store-link-functions 'org-irc-store-link)
-
-(org-add-link-type "irc" 'org-irc-visit nil)
+(org-link-set-parameters "irc" :follow #'org-irc-visit :store #'org-irc-store-link)
(defun org-irc-visit (link)
"Parse LINK and dispatch to the correct function based on the client found."
@@ -114,11 +110,9 @@ chars that the value AFTER with `...'"
(cons "[ \t]*$" "")
(cons (concat "^\\(.\\{" after
"\\}\\).*") "\\1..."))))
- (mapc (lambda (x)
- (when (string-match (car x) string)
- (setq string (replace-match (cdr x) nil nil string))))
- replace-map)
- string))
+ (dolist (x replace-map string)
+ (when (string-match (car x) string)
+ (setq string (replace-match (cdr x) nil nil string))))))
;; ERC specific functions
@@ -233,7 +227,7 @@ default."
(throw 'found x))))))
(if chan-buf
(progn
- (org-pop-to-buffer-same-window chan-buf)
+ (pop-to-buffer-same-window chan-buf)
;; if we got a nick, and they're in the chan,
;; then start a chat with them
(let ((nick (pop link)))
@@ -244,9 +238,9 @@ default."
(insert (concat nick ": ")))
(error "%s not found in %s" nick chan-name)))))
(progn
- (org-pop-to-buffer-same-window server-buffer)
+ (pop-to-buffer-same-window server-buffer)
(erc-cmd-JOIN chan-name))))
- (org-pop-to-buffer-same-window server-buffer)))
+ (pop-to-buffer-same-window server-buffer)))
;; no server match, make new connection
(erc-select :server server :port port))))
diff --git a/lisp/org-lint.el b/lisp/org-lint.el
index 37d05ed..2f92bb4 100644
--- a/lisp/org-lint.el
+++ b/lisp/org-lint.el
@@ -1,6 +1,6 @@
;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*-
-;; Copyright (C) 2015 Free Software Foundation
+;; Copyright (C) 2015-2016 Free Software Foundation
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -68,8 +68,10 @@
;; - orphaned affiliated keywords
;; - obsolete affiliated keywords
;; - missing language in src blocks
+;; - missing back-end in export blocks
;; - invalid Babel call blocks
;; - NAME values with a colon
+;; - deprecated export block syntax
;; - deprecated Babel header properties
;; - wrong header arguments in src blocks
;; - misuse of CATEGORY keyword
@@ -80,6 +82,7 @@
;; - links to non-existent local files
;; - SETUPFILE keywords with non-existent file parameter
;; - INCLUDE keywords with wrong link parameter
+;; - obsolete markup in INCLUDE keyword
;; - unknown items in OPTIONS keyword
;; - spurious macro arguments or invalid macro templates
;; - special properties in properties drawer
@@ -93,6 +96,7 @@
;; - incomplete drawers
;; - indented diary-sexps
;; - obsolete QUOTE section
+;; - obsolete "file+application" link
;;; Code:
@@ -143,15 +147,24 @@
:description "Report obsolete affiliated keywords"
:categories '(obsolete))
(make-org-lint-checker
+ :name 'deprecated-export-blocks
+ :description "Report deprecated export block syntax"
+ :categories '(obsolete export)
+ :trust 'low)
+ (make-org-lint-checker
:name 'deprecated-header-syntax
:description "Report deprecated Babel header syntax"
- :categories '(babel obsolete)
+ :categories '(obsolete babel)
:trust 'low)
(make-org-lint-checker
:name 'missing-language-in-src-block
:description "Report missing language in src blocks"
:categories '(babel))
(make-org-lint-checker
+ :name 'missing-backend-in-export-block
+ :description "Report missing back-end in export blocks"
+ :categories '(export))
+ (make-org-lint-checker
:name 'invalid-babel-call-block
:description "Report invalid Babel call blocks"
:categories '(babel))
@@ -203,6 +216,11 @@
:categories '(export)
:trust 'low)
(make-org-lint-checker
+ :name 'obsolete-include-markup
+ :description "Report obsolete markup in INCLUDE keyword"
+ :categories '(obsolete export)
+ :trust 'low)
+ (make-org-lint-checker
:name 'unknown-options-item
:description "Report unknown items in OPTIONS keyword"
:categories '(export)
@@ -256,7 +274,11 @@
:name 'quote-section
:description "Report obsolete QUOTE section"
:categories '(obsolete)
- :trust 'low))
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'file-application
+ :description "Report obsolete \"file+application\" link"
+ :categories '(link obsolete)))
"List of all available checkers.")
(defun org-lint--collect-duplicates
@@ -341,7 +363,7 @@ called with one argument, the key used for comparison."
(lambda (k)
(let ((key (org-element-property :key k)))
(and (or (let ((case-fold-search t))
- (org-string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
+ (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
(member key keywords))
(list (org-element-property :post-affiliated k)
(format "Orphaned affiliated keyword: \"%s\"" key))))))))
@@ -353,7 +375,7 @@ called with one argument, the key used for comparison."
t)))
reports)
(while (re-search-forward regexp nil t)
- (let ((key (upcase (org-match-string-no-properties 1))))
+ (let ((key (upcase (match-string-no-properties 1))))
(when (< (point)
(org-element-property :post-affiliated (org-element-at-point)))
(push
@@ -368,6 +390,20 @@ called with one argument, the key used for comparison."
reports))))
reports))
+(defun org-lint-deprecated-export-blocks (ast)
+ (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
+ "ODT" "ORG" "TEXINFO")))
+ (org-element-map ast 'special-block
+ (lambda (b)
+ (let ((type (org-element-property :type b)))
+ (when (member-ignore-case type deprecated)
+ (list
+ (org-element-property :post-affiliated b)
+ (format
+ "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \
+instead"
+ type))))))))
+
(defun org-lint-deprecated-header-syntax (ast)
(let* ((deprecated-babel-properties
(mapcar (lambda (arg) (symbol-name (car arg)))
@@ -385,7 +421,7 @@ called with one argument, the key used for comparison."
(list (org-element-property :begin datum)
(format "Deprecated syntax for \"%s\". \
Use header-args instead"
- (org-match-string-no-properties 1 value))))))
+ (match-string-no-properties 1 value))))))
(`node-property
(and (member-ignore-case key deprecated-babel-properties)
(list
@@ -401,6 +437,13 @@ Use :header-args: instead"
(list (org-element-property :post-affiliated b)
"Missing language in source block")))))
+(defun org-lint-missing-backend-in-export-block (ast)
+ (org-element-map ast 'export-block
+ (lambda (b)
+ (unless (org-element-property :type b)
+ (list (org-element-property :post-affiliated b)
+ "Missing back-end in export block")))))
+
(defun org-lint-invalid-babel-call-block (ast)
(org-element-map ast 'babel-call
(lambda (b)
@@ -409,7 +452,7 @@ Use :header-args: instead"
(list (org-element-property :post-affiliated b)
"Invalid syntax in babel call block"))
((let ((h (org-element-property :end-header b)))
- (and h (org-string-match-p "\\`\\[.*\\]\\'" h)))
+ (and h (string-match-p "\\`\\[.*\\]\\'" h)))
(list
(org-element-property :post-affiliated b)
"Babel call's end header must not be wrapped within brackets"))))))
@@ -509,7 +552,8 @@ Use :header-args: instead"
(org-element-map ast 'keyword
(lambda (k)
(when (equal (org-element-property :key k) "SETUPFILE")
- (let ((file (org-remove-double-quotes
+ (let ((file (org-unbracket-string
+ "\"" "\""
(org-element-property :value k))))
(and (not (file-remote-p file))
(not (file-exists-p file))
@@ -524,7 +568,7 @@ Use :header-args: instead"
(path
(and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value)
(save-match-data
- (org-remove-double-quotes (match-string 1 value))))))
+ (org-unbracket-string "\"" "\"" (match-string 1 value))))))
(if (not path)
(list (org-element-property :post-affiliated k)
"Missing location argument in INCLUDE keyword")
@@ -555,6 +599,25 @@ Use :header-args: instead"
search))))
(unless visiting (kill-buffer buffer))))))))))))
+(defun org-lint-obsolete-include-markup (ast)
+ (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
+ (regexp-opt
+ '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
+ "ODT" "ORG" "TEXINFO")
+ t))))
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (when (equal (org-element-property :key k) "INCLUDE")
+ (let ((case-fold-search t)
+ (value (org-element-property :value k)))
+ (when (string-match regexp value)
+ (let ((markup (match-string-no-properties 1 value)))
+ (list (org-element-property :post-affiliated k)
+ (format "Obsolete markup \"%s\" in INCLUDE keyword. \
+Use \"export %s\" instead"
+ markup
+ markup))))))))))
+
(defun org-lint-unknown-options-item (ast)
(let ((allowed (delq nil
(append
@@ -676,7 +739,7 @@ Use :header-args: instead"
(lambda (e)
(let ((name (org-element-property :name e)))
(and name
- (org-string-match-p ":" name)
+ (string-match-p ":" name)
(list (progn
(goto-char (org-element-property :begin e))
(re-search-forward
@@ -700,7 +763,7 @@ Use :header-args: instead"
(defun org-lint-incomplete-drawer (_)
(let (reports)
(while (re-search-forward org-drawer-regexp nil t)
- (let ((name (org-trim (org-match-string-no-properties 0)))
+ (let ((name (org-trim (match-string-no-properties 0)))
(element (org-element-at-point)))
(pcase (org-element-type element)
((or `drawer `property-drawer)
@@ -755,7 +818,7 @@ Use :header-args: instead"
(regexp-opt org-element-dual-keywords)))
reports)
(while (re-search-forward regexp nil t)
- (let ((name (org-match-string-no-properties 1)))
+ (let ((name (match-string-no-properties 1)))
(unless (or (string-prefix-p "BEGIN" name t)
(string-prefix-p "END" name t)
(save-excursion
@@ -781,7 +844,7 @@ Use :header-args: instead"
(org-element-property :commentedp e))))
nil t '(footnote-definition property-drawer))
(list (org-element-property :begin h)
- "Extraneous elements in footnote section")))))
+ "Extraneous elements in footnote section are not exported")))))
(defun org-lint-quote-section (ast)
(org-element-map ast '(headline inlinetask)
@@ -792,6 +855,14 @@ Use :header-args: instead"
(list (org-element-property :begin h)
"Deprecated QUOTE section"))))))
+(defun org-lint-file-application (ast)
+ (org-element-map ast 'link
+ (lambda (l)
+ (let ((app (org-element-property :application l)))
+ (and app
+ (list (org-element-property :begin l)
+ (format "Deprecated \"file+%s\" link type" app)))))))
+
(defun org-lint-wrong-header-argument (ast)
(let* ((reports)
(verify
@@ -883,35 +954,22 @@ Use :header-args: instead"
(and (boundp v) (symbol-value v))))
org-babel-common-header-args-w-values))
(datum-header-values
- (apply
- #'org-babel-merge-params
- org-babel-default-header-args
- (and language
- (let ((v (intern (concat "org-babel-default-header-args:"
- language))))
- (and (boundp v) (symbol-value v))))
- (append
- (list (and (memq type '(babel-call inline-babel-call))
- org-babel-default-lob-header-args))
- (progn (goto-char (org-element-property :begin datum))
- (org-babel-params-from-properties language))
- (list
- (org-babel-parse-header-arguments
- (org-trim
- (pcase type
- (`src-block
- (mapconcat
- #'identity
- (cons (org-element-property :parameters datum)
- (org-element-property :header datum))
- " "))
- (`inline-src-block
- (or (org-element-property :parameters datum) ""))
- (_
- (concat
- (org-element-property :inside-header datum)
- " "
- (org-element-property :end-header datum)))))))))))
+ (org-babel-parse-header-arguments
+ (org-trim
+ (pcase type
+ (`src-block
+ (mapconcat
+ #'identity
+ (cons (org-element-property :parameters datum)
+ (org-element-property :header datum))
+ " "))
+ (`inline-src-block
+ (or (org-element-property :parameters datum) ""))
+ (_
+ (concat
+ (org-element-property :inside-header datum)
+ " "
+ (org-element-property :end-header datum))))))))
(dolist (header datum-header-values)
(let ((allowed-values
(cdr (assoc-string (substring (symbol-name (car header)) 1)
@@ -1002,14 +1060,15 @@ for `tabulated-list-printer'."
(mapcar
(lambda (report)
(list
- (incf id)
+ (cl-incf id)
(apply #'vector
(cons
(progn
(goto-char (car report))
(beginning-of-line)
(prog1 (number-to-string
- (incf last-line (count-lines last-pos (point))))
+ (cl-incf last-line
+ (count-lines last-pos (point))))
(setf last-pos (point))))
(cdr report)))))
;; Insert trust level in generated reports. Also sort them
@@ -1103,16 +1162,16 @@ Checker will also be ignored in all subsequent reports."
(defun org-lint (&optional arg)
"Check current Org buffer for syntax mistakes.
-By default, run all checkers. With a single prefix ARG \
-\\[universal-argument],
-select one category of checkers only. With a double prefix
-\\[universal-argument] \\[universal-argument], select one precise \
+By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \
+select one
+category of checkers only. With a `\\[universal-argument] \
+\\[universal-argument]' prefix, run one precise
checker by its name.
ARG can also be a list of checker names, as symbols, to run."
(interactive "P")
(unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
- (when (org-called-interactively-p)
+ (when (called-interactively-p 'any)
(message "Org linting process starting..."))
(let ((checkers
(pcase arg
@@ -1141,7 +1200,7 @@ ARG can also be a list of checker names, as symbols, to run."
(cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
org-lint--checkers))
(_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
- (if (not (org-called-interactively-p))
+ (if (not (called-interactively-p 'any))
(org-lint--generate-reports (current-buffer) checkers)
(org-lint--display-reports (current-buffer) checkers)
(message "Org linting process completed"))))
diff --git a/lisp/org-list.el b/lisp/org-list.el
index d264451..e8d9aef 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -1,4 +1,4 @@
-;;; org-list.el --- Plain lists for Org-mode
+;;; org-list.el --- Plain lists for Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
;;
@@ -25,7 +25,7 @@
;;
;;; Commentary:
-;; This file contains the code dealing with plain lists in Org-mode.
+;; This file contains the code dealing with plain lists in Org mode.
;; The core concept behind lists is their structure. A structure is
;; a snapshot of the list, in the shape of a data tree (see
@@ -76,8 +76,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
@@ -88,32 +87,54 @@
(defvar org-closed-string)
(defvar org-deadline-string)
(defvar org-description-max-indent)
+(defvar org-done-keywords)
+(defvar org-drawer-regexp)
+(defvar org-element-all-objects)
+(defvar org-inhibit-startup)
(defvar org-odd-levels-only)
+(defvar org-outline-regexp-bol)
(defvar org-scheduled-string)
+(defvar org-todo-line-regexp)
(defvar org-ts-regexp)
(defvar org-ts-regexp-both)
-(defvar org-drawer-regexp)
(declare-function org-at-heading-p "org" (&optional invisible-ok))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-combine-plists "org" (&rest plists))
-(declare-function org-count "org" (cl-item cl-seq))
(declare-function org-current-level "org" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
-(declare-function org-element-lineage "org-element"
- (blob &optional types with-self))
+(declare-function org-element-interpret-data "org-element" (data))
+(declare-function
+ org-element-lineage "org-element" (blob &optional types with-self))
+(declare-function org-element-macro-interpreter "org-element" (macro ##))
+(declare-function
+ org-element-map "org-element"
+ (data types fun &optional info first-match no-recursion with-affiliated))
+(declare-function org-element-normalize-string "org-element" (s))
+(declare-function org-element-parse-buffer "org-element"
+ (&optional granularity visible-only))
(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-put-property "org-element"
+ (element property value))
+(declare-function org-element-set-element "org-element" (old new))
(declare-function org-element-type "org-element" (element))
(declare-function org-element-update-syntax "org-element" ())
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
-(declare-function org-export-string-as "ox"
- (string backend &optional body-only ext-plist))
+(declare-function org-export-create-backend "ox" (&rest rest) t)
+(declare-function org-export-data-with-backend "ox" (data backend info))
+(declare-function org-export-get-backend "ox" (name))
+(declare-function org-export-get-environment "ox"
+ (&optional backend subtreep ext-plist))
+(declare-function org-export-get-next-element "ox"
+ (blob info &optional n))
+(declare-function org-export-with-backend "ox"
+ (backend data &optional contents info))
(declare-function org-fix-tags-on-the-fly "org" ())
(declare-function org-get-indentation "org" (&optional line))
-(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-get-todo-state "org" ())
(declare-function org-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
@@ -122,15 +143,16 @@
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-outline-level "org" ())
(declare-function org-previous-line-empty-p "org" ())
(declare-function org-reduced-level "org" (L))
-(declare-function org-remove-if "org" (predicate seq))
+(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-show-subtree "org" ())
(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
(declare-function org-timer-hms-to-secs "org-timer" (hms))
(declare-function org-timer-item "org-timer" (&optional arg))
-(declare-function org-trim "org" (s))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function org-uniquify "org" (list))
(declare-function outline-flag-region "outline" (from to flag))
(declare-function outline-invisible-p "outline" (&optional pos))
@@ -142,7 +164,7 @@
;;; Configuration variables
(defgroup org-plain-lists nil
- "Options concerning plain lists in Org-mode."
+ "Options concerning plain lists in Org mode."
:tag "Org Plain lists"
:group 'org-structure)
@@ -219,7 +241,7 @@ This variable needs to be set before org.el is loaded. If you
need to make a change while Emacs is running, use the customize
interface or run the following code after updating it:
- \\[org-element-update-syntax]"
+ `\\[org-element-update-syntax]'"
:group 'org-plain-lists
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
@@ -227,8 +249,6 @@ interface or run the following code after updating it:
:set (lambda (var val) (set var val)
(when (featurep 'org-element) (org-element-update-syntax))))
-(define-obsolete-variable-alias 'org-alphabetical-lists
- 'org-list-allow-alphabetical "24.4") ; Since 8.0
(defcustom org-list-allow-alphabetical nil
"Non-nil means single character alphabetical bullets are allowed.
@@ -240,7 +260,7 @@ This variable needs to be set before org.el is loaded. If you
need to make a change while Emacs is running, use the customize
interface or run the following code after updating it:
- \\[org-element-update-syntax]"
+ `\\[org-element-update-syntax]'"
:group 'org-plain-lists
:version "24.1"
:type 'boolean
@@ -259,23 +279,22 @@ spaces instead of one after the bullet in each item of the list."
(const :tag "never" nil)
(regexp)))
-(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists
- 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0
-(defcustom org-list-empty-line-terminates-plain-lists nil
- "Non-nil means an empty line ends all plain list levels.
-Otherwise, two of them will be necessary."
- :group 'org-plain-lists
- :type 'boolean)
-
(defcustom org-list-automatic-rules '((checkbox . t)
(indent . t))
"Non-nil means apply set of rules when acting on lists.
+\\<org-mode-map>
By default, automatic actions are taken when using
- \\[org-meta-return], \\[org-metaright], \\[org-metaleft],
- \\[org-shiftmetaright], \\[org-shiftmetaleft],
- \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
- \\[org-insert-todo-heading]. You can disable individually these
- rules by setting them to nil. Valid rules are:
+ `\\[org-meta-return]',
+ `\\[org-metaright]',
+ `\\[org-metaleft]',
+ `\\[org-shiftmetaright]',
+ `\\[org-shiftmetaleft]',
+ `\\[org-ctrl-c-minus]',
+ `\\[org-toggle-checkbox]',
+ `\\[org-insert-todo-heading]'.
+
+You can disable individually these rules by setting them to nil.
+Valid rules are:
checkbox when non-nil, checkbox statistics is updated each time
you either insert a new checkbox or toggle a checkbox.
@@ -295,13 +314,15 @@ indent when non-nil, indenting or outdenting list top-item
(defcustom org-list-use-circular-motion nil
"Non-nil means commands implying motion in lists should be cyclic.
-
+\\<org-mode-map>
In that case, the item following the last item is the first one,
and the item preceding the first item is the last one.
-This affects the behavior of \\[org-move-item-up],
- \\[org-move-item-down], \\[org-next-item] and
- \\[org-previous-item]."
+This affects the behavior of
+ `\\[org-move-item-up]',
+ `\\[org-move-item-down]',
+ `\\[org-next-item]',
+ `\\[org-previous-item]'."
:group 'org-plain-lists
:version "24.1"
:type 'boolean)
@@ -313,8 +334,6 @@ This hook runs even if checkbox rule in
implement alternative ways of collecting statistics
information.")
-(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
- 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0
(defcustom org-checkbox-hierarchical-statistics t
"Non-nil means checkbox statistics counts only the state of direct children.
When nil, all boxes below the cookie are counted.
@@ -323,8 +342,6 @@ with the word \"recursive\" in the value."
:group 'org-plain-lists
:type 'boolean)
-(org-defvaralias 'org-description-max-indent
- 'org-list-description-max-indent) ;; Since 8.0
(defcustom org-list-description-max-indent 20
"Maximum indentation for the second line of a description list.
When the indentation would be larger than this, it will become
@@ -367,8 +384,7 @@ list, obtained by prompting the user."
(list (symbol :tag "Major mode")
(string :tag "Format"))))
-(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
- "html" "latex" "odt")
+(defvar org-list-forbidden-blocks '("example" "verse" "src" "export")
"Names of blocks where lists are not allowed.
Names must be in lower case.")
@@ -383,10 +399,8 @@ specifically, type `block' is determined by the variable
;;; Predicates and regexps
-(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n"
- "^[ \t]*\n[ \t]*\n")
- "Regex corresponding to the end of a list.
-It depends on `org-list-empty-line-terminates-plain-lists'.")
+(defconst org-list-end-re "^[ \t]*\n[ \t]*\n"
+ "Regex matching the end of a plain list.")
(defconst org-list-full-item-re
(concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
@@ -653,7 +667,7 @@ Assume point is at an item."
(match-string-no-properties 2) ; counter
(match-string-no-properties 3) ; checkbox
;; Description tag.
- (and (save-match-data (string-match "[-+*]" bullet))
+ (and (string-match-p "[-+*]" bullet)
(match-string-no-properties 4)))))))
(end-before-blank
(function
@@ -1020,7 +1034,7 @@ Possible types are `descriptive', `ordered' and `unordered'. The
type is determined by the first item of the list."
(let ((first (org-list-get-list-begin item struct prevs)))
(cond
- ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
+ ((string-match-p "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
((org-list-get-tag first struct) 'descriptive)
(t 'unordered))))
@@ -1042,7 +1056,7 @@ that value."
(let ((seq 0) (pos item) counter)
(while (and (not (setq counter (org-list-get-counter pos struct)))
(setq pos (org-list-get-prev-item pos struct prevs)))
- (incf seq))
+ (cl-incf seq))
(if (not counter) (1+ seq)
(cond
((string-match "[A-Za-z]" counter)
@@ -1222,7 +1236,7 @@ some heuristics to guess the result."
(point))))))))
(cond
;; Trivial cases where there should be none.
- ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
+ ((not insert-blank-p) 0)
;; When `org-blank-before-new-entry' says so, it is 1.
((eq insert-blank-p t) 1)
;; `plain-list-item' is 'auto. Count blank lines separating
@@ -1324,7 +1338,7 @@ This function modifies STRUCT."
(size-offset (- item-size (length text-cut))))
;; 4. Insert effectively item into buffer.
(goto-char item)
- (org-indent-to-column ind)
+ (indent-to-column ind)
(insert body item-sep)
;; 5. Add new item to STRUCT.
(mapc (lambda (e)
@@ -1466,7 +1480,7 @@ This function returns, destructively, the new list structure."
(save-excursion
(goto-char (org-list-get-last-item item struct prevs))
(point-at-eol)))
- ((string-match "\\`[0-9]+\\'" dest)
+ ((string-match-p "\\`[0-9]+\\'" dest)
(let* ((all (org-list-get-all-items item struct prevs))
(len (length all))
(index (mod (string-to-number dest) len)))
@@ -1481,7 +1495,7 @@ This function returns, destructively, the new list structure."
(t dest)))
(org-M-RET-may-split-line nil)
;; Store inner overlays (to preserve visibility).
- (overlays (org-remove-if (lambda (o) (or (< (overlay-start o) item)
+ (overlays (cl-remove-if (lambda (o) (or (< (overlay-start o) item)
(> (overlay-end o) item)))
(overlays-in item item-end))))
(cond
@@ -1640,7 +1654,7 @@ as returned by `org-list-prevs-alist'."
(while item
(let ((count (org-list-get-counter item struct)))
;; Virtually determine current bullet
- (if (and count (string-match "[a-zA-Z]" count))
+ (if (and count (string-match-p "[a-zA-Z]" count))
;; Counters are not case-sensitive.
(setq ascii (string-to-char (upcase count)))
(setq ascii (1+ ascii)))
@@ -1883,8 +1897,8 @@ Initial position of cursor is restored after the changes."
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning))
;; Shift only non-empty lines.
- ((org-looking-at-p "^[ \t]*\\S-")
- (org-indent-line-to (+ (org-get-indentation) delta))))
+ ((looking-at-p "^[ \t]*\\S-")
+ (indent-line-to (+ (org-get-indentation) delta))))
(forward-line -1)))))
(modify-item
(function
@@ -1967,7 +1981,7 @@ Initial position of cursor is restored after the changes."
(while (< (point) down)
;; Ignore empty lines. Also ignore blocks and
;; drawers contents.
- (unless (org-looking-at-p "[ \t]*$")
+ (unless (looking-at-p "[ \t]*$")
(setq min-ind (min (org-get-indentation) min-ind))
(cond
((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
@@ -2087,11 +2101,11 @@ Possible values are: `folded', `children' or `subtree'. See
(if (match-beginning 2)
(let ((start (1+ (match-end 2)))
(ind (org-get-indentation)))
- (if (> start (+ ind org-description-max-indent)) (+ ind 5) start))
+ (if (> start (+ ind org-list-description-max-indent)) (+ ind 5) start))
(+ (progn (goto-char (match-end 1)) (current-column))
(if (and org-list-two-spaces-after-bullet-regexp
- (org-string-match-p org-list-two-spaces-after-bullet-regexp
- (match-string 1)))
+ (string-match-p org-list-two-spaces-after-bullet-regexp
+ (match-string 1)))
2
1)))))
@@ -2410,7 +2424,7 @@ in subtree, ignoring drawers."
(parents (org-list-parents-alist struct))
(prevs (org-list-prevs-alist struct))
(bottom (copy-marker (org-list-get-bottom-point struct)))
- (items-to-toggle (org-remove-if
+ (items-to-toggle (cl-remove-if
(lambda (e) (or (< e lim-up) (> e lim-down)))
(mapcar #'car struct))))
(mapc (lambda (e) (org-list-set-checkbox
@@ -2506,8 +2520,8 @@ With optional prefix argument ALL, do this for the whole buffer."
(lambda (e)
(org-list-get-checkbox e s))
items))))
- (incf c-all (length cookies))
- (incf c-on (org-count "[X]" cookies)))))))
+ (cl-incf c-all (length cookies))
+ (cl-incf c-on (cl-count "[X]" cookies :test #'equal)))))))
cookies-list cache)
;; Move to start.
(cond (all (goto-char (point-min)))
@@ -2685,7 +2699,7 @@ Return t if successful."
;; of the subtree mustn't have a child.
(let ((last-item (caar
(reverse
- (org-remove-if
+ (cl-remove-if
(lambda (e) (>= (car e) end))
struct)))))
(org-list-has-child-p last-item struct))))
@@ -2802,7 +2816,7 @@ Return t at each successful move."
((and (= ind (car org-tab-ind-state))
(ignore-errors (org-list-indent-item-generic 1 t struct))))
(t (delete-region (point-at-bol) (point-at-eol))
- (org-indent-to-column (car org-tab-ind-state))
+ (indent-to-column (car org-tab-ind-state))
(insert (cdr org-tab-ind-state) " ")
;; Break cycle
(setq this-command 'identity)))
@@ -2862,8 +2876,8 @@ ignores hidden links."
(getkey-func
(or getkey-func
(and (= (downcase sorting-type) ?f)
- (intern (org-icompleting-read "Sort using function: "
- obarray 'fboundp t nil nil))))))
+ (intern (completing-read "Sort using function: "
+ obarray 'fboundp t nil nil))))))
(message "Sorting items...")
(save-restriction
(narrow-to-region start end)
@@ -2905,7 +2919,7 @@ ignores hidden links."
(save-excursion (re-search-forward org-ts-regexp-both
(point-at-eol) t)))
(org-time-string-to-seconds (match-string 0)))
- (t (org-float-time now))))
+ (t (float-time now))))
((= dcst ?x) (or (and (stringp (match-string 1))
(match-string 1))
""))
@@ -2929,128 +2943,249 @@ ignores hidden links."
(run-hooks 'org-after-sorting-entries-or-items-hook)
(message "Sorting items...done")))))
+(defun org-toggle-item (arg)
+ "Convert headings or normal lines to items, items to normal lines.
+If there is no active region, only the current line is considered.
+
+If the first non blank line in the region is a headline, convert
+all headlines to items, shifting text accordingly.
+
+If it is an item, convert all items to normal lines.
+
+If it is normal text, change region into a list of items.
+With a prefix argument ARG, change the region in a single item."
+ (interactive "P")
+ (let ((shift-text
+ (lambda (ind end)
+ ;; Shift text in current section to IND, from point to END.
+ ;; The function leaves point to END line.
+ (let ((min-i 1000) (end (copy-marker end)))
+ ;; First determine the minimum indentation (MIN-I) of
+ ;; the text.
+ (save-excursion
+ (catch 'exit
+ (while (< (point) end)
+ (let ((i (org-get-indentation)))
+ (cond
+ ;; Skip blank lines and inline tasks.
+ ((looking-at "^[ \t]*$"))
+ ((looking-at org-outline-regexp-bol))
+ ;; We can't find less than 0 indentation.
+ ((zerop i) (throw 'exit (setq min-i 0)))
+ ((< i min-i) (setq min-i i))))
+ (forward-line))))
+ ;; Then indent each line so that a line indented to
+ ;; MIN-I becomes indented to IND. Ignore blank lines
+ ;; and inline tasks in the process.
+ (let ((delta (- ind min-i)))
+ (while (< (point) end)
+ (unless (or (looking-at "^[ \t]*$")
+ (looking-at org-outline-regexp-bol))
+ (indent-line-to (+ (org-get-indentation) delta)))
+ (forward-line))))))
+ (skip-blanks
+ (lambda (pos)
+ ;; Return beginning of first non-blank line, starting from
+ ;; line at POS.
+ (save-excursion
+ (goto-char pos)
+ (skip-chars-forward " \r\t\n")
+ (point-at-bol))))
+ beg end)
+ ;; Determine boundaries of changes.
+ (if (org-region-active-p)
+ (setq beg (funcall skip-blanks (region-beginning))
+ end (copy-marker (region-end)))
+ (setq beg (funcall skip-blanks (point-at-bol))
+ end (copy-marker (point-at-eol))))
+ ;; Depending on the starting line, choose an action on the text
+ ;; between BEG and END.
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char beg)
+ (cond
+ ;; Case 1. Start at an item: de-itemize. Note that it only
+ ;; happens when a region is active: `org-ctrl-c-minus'
+ ;; would call `org-cycle-list-bullet' otherwise.
+ ((org-at-item-p)
+ (while (< (point) end)
+ (when (org-at-item-p)
+ (skip-chars-forward " \t")
+ (delete-region (point) (match-end 0)))
+ (forward-line)))
+ ;; Case 2. Start at an heading: convert to items.
+ ((org-at-heading-p)
+ (let* ((bul (org-list-bullet-string "-"))
+ (bul-len (length bul))
+ ;; Indentation of the first heading. It should be
+ ;; relative to the indentation of its parent, if any.
+ (start-ind (save-excursion
+ (cond
+ ((not org-adapt-indentation) 0)
+ ((not (outline-previous-heading)) 0)
+ (t (length (match-string 0))))))
+ ;; Level of first heading. Further headings will be
+ ;; compared to it to determine hierarchy in the list.
+ (ref-level (org-reduced-level (org-outline-level))))
+ (while (< (point) end)
+ (let* ((level (org-reduced-level (org-outline-level)))
+ (delta (max 0 (- level ref-level)))
+ (todo-state (org-get-todo-state)))
+ ;; If current headline is less indented than the first
+ ;; one, set it as reference, in order to preserve
+ ;; subtrees.
+ (when (< level ref-level) (setq ref-level level))
+ ;; Remove stars and TODO keyword.
+ (looking-at org-todo-line-regexp)
+ (delete-region (point) (or (match-beginning 3)
+ (line-end-position)))
+ (insert bul)
+ (indent-line-to (+ start-ind (* delta bul-len)))
+ ;; Turn TODO keyword into a check box.
+ (when todo-state
+ (let* ((struct (org-list-struct))
+ (old (copy-tree struct)))
+ (org-list-set-checkbox
+ (line-beginning-position)
+ struct
+ (if (member todo-state org-done-keywords)
+ "[X]"
+ "[ ]"))
+ (org-list-write-struct struct
+ (org-list-parents-alist struct)
+ old)))
+ ;; Ensure all text down to END (or SECTION-END) belongs
+ ;; to the newly created item.
+ (let ((section-end (save-excursion
+ (or (outline-next-heading) (point)))))
+ (forward-line)
+ (funcall shift-text
+ (+ start-ind (* (1+ delta) bul-len))
+ (min end section-end)))))))
+ ;; Case 3. Normal line with ARG: make the first line of region
+ ;; an item, and shift indentation of others lines to
+ ;; set them as item's body.
+ (arg (let* ((bul (org-list-bullet-string "-"))
+ (bul-len (length bul))
+ (ref-ind (org-get-indentation)))
+ (skip-chars-forward " \t")
+ (insert bul)
+ (forward-line)
+ (while (< (point) end)
+ ;; Ensure that lines less indented than first one
+ ;; still get included in item body.
+ (funcall shift-text
+ (+ ref-ind bul-len)
+ (min end (save-excursion (or (outline-next-heading)
+ (point)))))
+ (forward-line))))
+ ;; Case 4. Normal line without ARG: turn each non-item line
+ ;; into an item.
+ (t
+ (while (< (point) end)
+ (unless (or (org-at-heading-p) (org-at-item-p))
+ (when (looking-at "\\([ \t]*\\)\\(\\S-\\)")
+ (replace-match
+ (concat "\\1" (org-list-bullet-string "-") "\\2"))))
+ (forward-line))))))))
;;; Send and receive lists
-(defun org-list-parse-list (&optional delete)
+(defun org-list-to-lisp (&optional delete)
"Parse the list at point and maybe DELETE it.
Return a list whose car is a symbol of list type, among
`ordered', `unordered' and `descriptive'. Then, each item is
-a list whose car is counter, and cdr are strings and other
-sub-lists. Inside strings, check-boxes are replaced by
-\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\".
+a list of strings and other sub-lists.
For example, the following list:
-1. first item
- + sub-item one
- + [X] sub-item two
- more text in first item
-2. [@3] last item
+ 1. first item
+ + sub-item one
+ + [X] sub-item two
+ more text in first item
+ 2. [@3] last item
-will be parsed as:
+is parsed as
(ordered
- (nil \"first item\"
- (unordered
- (nil \"sub-item one\")
- (nil \"[CBON] sub-item two\"))
- \"more text in first item\")
- (3 \"last item\"))
-
-Point is left at list end."
- (defvar parse-item) ;FIXME: Or use `cl-labels' or `letrec'.
- (let* ((struct (org-list-struct))
- (prevs (org-list-prevs-alist struct))
- (parents (org-list-parents-alist struct))
- (top (org-list-get-top-point struct))
- (bottom (org-list-get-bottom-point struct))
- out
- (get-text
- (function
- ;; Return text between BEG and END, trimmed, with
- ;; checkboxes replaced.
- (lambda (beg end)
- (let ((text (org-trim (buffer-substring beg end))))
- (if (string-match "\\`\\[\\([-X ]\\)\\]" text)
- (replace-match
- (let ((box (match-string 1 text)))
- (cond
- ((equal box " ") "CBOFF")
- ((equal box "-") "CBTRANS")
- (t "CBON")))
- t nil text 1)
- text)))))
- (parse-sublist
- (function
- ;; Return a list whose car is list type and cdr a list of
- ;; items' body.
- (lambda (e)
- (cons (org-list-get-list-type (car e) struct prevs)
- (mapcar parse-item e)))))
- (parse-item
- (function
- ;; Return a list containing counter of item, if any, text
- ;; and any sublist inside it.
- (lambda (e)
- (let ((start (save-excursion
- (goto-char e)
- (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
- (match-end 0)))
- ;; Get counter number. For alphabetic counter, get
- ;; its position in the alphabet.
- (counter (let ((c (org-list-get-counter e struct)))
- (cond
- ((not c) nil)
- ((string-match "[A-Za-z]" c)
- (- (string-to-char (upcase (match-string 0 c)))
- 64))
- ((string-match "[0-9]+" c)
- (string-to-number (match-string 0 c))))))
- (childp (org-list-has-child-p e struct))
- (end (org-list-get-item-end e struct)))
- ;; If item has a child, store text between bullet and
- ;; next child, then recursively parse all sublists. At
- ;; the end of each sublist, check for the presence of
- ;; text belonging to the original item.
- (if childp
- (let* ((children (org-list-get-children e struct parents))
- (body (list (funcall get-text start childp))))
- (while children
- (let* ((first (car children))
- (sub (org-list-get-all-items first struct prevs))
- (last-c (car (last sub)))
- (last-end (org-list-get-item-end last-c struct)))
- (push (funcall parse-sublist sub) body)
- ;; Remove children from the list just parsed.
- (setq children (cdr (member last-c children)))
- ;; There is a chunk of text belonging to the
- ;; item if last child doesn't end where next
- ;; child starts or where item ends.
- (unless (= (or (car children) end) last-end)
- (push (funcall get-text
- last-end (or (car children) end))
- body))))
- (cons counter (nreverse body)))
- (list counter (funcall get-text start end))))))))
+ (\"first item\"
+ (unordered
+ (\"sub-item one\")
+ (\"[X] sub-item two\"))
+ \"more text in first item\")
+ (\"[@3] last item\"))
+
+Point is left at list's end."
+ (letrec ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (parents (org-list-parents-alist struct))
+ (top (org-list-get-top-point struct))
+ (bottom (org-list-get-bottom-point struct))
+ (trim
+ (lambda (text)
+ ;; Remove indentation and final newline from TEXT.
+ (org-remove-indentation
+ (if (string-match-p "\n\\'" text)
+ (substring text 0 -1)
+ text))))
+ (parse-sublist
+ (lambda (e)
+ ;; Return a list whose car is list type and cdr a list
+ ;; of items' body.
+ (cons (org-list-get-list-type (car e) struct prevs)
+ (mapcar parse-item e))))
+ (parse-item
+ (lambda (e)
+ ;; Return a list containing counter of item, if any,
+ ;; text and any sublist inside it.
+ (let* ((end (org-list-get-item-end e struct))
+ (children (org-list-get-children e struct parents))
+ (body
+ (save-excursion
+ (goto-char e)
+ (looking-at "[ \t]*\\S-+[ \t]*")
+ (list
+ (funcall
+ trim
+ (concat
+ (make-string (string-width (match-string 0)) ?\s)
+ (buffer-substring-no-properties
+ (match-end 0) (or (car children) end))))))))
+ (while children
+ (let* ((child (car children))
+ (sub (org-list-get-all-items child struct prevs))
+ (last-in-sub (car (last sub))))
+ (push (funcall parse-sublist sub) body)
+ ;; Remove whole sub-list from children.
+ (setq children (cdr (memq last-in-sub children)))
+ ;; There is a chunk of text belonging to the item
+ ;; if last child doesn't end where next child
+ ;; starts or where item ends.
+ (let ((sub-end (org-list-get-item-end last-in-sub struct))
+ (next (or (car children) end)))
+ (when (/= sub-end next)
+ (push (funcall
+ trim
+ (buffer-substring-no-properties sub-end next))
+ body)))))
+ (nreverse body)))))
;; Store output, take care of cursor position and deletion of
;; list, then return output.
- (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs)))
- (goto-char top)
- (when delete
- (delete-region top bottom)
- (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
- (replace-match "")))
- out))
+ (prog1 (funcall parse-sublist (org-list-get-all-items top struct prevs))
+ (goto-char top)
+ (when delete
+ (delete-region top bottom)
+ (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
+ (replace-match ""))))))
(defun org-list-make-subtree ()
"Convert the plain list at point into a subtree."
(interactive)
(if (not (ignore-errors (goto-char (org-in-item-p))))
(error "Not in a list")
- (let ((list (save-excursion (org-list-parse-list t))))
+ (let ((list (save-excursion (org-list-to-lisp t))))
(insert (org-list-to-subtree list)))))
(defun org-list-insert-radio-list ()
@@ -3076,11 +3211,13 @@ for this list."
(catch 'exit
(unless (org-at-item-p) (error "Not at a list item"))
(save-excursion
- (re-search-backward "#\\+ORGLST" nil t)
- (unless (looking-at "\\(?:[ \t]\\)?#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)")
- (if maybe (throw 'exit nil)
- (error "Don't know how to transform this list"))))
- (let* ((name (match-string 1))
+ (let ((case-fold-search t))
+ (re-search-backward "^[ \t]*#\\+ORGLST:" nil t)
+ (unless (looking-at
+ "[ \t]*#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\([^ \t\n]+\\)")
+ (if maybe (throw 'exit nil)
+ (error "Don't know how to transform this list")))))
+ (let* ((name (regexp-quote (match-string 1)))
(transform (intern (match-string 2)))
(bottom-point
(save-excursion
@@ -3092,220 +3229,342 @@ for this list."
(re-search-backward "#\\+ORGLST" nil t)
(re-search-forward (org-item-beginning-re) bottom-point t)
(match-beginning 0)))
- (plain-list (buffer-substring-no-properties top-point bottom-point))
- beg)
+ (plain-list (save-excursion
+ (goto-char top-point)
+ (org-list-to-lisp))))
(unless (fboundp transform)
(error "No such transformation function %s" transform))
(let ((txt (funcall transform plain-list)))
- ;; Find the insertion place
+ ;; Find the insertion(s) place(s).
(save-excursion
(goto-char (point-min))
- (unless (re-search-forward
- (concat "BEGIN RECEIVE ORGLST +"
- name
- "\\([ \t]\\|$\\)")
- nil t)
- (error "Don't know where to insert translated list"))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (setq beg (point))
- (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
- (error "Cannot find end of insertion region"))
- (delete-region beg (point-at-bol))
- (goto-char beg)
- (insert txt "\n")))
- (message "List converted and installed at receiver location"))))
-
-(defsubst org-list-item-trim-br (item)
- "Trim line breaks in a list ITEM."
- (setq item (replace-regexp-in-string "\n +" " " item)))
+ (let ((receiver-count 0)
+ (begin-re (format "BEGIN +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)"
+ name))
+ (end-re (format "END +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)"
+ name)))
+ (while (re-search-forward begin-re nil t)
+ (cl-incf receiver-count)
+ (let ((beg (line-beginning-position 2)))
+ (unless (re-search-forward end-re nil t)
+ (user-error "Cannot find end of receiver location at %d" beg))
+ (beginning-of-line)
+ (delete-region beg (point))
+ (insert txt "\n")))
+ (cond
+ ((> receiver-count 1)
+ (message "List converted and installed at receiver locations"))
+ ((= receiver-count 1)
+ (message "List converted and installed at receiver location"))
+ (t (user-error "No valid receiver location found")))))))))
(defun org-list-to-generic (list params)
- "Convert a LIST parsed through `org-list-parse-list' to other formats.
-Valid parameters PARAMS are:
-
-:ustart String to start an unordered list
-:uend String to end an unordered list
-
-:ostart String to start an ordered list
-:oend String to end an ordered list
-
-:dstart String to start a descriptive list
-:dend String to end a descriptive list
-:dtstart String to start a descriptive term
-:dtend String to end a descriptive term
-:ddstart String to start a description
-:ddend String to end a description
-
-:splice When set to t, return only list body lines, don't wrap
- them into :[u/o]start and :[u/o]end. Default is nil.
-
-:istart String to start a list item.
-:icount String to start an item with a counter.
-:iend String to end a list item
-:isep String to separate items
-:lsep String to separate sublists
-:csep String to separate text from a sub-list
-
-:cboff String to insert for an unchecked check-box
-:cbon String to insert for a checked check-box
-:cbtrans String to insert for a check-box in transitional state
-
-:nobr Non-nil means remove line breaks in lists items.
-
-Alternatively, each parameter can also be a form returning
-a string. These sexp can use keywords `counter' and `depth',
-representing respectively counter associated to the current
-item, and depth of the current sub-list, starting at 0.
-Obviously, `counter' is only available for parameters applying to
-items."
- (interactive)
- (let* ((p params)
- (splicep (plist-get p :splice))
- (ostart (plist-get p :ostart))
- (oend (plist-get p :oend))
- (ustart (plist-get p :ustart))
- (uend (plist-get p :uend))
- (dstart (plist-get p :dstart))
- (dend (plist-get p :dend))
- (dtstart (plist-get p :dtstart))
- (dtend (plist-get p :dtend))
- (ddstart (plist-get p :ddstart))
- (ddend (plist-get p :ddend))
- (istart (plist-get p :istart))
- (icount (plist-get p :icount))
- (iend (plist-get p :iend))
- (isep (plist-get p :isep))
- (lsep (plist-get p :lsep))
- (csep (plist-get p :csep))
- (cbon (plist-get p :cbon))
- (cboff (plist-get p :cboff))
- (cbtrans (plist-get p :cbtrans))
- (nobr (plist-get p :nobr))
- export-sublist ; for byte-compiler
- (export-item
- (function
- ;; Export an item ITEM of type TYPE, at DEPTH. First
- ;; string in item is treated in a special way as it can
- ;; bring extra information that needs to be processed.
- (lambda (item type depth)
- (let* ((counter (pop item))
- (fmt (concat
- (cond
- ((eq type 'descriptive)
- ;; Stick DTSTART to ISTART by
- ;; left-trimming the latter.
- (concat (let ((s (eval istart)))
- (or (and (string-match "[ \t\n\r]+\\'" s)
- (replace-match "" t t s))
- istart))
- "%s" (eval ddend)))
- ((and counter (eq type 'ordered))
- (concat (eval icount) "%s"))
- (t (concat (eval istart) "%s")))
- (eval iend)))
- (first (car item)))
- ;; Replace checkbox if any is found.
- (cond
- ((string-match "\\[CBON\\]" first)
- (setq first (replace-match cbon t t first)))
- ((string-match "\\[CBOFF\\]" first)
- (setq first (replace-match cboff t t first)))
- ((string-match "\\[CBTRANS\\]" first)
- (setq first (replace-match cbtrans t t first))))
- ;; Replace line breaks if required
- (when nobr (setq first (org-list-item-trim-br first)))
- ;; Insert descriptive term if TYPE is `descriptive'.
- (when (eq type 'descriptive)
- (let* ((complete
- (string-match "^\\(.*\\)[ \t]+::[ \t]*" first))
- (term (if complete
- (save-match-data
- (org-trim (match-string 1 first)))
- "???"))
- (desc (if complete (substring first (match-end 0))
- first)))
- (setq first (concat (eval dtstart) term (eval dtend)
- (eval ddstart) desc))))
- (setcar item first)
- (format fmt
- (mapconcat (lambda (e)
- (if (stringp e) e
- (funcall export-sublist e (1+ depth))))
- item (or (eval csep) "")))))))
- (export-sublist
- (function
- ;; Export sublist SUB at DEPTH.
- (lambda (sub depth)
- (let* ((type (car sub))
- (items (cdr sub))
- (fmt (concat (cond
- (splicep "%s")
- ((eq type 'ordered)
- (concat (eval ostart) "%s" (eval oend)))
- ((eq type 'descriptive)
- (concat (eval dstart) "%s" (eval dend)))
- (t (concat (eval ustart) "%s" (eval uend))))
- (eval lsep))))
- (format fmt (mapconcat (lambda (e)
- (funcall export-item e type depth))
- items (or (eval isep) ""))))))))
- (concat (funcall export-sublist list 0) "\n")))
-
-(defun org-list-to-latex (list &optional _params)
+ "Convert a LIST parsed through `org-list-to-lisp' to a custom format.
+
+LIST is a list as returned by `org-list-to-lisp', which see.
+PARAMS is a property list of parameters used to tweak the output
+format.
+
+Valid parameters are:
+
+:backend, :raw
+
+ Export back-end used as a basis to transcode elements of the
+ list, when no specific parameter applies to it. It is also
+ used to translate its contents. You can prevent this by
+ setting :raw property to a non-nil value.
+
+:splice
+
+ When non-nil, only export the contents of the top most plain
+ list, effectively ignoring its opening and closing lines.
+
+:ustart, :uend
+
+ Strings to start and end an unordered list. They can also be
+ set to a function returning a string or nil, which will be
+ called with the depth of the list, counting from 1.
+
+:ostart, :oend
+
+ Strings to start and end an ordered list. They can also be set
+ to a function returning a string or nil, which will be called
+ with the depth of the list, counting from 1.
+
+:dstart, :dend
+
+ Strings to start and end a descriptive list. They can also be
+ set to a function returning a string or nil, which will be
+ called with the depth of the list, counting from 1.
+
+:dtstart, :dtend, :ddstart, :ddend
+
+ Strings to start and end a descriptive term.
+
+:istart, :iend
+
+ Strings to start or end a list item, and to start a list item
+ with a counter. They can also be set to a function returning
+ a string or nil, which will be called with the depth of the
+ item, counting from 1.
+
+:icount
+
+ Strings to start a list item with a counter. It can also be
+ set to a function returning a string or nil, which will be
+ called with two arguments: the depth of the item, counting from
+ 1, and the counter. Its value, when non-nil, has precedence
+ over `:istart'.
+
+:isep
+
+ String used to separate items. It can also be set to
+ a function returning a string or nil, which will be called with
+ the depth of the items, counting from 1. It always start on
+ a new line.
+
+:cbon, :cboff, :cbtrans
+
+ String to insert, respectively, an un-checked check-box,
+ a checked check-box and a check-box in transitional state."
+ (require 'ox)
+ (let* ((backend (plist-get params :backend))
+ (custom-backend
+ (org-export-create-backend
+ :parent (or backend 'org)
+ :transcoders
+ `((plain-list . ,(org-list--to-generic-plain-list params))
+ (item . ,(org-list--to-generic-item params))
+ (macro . (lambda (m c i) (org-element-macro-interpreter m nil))))))
+ data info)
+ ;; Write LIST back into Org syntax and parse it.
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)) (org-mode))
+ (letrec ((insert-list
+ (lambda (l)
+ (dolist (i (cdr l))
+ (funcall insert-item i (car l)))))
+ (insert-item
+ (lambda (i type)
+ (let ((start (point)))
+ (insert (if (eq type 'ordered) "1. " "- "))
+ (dolist (e i)
+ (if (consp e) (funcall insert-list e)
+ (insert e)
+ (insert "\n")))
+ (beginning-of-line)
+ (save-excursion
+ (let ((ind (if (eq type 'ordered) 3 2)))
+ (while (> (point) start)
+ (unless (looking-at-p "[ \t]*$")
+ (indent-to ind))
+ (forward-line -1))))))))
+ (funcall insert-list list))
+ (setf data
+ (org-element-map (org-element-parse-buffer) 'plain-list
+ #'identity nil t))
+ (setf info (org-export-get-environment backend nil params)))
+ (when (and backend (symbolp backend) (not (org-export-get-backend backend)))
+ (user-error "Unknown :backend value"))
+ (unless backend (require 'ox-org))
+ ;; When`:raw' property has a non-nil value, turn all objects back
+ ;; into Org syntax.
+ (when (and backend (plist-get params :raw))
+ (org-element-map data org-element-all-objects
+ (lambda (object)
+ (org-element-set-element
+ object (org-element-interpret-data object)))))
+ ;; We use a low-level mechanism to export DATA so as to skip all
+ ;; usual pre-processing and post-processing, i.e., hooks, filters,
+ ;; Babel code evaluation, include keywords and macro expansion,
+ ;; and filters.
+ (let ((output (org-export-data-with-backend data custom-backend info)))
+ ;; Remove final newline.
+ (if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
+
+(defun org-list--depth (element)
+ "Return the level of ELEMENT within current plain list.
+ELEMENT is either an item or a plain list."
+ (cl-count-if (lambda (ancestor) (eq (org-element-type ancestor) 'plain-list))
+ (org-element-lineage element nil t)))
+
+(defun org-list--trailing-newlines (string)
+ "Return the number of trailing newlines in STRING."
+ (with-temp-buffer
+ (insert string)
+ (skip-chars-backward " \t\n")
+ (count-lines (line-beginning-position 2) (point-max))))
+
+(defun org-list--generic-eval (value &rest args)
+ "Evaluate VALUE according to its type.
+VALUE is either nil, a string or a function. In the latter case,
+it is called with arguments ARGS."
+ (cond ((null value) nil)
+ ((stringp value) value)
+ ((functionp value) (apply value args))
+ (t (error "Wrong value: %s" value))))
+
+(defun org-list--to-generic-plain-list (params)
+ "Return a transcoder for `plain-list' elements.
+PARAMS is a plist used to tweak the behavior of the transcoder."
+ (let ((ustart (plist-get params :ustart))
+ (uend (plist-get params :uend))
+ (ostart (plist-get params :ostart))
+ (oend (plist-get params :oend))
+ (dstart (plist-get params :dstart))
+ (dend (plist-get params :dend))
+ (splice (plist-get params :splice))
+ (backend (plist-get params :backend)))
+ (lambda (plain-list contents info)
+ (let* ((type (org-element-property :type plain-list))
+ (depth (org-list--depth plain-list))
+ (start (and (not splice)
+ (org-list--generic-eval
+ (pcase type
+ (`ordered ostart)
+ (`unordered ustart)
+ (_ dstart))
+ depth)))
+ (end (and (not splice)
+ (org-list--generic-eval
+ (pcase type
+ (`ordered oend)
+ (`unordered uend)
+ (_ dend))
+ depth))))
+ ;; Make sure trailing newlines in END appear in the output by
+ ;; setting `:post-blank' property to their number.
+ (when end
+ (org-element-put-property
+ plain-list :post-blank (org-list--trailing-newlines end)))
+ ;; Build output.
+ (concat (and start (concat start "\n"))
+ (if (or start end splice (not backend))
+ contents
+ (org-export-with-backend backend plain-list contents info))
+ end)))))
+
+(defun org-list--to-generic-item (params)
+ "Return a transcoder for `item' elements.
+PARAMS is a plist used to tweak the behavior of the transcoder."
+ (let ((backend (plist-get params :backend))
+ (istart (plist-get params :istart))
+ (iend (plist-get params :iend))
+ (isep (plist-get params :isep))
+ (icount (plist-get params :icount))
+ (cboff (plist-get params :cboff))
+ (cbon (plist-get params :cbon))
+ (cbtrans (plist-get params :cbtrans))
+ (dtstart (plist-get params :dtstart))
+ (dtend (plist-get params :dtend))
+ (ddstart (plist-get params :ddstart))
+ (ddend (plist-get params :ddend)))
+ (lambda (item contents info)
+ (let* ((type
+ (org-element-property :type (org-element-property :parent item)))
+ (tag (org-element-property :tag item))
+ (depth (org-list--depth item))
+ (separator (and (org-export-get-next-element item info)
+ (org-list--generic-eval isep depth)))
+ (closing (pcase (org-list--generic-eval iend depth)
+ ((or `nil `"") "\n")
+ ((and (guard separator) s)
+ (if (equal (substring s -1) "\n") s (concat s "\n")))
+ (s s))))
+ ;; When a closing line or a separator is provided, make sure
+ ;; its trailing newlines are taken into account when building
+ ;; output. This is done by setting `:post-blank' property to
+ ;; the number of such lines in the last line to be added.
+ (let ((last-string (or separator closing)))
+ (when last-string
+ (org-element-put-property
+ item
+ :post-blank
+ (max (1- (org-list--trailing-newlines last-string)) 0))))
+ ;; Build output.
+ (concat
+ (let ((c (org-element-property :counter item)))
+ (if c (org-list--generic-eval icount depth c)
+ (org-list--generic-eval istart depth)))
+ (let ((body
+ (if (or istart iend icount cbon cboff cbtrans (not backend)
+ (and (eq type 'descriptive)
+ (or dtstart dtend ddstart ddend)))
+ (concat
+ (pcase (org-element-property :checkbox item)
+ (`on cbon)
+ (`off cboff)
+ (`trans cbtrans))
+ (and tag
+ (concat dtstart
+ (if backend
+ (org-export-data-with-backend
+ tag backend info)
+ (org-element-interpret-data tag))
+ dtend))
+ (and tag ddstart)
+ (if (= (length contents) 0) "" (substring contents 0 -1))
+ (and tag ddend))
+ (org-export-with-backend backend item contents info))))
+ ;; Remove final newline.
+ (if (equal body "") ""
+ (substring (org-element-normalize-string body) 0 -1)))
+ closing
+ separator)))))
+
+(defun org-list-to-latex (list &optional params)
"Convert LIST into a LaTeX list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+PARAMS is a property list with overruling parameters for
+`org-list-to-generic'. Return converted list as a string."
(require 'ox-latex)
- (org-export-string-as list 'latex t))
+ (org-list-to-generic list (org-combine-plists '(:backend latex) params)))
-(defun org-list-to-html (list)
+(defun org-list-to-html (list &optional params)
"Convert LIST into a HTML list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+PARAMS is a property list with overruling parameters for
+`org-list-to-generic'. Return converted list as a string."
(require 'ox-html)
- (org-export-string-as list 'html t))
+ (org-list-to-generic list (org-combine-plists '(:backend html) params)))
-(defun org-list-to-texinfo (list &optional _params)
+(defun org-list-to-texinfo (list &optional params)
"Convert LIST into a Texinfo list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+PARAMS is a property list with overruling parameters for
+`org-list-to-generic'. Return converted list as a string."
(require 'ox-texinfo)
- (org-export-string-as list 'texinfo t))
+ (org-list-to-generic list (org-combine-plists '(:backend texinfo) params)))
(defun org-list-to-subtree (list &optional params)
"Convert LIST into an Org subtree.
-LIST is as returned by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (defvar get-stars) (defvar org--blankp)
- (let* ((rule (cdr (assq 'heading org-blank-before-new-entry)))
+LIST is as returned by `org-list-to-lisp'. PARAMS is a property
+list with overruling parameters for `org-list-to-generic'."
+ (let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry))
+ (`t t)
+ (`auto (save-excursion
+ (org-with-limited-levels (outline-previous-heading))
+ (org-previous-line-empty-p)))))
(level (org-reduced-level (or (org-current-level) 0)))
- (org--blankp (or (eq rule t)
- (and (eq rule 'auto)
- (save-excursion
- (outline-previous-heading)
- (org-previous-line-empty-p)))))
- (get-stars ;FIXME: Can't rename without renaming it in org.el as well!
- (function
- ;; Return the string for the heading, depending on depth D
- ;; of current sub-list.
- (lambda (d)
- (let ((oddeven-level (+ level d 1)))
- (concat (make-string (if org-odd-levels-only
- (1- (* 2 oddeven-level))
- oddeven-level)
- ?*)
- " "))))))
+ (make-stars
+ (lambda (depth)
+ ;; Return the string for the heading, depending on DEPTH
+ ;; of current sub-list.
+ (let ((oddeven-level (+ level depth)))
+ (concat (make-string (if org-odd-levels-only
+ (1- (* 2 oddeven-level))
+ oddeven-level)
+ ?*)
+ " ")))))
(org-list-to-generic
list
(org-combine-plists
- '(:splice t
- :dtstart " " :dtend " "
- :istart (funcall get-stars depth)
- :icount (funcall get-stars depth)
- :isep (if org--blankp "\n\n" "\n")
- :csep (if org--blankp "\n\n" "\n")
- :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
+ (list :splice t
+ :istart make-stars
+ :icount make-stars
+ :dtstart " " :dtend " "
+ :isep (if blank "\n\n" "\n")
+ :cbon "DONE " :cboff "TODO " :cbtrans "TODO ")
params))))
(provide 'org-list)
diff --git a/lisp/org-loaddefs.el b/lisp/org-loaddefs.el
index b61eaa3..5bc5fef 100644
--- a/lisp/org-loaddefs.el
+++ b/lisp/org-loaddefs.el
@@ -2,28 +2,86 @@
;;
;;; Code:
-;;;### (autoloads (org-babel-mark-block org-babel-previous-src-block
-;;;;;; org-babel-next-src-block org-babel-goto-named-result org-babel-goto-named-src-block
-;;;;;; org-babel-goto-src-block-head org-babel-hide-result-toggle-maybe
-;;;;;; org-babel-sha1-hash org-babel-execute-subtree org-babel-execute-buffer
-;;;;;; org-babel-map-executables org-babel-map-call-lines org-babel-map-inline-src-blocks
-;;;;;; org-babel-map-src-blocks org-babel-open-src-block-result
-;;;;;; org-babel-do-in-edit-buffer org-babel-switch-to-session-with-code
-;;;;;; org-babel-switch-to-session org-babel-initiate-session org-babel-load-in-session
-;;;;;; org-babel-insert-header-arg org-babel-check-src-block org-babel-expand-src-block
-;;;;;; org-babel-execute-src-block org-babel-pop-to-session-maybe
-;;;;;; org-babel-load-in-session-maybe org-babel-expand-src-block-maybe
-;;;;;; org-babel-view-src-block-info org-babel-execute-maybe org-babel-execute-safely-maybe)
-;;;;;; "ob-core" "ob-core.el" "ee83b8920bd29f8ac10c08e0b4271f48")
+;;;### (autoloads nil "ob-C" "ob-C.el" (0 0 0 0))
+;;; Generated autoloads from ob-C.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-C" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-J" "ob-J.el" (0 0 0 0))
+;;; Generated autoloads from ob-J.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-J" '("obj-" "org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-R" "ob-R.el" (0 0 0 0))
+;;; Generated autoloads from ob-R.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("ob-R-" "org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-abc" "ob-abc.el" (0 0 0 0))
+;;; Generated autoloads from ob-abc.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-abc" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-asymptote" "ob-asymptote.el" (0 0 0 0))
+;;; Generated autoloads from ob-asymptote.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-asymptote" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-awk" "ob-awk.el" (0 0 0 0))
+;;; Generated autoloads from ob-awk.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-awk" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-calc" "ob-calc.el" (0 0 0 0))
+;;; Generated autoloads from ob-calc.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-calc" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-clojure" "ob-clojure.el" (0 0 0 0))
+;;; Generated autoloads from ob-clojure.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-clojure" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-comint" "ob-comint.el" (0 0 0 0))
+;;; Generated autoloads from ob-comint.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-comint" '("org-babel-comint-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-coq" "ob-coq.el" (0 0 0 0))
+;;; Generated autoloads from ob-coq.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-coq" '("org-babel-" "coq-program-name")))
+
+;;;***
+
+;;;### (autoloads nil "ob-core" "ob-core.el" (0 0 0 0))
;;; Generated autoloads from ob-core.el
(autoload 'org-babel-execute-safely-maybe "ob-core" "\
-Not documented
+
\(fn)" nil nil)
(autoload 'org-babel-execute-maybe "ob-core" "\
-Not documented
+
\(fn)" t nil)
@@ -78,7 +136,7 @@ Expand the current source code block.
Expand according to the source code block's header
arguments and pop open the results in a preview buffer.
-\(fn &optional _ARG INFO PARAMS)" t nil)
+\(fn &optional ARG INFO PARAMS)" t nil)
(autoload 'org-babel-check-src-block "ob-core" "\
Check for misspelled header arguments in the current code block.
@@ -96,7 +154,7 @@ Evaluate the header arguments for the source block before
entering the session. After loading the body this pops open the
session.
-\(fn &optional _ARG INFO)" t nil)
+\(fn &optional ARG INFO)" t nil)
(autoload 'org-babel-initiate-session "ob-core" "\
Initiate session for current code block.
@@ -117,13 +175,13 @@ with a prefix argument then this is passed on to
(autoload 'org-babel-switch-to-session-with-code "ob-core" "\
Switch to code buffer and display session.
-\(fn &optional ARG _INFO)" t nil)
+\(fn &optional ARG INFO)" t nil)
(autoload 'org-babel-do-in-edit-buffer "ob-core" "\
Evaluate BODY in edit buffer if there is a code block at point.
Return t if a code block was found at point, nil otherwise.
-\(fn &rest BODY)" nil (quote macro))
+\(fn &rest BODY)" nil t)
(autoload 'org-babel-open-src-block-result "ob-core" "\
If `point' is on a src block then open the results of the
@@ -155,26 +213,36 @@ body ------------- string holding the body of the code block
beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body
-\(fn FILE &rest BODY)" nil (quote macro))
+\(fn FILE &rest BODY)" nil t)
+
+(function-put 'org-babel-map-src-blocks 'lisp-indent-function '1)
(autoload 'org-babel-map-inline-src-blocks "ob-core" "\
-Evaluate BODY forms on each inline source-block in FILE.
+Evaluate BODY forms on each inline source block in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer.
-\(fn FILE &rest BODY)" nil (quote macro))
+\(fn FILE &rest BODY)" nil t)
+
+(function-put 'org-babel-map-inline-src-blocks 'lisp-indent-function '1)
(autoload 'org-babel-map-call-lines "ob-core" "\
Evaluate BODY forms on each call line in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer.
-\(fn FILE &rest BODY)" nil (quote macro))
+\(fn FILE &rest BODY)" nil t)
+
+(function-put 'org-babel-map-call-lines 'lisp-indent-function '1)
(autoload 'org-babel-map-executables "ob-core" "\
-Not documented
+Evaluate BODY forms on each active Babel code in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer.
+
+\(fn FILE &rest BODY)" nil t)
-\(fn FILE &rest BODY)" nil (quote macro))
+(function-put 'org-babel-map-executables 'lisp-indent-function '1)
(autoload 'org-babel-execute-buffer "ob-core" "\
Execute source code blocks in a buffer.
@@ -232,10 +300,116 @@ Mark current src block.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-core" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-css" "ob-css.el" (0 0 0 0))
+;;; Generated autoloads from ob-css.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-css" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-ditaa" "ob-ditaa.el" (0 0 0 0))
+;;; Generated autoloads from ob-ditaa.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ditaa" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-dot" "ob-dot.el" (0 0 0 0))
+;;; Generated autoloads from ob-dot.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-dot" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-ebnf" "ob-ebnf.el" (0 0 0 0))
+;;; Generated autoloads from ob-ebnf.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ebnf" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-emacs-lisp" "ob-emacs-lisp.el" (0 0 0 0))
+;;; Generated autoloads from ob-emacs-lisp.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-emacs-lisp" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-eval" "ob-eval.el" (0 0 0 0))
+;;; Generated autoloads from ob-eval.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-eval" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-exp" "ob-exp.el" (0 0 0 0))
+;;; Generated autoloads from ob-exp.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-exp" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-forth" "ob-forth.el" (0 0 0 0))
+;;; Generated autoloads from ob-forth.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-forth" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-fortran" "ob-fortran.el" (0 0 0 0))
+;;; Generated autoloads from ob-fortran.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-fortran" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-gnuplot" "ob-gnuplot.el" (0 0 0 0))
+;;; Generated autoloads from ob-gnuplot.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-gnuplot" '("org-babel-" "*org-babel-gnuplot-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-groovy" "ob-groovy.el" (0 0 0 0))
+;;; Generated autoloads from ob-groovy.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-groovy" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-haskell" "ob-haskell.el" (0 0 0 0))
+;;; Generated autoloads from ob-haskell.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-haskell" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-io" "ob-io.el" (0 0 0 0))
+;;; Generated autoloads from ob-io.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-io" '("org-babel-")))
+
;;;***
-;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "ob-keys.el"
-;;;;;; "24762aeb15b93f86ba40d1649d47134a")
+;;;### (autoloads nil "ob-java" "ob-java.el" (0 0 0 0))
+;;; Generated autoloads from ob-java.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-java" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-js" "ob-js.el" (0 0 0 0))
+;;; Generated autoloads from ob-js.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-js" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-keys" "ob-keys.el" (0 0 0 0))
;;; Generated autoloads from ob-keys.el
(autoload 'org-babel-describe-bindings "ob-keys" "\
@@ -243,10 +417,39 @@ Describe all keybindings behind `org-babel-key-prefix'.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-keys" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-latex" "ob-latex.el" (0 0 0 0))
+;;; Generated autoloads from ob-latex.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-ledger" "ob-ledger.el" (0 0 0 0))
+;;; Generated autoloads from ob-ledger.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ledger" '("org-babel-")))
+
;;;***
-;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe)
-;;;;;; "ob-lob" "ob-lob.el" "642d1791b061066c54b8ff95e332f856")
+;;;### (autoloads nil "ob-lilypond" "ob-lilypond.el" (0 0 0 0))
+;;; Generated autoloads from ob-lilypond.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lilypond" '("org-babel-" "lilypond-mode")))
+
+;;;***
+
+;;;### (autoloads nil "ob-lisp" "ob-lisp.el" (0 0 0 0))
+;;; Generated autoloads from ob-lisp.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lisp" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-lob" "ob-lob.el" (0 0 0 0))
;;; Generated autoloads from ob-lob.el
(autoload 'org-babel-lob-execute-maybe "ob-lob" "\
@@ -257,14 +460,193 @@ if so then run the appropriate source block from the Library.
\(fn)" t nil)
(autoload 'org-babel-lob-get-info "ob-lob" "\
-Return a Library of Babel function call as a string.
+Return internal representation for Library of Babel function call.
+Consider DATUM, when provided, or element at point. Return nil
+when not on an appropriate location. Otherwise return a list
+compatible with `org-babel-get-src-block-info', which see.
-\(fn)" nil nil)
+\(fn &optional DATUM)" nil nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lob" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-lua" "ob-lua.el" (0 0 0 0))
+;;; Generated autoloads from ob-lua.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lua" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-makefile" "ob-makefile.el" (0 0 0 0))
+;;; Generated autoloads from ob-makefile.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-makefile" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-maxima" "ob-maxima.el" (0 0 0 0))
+;;; Generated autoloads from ob-maxima.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-maxima" '("org-babel-")))
;;;***
-;;;### (autoloads (org-babel-tangle org-babel-tangle-file) "ob-tangle"
-;;;;;; "ob-tangle.el" "3ba1e4bcd6d4b3c9293130baa1e76017")
+;;;### (autoloads nil "ob-mscgen" "ob-mscgen.el" (0 0 0 0))
+;;; Generated autoloads from ob-mscgen.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-mscgen" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-ocaml" "ob-ocaml.el" (0 0 0 0))
+;;; Generated autoloads from ob-ocaml.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ocaml" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-octave" "ob-octave.el" (0 0 0 0))
+;;; Generated autoloads from ob-octave.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-octave" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-org" "ob-org.el" (0 0 0 0))
+;;; Generated autoloads from ob-org.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-org" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-perl" "ob-perl.el" (0 0 0 0))
+;;; Generated autoloads from ob-perl.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-perl" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-picolisp" "ob-picolisp.el" (0 0 0 0))
+;;; Generated autoloads from ob-picolisp.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-picolisp" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-plantuml" "ob-plantuml.el" (0 0 0 0))
+;;; Generated autoloads from ob-plantuml.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-plantuml" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-processing" "ob-processing.el" (0 0 0 0))
+;;; Generated autoloads from ob-processing.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-processing" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-python" "ob-python.el" (0 0 0 0))
+;;; Generated autoloads from ob-python.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-python" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-ref" "ob-ref.el" (0 0 0 0))
+;;; Generated autoloads from ob-ref.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ref" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-ruby" "ob-ruby.el" (0 0 0 0))
+;;; Generated autoloads from ob-ruby.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ruby" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-sass" "ob-sass.el" (0 0 0 0))
+;;; Generated autoloads from ob-sass.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sass" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-scala" "ob-scala.el" (0 0 0 0))
+;;; Generated autoloads from ob-scala.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scala" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-scheme" "ob-scheme.el" (0 0 0 0))
+;;; Generated autoloads from ob-scheme.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scheme" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-screen" "ob-screen.el" (0 0 0 0))
+;;; Generated autoloads from ob-screen.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-screen" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-sed" "ob-sed.el" (0 0 0 0))
+;;; Generated autoloads from ob-sed.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sed" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-shell" "ob-shell.el" (0 0 0 0))
+;;; Generated autoloads from ob-shell.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shell" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-shen" "ob-shen.el" (0 0 0 0))
+;;; Generated autoloads from ob-shen.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shen" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-sql" "ob-sql.el" (0 0 0 0))
+;;; Generated autoloads from ob-sql.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-sqlite" "ob-sqlite.el" (0 0 0 0))
+;;; Generated autoloads from ob-sqlite.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sqlite" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-stan" "ob-stan.el" (0 0 0 0))
+;;; Generated autoloads from ob-stan.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-stan" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-table" "ob-table.el" (0 0 0 0))
+;;; Generated autoloads from ob-table.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-table" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-tangle" "ob-tangle.el" (0 0 0 0))
;;; Generated autoloads from ob-tangle.el
(autoload 'org-babel-tangle-file "ob-tangle" "\
@@ -290,15 +672,11 @@ used to limit the exported source code blocks by language.
\(fn &optional ARG TARGET-FILE LANG)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-tangle" '("org-babel-")))
+
;;;***
-;;;### (autoloads (org-agenda-to-appt org-calendar-goto-agenda org-agenda-set-restriction-lock
-;;;;;; org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
-;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list
-;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views
-;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda
-;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org-agenda.el"
-;;;;;; (22194 60218))
+;;;### (autoloads nil "org-agenda" "org-agenda.el" (0 0 0 0))
;;; Generated autoloads from org-agenda.el
(autoload 'org-toggle-sticky-agenda "org-agenda" "\
@@ -335,9 +713,9 @@ More commands can be added by configuring the variable
`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
searches can be pre-defined in this way.
-If the current buffer is in Org-mode and visiting a file, you can also
+If the current buffer is in Org mode and visiting a file, you can also
first press `<' once to indicate that the agenda should be temporarily
-\(until the next use of \\[org-agenda]) restricted to the current file.
+\(until the next use of `\\[org-agenda]') restricted to the current file.
Pressing `<' twice means to restrict to the current subtree or region
\(if active).
@@ -351,7 +729,7 @@ longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command.
-\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro))
+\(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-batch-agenda-csv "org-agenda" "\
Run an agenda command in batch mode and send the result to STDOUT.
@@ -388,7 +766,7 @@ priority-l The priority letter if any was given
priority-n The computed numerical priority
agenda-day The day in the agenda where this is listed
-\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro))
+\(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-store-agenda-views "org-agenda" "\
Store agenda views.
@@ -398,7 +776,7 @@ Store agenda views.
(autoload 'org-batch-store-agenda-views "org-agenda" "\
Run all custom agenda commands that have a file argument.
-\(fn &rest PARAMETERS)" nil (quote macro))
+\(fn &rest PARAMETERS)" nil t)
(autoload 'org-agenda-list "org-agenda" "\
Produce a daily/weekly view from all files in variable `org-agenda-files'.
@@ -466,7 +844,7 @@ in `org-agenda-text-search-extra-files'.
(autoload 'org-todo-list "org-agenda" "\
Show all (not done) TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
-the list to these. When using \\[universal-argument], you will be prompted
+the list to these. When using `\\[universal-argument]', you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'.
@@ -529,15 +907,15 @@ in the file. Otherwise, restriction will be to the current subtree.
\(fn &optional TYPE)" t nil)
(autoload 'org-calendar-goto-agenda "org-agenda" "\
-Compute the Org-mode agenda for the calendar date displayed at the cursor.
+Compute the Org agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'.
\(fn)" t nil)
(autoload 'org-agenda-to-appt "org-agenda" "\
Activate appointments found in `org-agenda-files'.
-With a \\[universal-argument] prefix, refresh the list of
-appointments.
+
+With a `\\[universal-argument]' prefix, refresh the list of appointments.
If FILTER is t, interactively prompt the user for a regular
expression, and filter out entries that don't match it.
@@ -569,12 +947,11 @@ to override `appt-message-warning-time'.
\(fn &optional REFRESH FILTER &rest ARGS)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-agenda" '("org-")))
+
;;;***
-;;;### (autoloads (org-archive-subtree-default-with-confirmation
-;;;;;; org-archive-subtree-default org-toggle-archive-tag org-archive-to-archive-sibling
-;;;;;; org-archive-subtree org-add-archive-files) "org-archive"
-;;;;;; "org-archive.el" "49615e9b6aa6314b77b090b118280556")
+;;;### (autoloads nil "org-archive" "org-archive.el" (0 0 0 0))
;;; Generated autoloads from org-archive.el
(autoload 'org-add-archive-files "org-archive" "\
@@ -627,9 +1004,11 @@ This command is set with the variable `org-archive-default-command'.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-archive" '("org-")))
+
;;;***
-;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "1e4c1afefe41ea28817861da7ea71ce6")
+;;;### (autoloads nil "org-attach" "org-attach.el" (0 0 0 0))
;;; Generated autoloads from org-attach.el
(autoload 'org-attach "org-attach" "\
@@ -638,10 +1017,11 @@ Shows a list of commands and prompts for another key to execute a command.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-attach" '("org-attach-")))
+
;;;***
-;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org-bbdb.el"
-;;;;;; "e782f707a5a0d3b8a8fd76825deb4111")
+;;;### (autoloads nil "org-bbdb" "org-bbdb.el" (0 0 0 0))
;;; Generated autoloads from org-bbdb.el
(autoload 'org-bbdb-anniversaries "org-bbdb" "\
@@ -649,11 +1029,23 @@ Extract anniversaries from BBDB for display in the agenda.
\(fn)" nil nil)
+(autoload 'org-bbdb-anniversaries-future "org-bbdb" "\
+Return list of anniversaries for today and the next n-1 days (default n=7).
+
+\(fn &optional N)" nil nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-bbdb" '("org-bbdb-")))
+
+;;;***
+
+;;;### (autoloads nil "org-bibtex" "org-bibtex.el" (0 0 0 0))
+;;; Generated autoloads from org-bibtex.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-bibtex" '("org-")))
+
;;;***
-;;;### (autoloads (org-capture-import-remember-templates org-capture
-;;;;;; org-capture-string) "org-capture" "org-capture.el" (22200
-;;;;;; 12002))
+;;;### (autoloads nil "org-capture" "org-capture.el" (0 0 0 0))
;;; Generated autoloads from org-capture.el
(autoload 'org-capture-string "org-capture" "\
@@ -664,16 +1056,17 @@ Capture STRING with the template selected by KEYS.
(autoload 'org-capture "org-capture" "\
Capture something.
\\<org-capture-mode-map>
-This will let you select a template from `org-capture-templates', and then
-file the newly captured information. The text is immediately inserted
-at the target location, and an indirect buffer is shown where you can
-edit it. Pressing \\[org-capture-finalize] brings you back to the previous state
-of Emacs, so that you can continue your work.
+This will let you select a template from `org-capture-templates', and
+then file the newly captured information. The text is immediately
+inserted at the target location, and an indirect buffer is shown where
+you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the previous
+state of Emacs, so that you can continue your work.
-When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture
-anything, just go to the file/headline where the selected template
-stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note
-stored.
+When called interactively with a `\\[universal-argument]' prefix argument GOTO, don't
+capture anything, just go to the file/headline where the selected
+template stores its notes.
+
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to the last note stored.
When called with a `C-0' (zero) prefix, insert a template at point.
@@ -693,18 +1086,15 @@ Set `org-capture-templates' to be similar to `org-remember-templates'.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-capture" '("org-")))
+
;;;***
-;;;### (autoloads (org-clock-update-time-maybe org-dblock-write:clocktable
-;;;;;; org-clocktable-shift org-clock-report org-clock-get-clocktable
-;;;;;; org-clock-remove-overlays org-clock-display org-clock-sum
-;;;;;; org-clock-goto org-clock-cancel org-clock-out org-clock-in-last
-;;;;;; org-clock-in org-resolve-clocks) "org-clock" "org-clock.el"
-;;;;;; "133b6d837d46606bf3b4f1753035bca8")
+;;;### (autoloads nil "org-clock" "org-clock.el" (0 0 0 0))
;;; Generated autoloads from org-clock.el
(autoload 'org-resolve-clocks "org-clock" "\
-Resolve all currently open org-mode clocks.
+Resolve all currently open Org clocks.
If `only-dangling-p' is non-nil, only ask to resolve dangling
\(i.e., not currently open and valid) clocks.
@@ -712,14 +1102,19 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(autoload 'org-clock-in "org-clock" "\
Start the clock on the current item.
+
If necessary, clock-out of the currently active clock.
-With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked
-tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task
-and mark it as the default task, a special task that will always be offered
-in the clocking selection, associated with the letter `d'.
-When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], clock in by using the last clock-out
-time as the start time (see `org-clock-continuously' to
-make this the default behavior.)
+
+With a `\\[universal-argument]' prefix argument SELECT, offer a list of recently clocked
+tasks to clock into.
+
+When SELECT is `\\[universal-argument] \\[universal-argument]', clock into the current task and mark it as
+the default task, a special task that will always be offered in the
+clocking selection, associated with the letter `d'.
+
+When SELECT is `\\[universal-argument] \\[universal-argument] \\[universal-argument]', clock in by using the last clock-out
+time as the start time. See `org-clock-continuously' to make this
+the default behavior.
\(fn &optional SELECT START-TIME)" t nil)
@@ -770,19 +1165,22 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes.
Show subtree times in the entire buffer.
By default, show the total time for the range defined in
-`org-clock-display-default-range'. With \\[universal-argument] prefix, show
-the total time for today instead. With \\[universal-argument] \\[universal-argument] prefix, use
-a custom range, entered at the prompt. With \\[universal-argument] \\[universal-argument] \\[universal-argument]
-prefix, display the total time in the echo area.
+`org-clock-display-default-range'. With `\\[universal-argument]' prefix, show
+the total time for today instead.
-Use \\[org-clock-remove-overlays] to remove the subtree times.
+With `\\[universal-argument] \\[universal-argument]' prefix, use a custom range, entered at prompt.
+
+With `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, display the total time in the
+echo area.
+
+Use `\\[org-clock-remove-overlays]' to remove the subtree times.
\(fn &optional ARG)" t nil)
(autoload 'org-clock-remove-overlays "org-clock" "\
Remove the occur highlights from the buffer.
-BEG and END are ignored. If NOREMOVE is nil, remove this function
-from the `before-change-functions' in the current buffer.
+If NOREMOVE is nil, remove this function from the
+`before-change-functions' in the current buffer.
\(fn &optional BEG END NOREMOVE)" t nil)
@@ -828,12 +1226,11 @@ Otherwise, return nil.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-clock" '("org-")))
+
;;;***
-;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview
-;;;;;; org-columns-number-to-string org-columns-compute org-columns
-;;;;;; org-columns-get-format-and-top-level org-columns-remove-overlays)
-;;;;;; "org-colview" "org-colview.el" (22176 30266))
+;;;### (autoloads nil "org-colview" "org-colview.el" (0 0 0 0))
;;; Generated autoloads from org-colview.el
(autoload 'org-columns-remove-overlays "org-colview" "\
@@ -842,31 +1239,34 @@ Remove all currently active column overlays.
\(fn)" t nil)
(autoload 'org-columns-get-format-and-top-level "org-colview" "\
-Not documented
+
\(fn)" nil nil)
(autoload 'org-columns "org-colview" "\
-Turn on column view on an org-mode file.
+Turn on column view on an Org mode file.
+
+Column view applies to the whole buffer if point is before the
+first headline. Otherwise, it applies to the first ancestor
+setting \"COLUMNS\" property. If there is none, it defaults to
+the current headline. With a `\\[universal-argument]' prefix argument, turn on column
+view for the whole buffer unconditionally.
+
When COLUMNS-FMT-STRING is non-nil, use it as the column format.
-\(fn &optional COLUMNS-FMT-STRING)" t nil)
+\(fn &optional GLOBAL COLUMNS-FMT-STRING)" t nil)
(autoload 'org-columns-compute "org-colview" "\
-Sum the values of property PROPERTY hierarchically, for the entire buffer.
+Summarize the values of PROPERTY hierarchically.
+Also update existing values for PROPERTY according to the first
+column specification.
\(fn PROPERTY)" t nil)
-(autoload 'org-columns-number-to-string "org-colview" "\
-Convert a computed column number to a string value, according to FMT.
-
-\(fn N FMT &optional PRINTF)" nil nil)
-
(autoload 'org-dblock-write:columnview "org-colview" "\
Write the column view table.
PARAMS is a property list of parameters:
-:width enforce same column widths with <N> specifiers.
:id the :ID: property of the entry where the columns view
should be built. When the symbol `local', call locally.
When `global' call column view with the cursor at the beginning
@@ -876,15 +1276,17 @@ PARAMS is a property list of parameters:
using `org-id-find'.
:hlines When t, insert a hline before each item. When a number, insert
a hline before each level <= that number.
+:indent When non-nil, indent each ITEM field according to its level.
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty.
+:width apply widths specified in columns format using <N> specifiers.
:format When non-nil, specify the column view format to use.
\(fn PARAMS)" nil nil)
-(autoload 'org-insert-columns-dblock "org-colview" "\
+(autoload 'org-columns-insert-dblock "org-colview" "\
Create a dynamic block capturing a column view table.
\(fn)" t nil)
@@ -894,36 +1296,69 @@ Turn on or update column view in the agenda.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-colview" '("org-")))
+
;;;***
-;;;### (autoloads (org-check-version) "org-compat" "org-compat.el"
-;;;;;; (22193 39354))
+;;;### (autoloads nil "org-compat" "org-compat.el" (0 0 0 0))
;;; Generated autoloads from org-compat.el
(autoload 'org-check-version "org-compat" "\
Try very hard to provide sensible version strings.
-\(fn)" nil (quote macro))
+\(fn)" nil t)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-compat" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "org-crypt" "org-crypt.el" (0 0 0 0))
+;;; Generated autoloads from org-crypt.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-crypt" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "org-ctags" "org-ctags.el" (0 0 0 0))
+;;; Generated autoloads from org-ctags.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-")))
;;;***
-;;;### (autoloads (org-datetree-find-date-create) "org-datetree"
-;;;;;; "org-datetree.el" "b568067e20b64b5dcfc50d0fe986fb9f")
+;;;### (autoloads nil "org-datetree" "org-datetree.el" (0 0 0 0))
;;; Generated autoloads from org-datetree.el
(autoload 'org-datetree-find-date-create "org-datetree" "\
-Find or create an entry for DATE.
+Find or create an entry for date D.
If KEEP-RESTRICTION is non-nil, do not widen the buffer.
When it is nil, the buffer will be widened to make sure an existing date
tree can be found.
-\(fn DATE &optional KEEP-RESTRICTION)" nil nil)
+\(fn D &optional KEEP-RESTRICTION)" nil nil)
+
+(autoload 'org-datetree-find-iso-week-create "org-datetree" "\
+Find or create an ISO week entry for date D.
+Compared to `org-datetree-find-date-create' this function creates
+entries ordered by week instead of months.
+If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it
+is nil, the buffer will be widened to make sure an existing date
+tree can be found.
+
+\(fn D &optional KEEP-RESTRICTION)" nil nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-datetree" '("org-datetree-")))
+
+;;;***
+
+;;;### (autoloads nil "org-docview" "org-docview.el" (0 0 0 0))
+;;; Generated autoloads from org-docview.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-docview" '("org-docview-")))
;;;***
-;;;### (autoloads (org-element-context org-element-at-point org-element-cache-refresh
-;;;;;; org-element-cache-reset org-element-interpret-data org-element-update-syntax)
-;;;;;; "org-element" "org-element.el" "54a3a77d31b0c99c7ce9827c94b05491")
+;;;### (autoloads nil "org-element" "org-element.el" (0 0 0 0))
;;; Generated autoloads from org-element.el
(autoload 'org-element-update-syntax "org-element" "\
@@ -993,10 +1428,39 @@ Providing it allows for quicker computation.
\(fn &optional ELEMENT)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-element" '("org-element-")))
+
+;;;***
+
+;;;### (autoloads nil "org-entities" "org-entities.el" (0 0 0 0))
+;;; Generated autoloads from org-entities.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("org-entit")))
+
+;;;***
+
+;;;### (autoloads nil "org-eshell" "org-eshell.el" (0 0 0 0))
+;;; Generated autoloads from org-eshell.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eshell" '("org-eshell-")))
+
+;;;***
+
+;;;### (autoloads nil "org-eww" "org-eww.el" (0 0 0 0))
+;;; Generated autoloads from org-eww.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eww" '("org-eww-")))
+
;;;***
-;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update
-;;;;;; org-feed-update-all) "org-feed" "org-feed.el" "d0f9ed4388a963a1ef1623799a68a0f0")
+;;;### (autoloads nil "org-faces" "org-faces.el" (0 0 0 0))
+;;; Generated autoloads from org-faces.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-faces" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "org-feed" "org-feed.el" (0 0 0 0))
;;; Generated autoloads from org-feed.el
(autoload 'org-feed-update-all "org-feed" "\
@@ -1021,10 +1485,11 @@ Show the raw feed buffer of a feed.
\(fn FEED)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-feed" '("org-feed-")))
+
;;;***
-;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote"
-;;;;;; "org-footnote.el" "9ceecddca334b14eed8100670d00bb8f")
+;;;### (autoloads nil "org-footnote" "org-footnote.el" (0 0 0 0))
;;; Generated autoloads from org-footnote.el
(autoload 'org-footnote-action "org-footnote" "\
@@ -1043,23 +1508,25 @@ offer additional commands in a menu.
\(fn &optional SPECIAL)" t nil)
-(autoload 'org-footnote-normalize "org-footnote" "\
-Collect the footnotes in various formats and normalize them.
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-footnote" '("org-footnote-")))
+
+;;;***
+
+;;;### (autoloads nil "org-gnus" "org-gnus.el" (0 0 0 0))
+;;; Generated autoloads from org-gnus.el
-This finds the different sorts of footnotes allowed in Org, and
-normalizes them to the usual [N] format.
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-gnus" '("org-")))
-When SORT-ONLY is set, only sort the footnote definitions into the
-referenced sequence.
+;;;***
+
+;;;### (autoloads nil "org-habit" "org-habit.el" (0 0 0 0))
+;;; Generated autoloads from org-habit.el
-\(fn &optional SORT-ONLY)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-habit" '("org-")))
;;;***
-;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-update-id-locations
-;;;;;; org-id-new org-id-find org-id-goto org-id-get-with-outline-drilling
-;;;;;; org-id-get-with-outline-path-completion org-id-get org-id-copy
-;;;;;; org-id-get-create) "org-id" "org-id.el" "aa9a9a641f5d77fb14a6ac89b1831168")
+;;;### (autoloads nil "org-id" "org-id.el" (0 0 0 0))
;;; Generated autoloads from org-id.el
(autoload 'org-id-get-create "org-id" "\
@@ -1099,7 +1566,7 @@ Use an outline-cycling interface to retrieve the ID of an entry.
This only finds entries in the current buffer, using `org-get-location'.
It returns the ID of the entry. If necessary, the ID is created.
-\(fn &optional TARGETS)" nil nil)
+\(fn)" nil nil)
(autoload 'org-id-goto "org-id" "\
Switch to the buffer containing the entry with id ID.
@@ -1136,7 +1603,6 @@ Store the relation between files and corresponding IDs.
This will scan all agenda files, all associated archives, and all
files currently mentioned in `org-id-locations'.
When FILES is given, scan these files instead.
-When CHECK is given, prepare detailed information about duplicate IDs.
\(fn &optional FILES SILENT)" t nil)
@@ -1150,10 +1616,11 @@ Store a link to the current entry, using its ID.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-id" '("org-id-")))
+
;;;***
-;;;### (autoloads (org-indent-mode) "org-indent" "org-indent.el"
-;;;;;; "da988e2c3b7826ad167376bcfd481df9")
+;;;### (autoloads nil "org-indent" "org-indent.el" (0 0 0 0))
;;; Generated autoloads from org-indent.el
(autoload 'org-indent-mode "org-indent" "\
@@ -1168,9 +1635,26 @@ during idle time.
\(fn &optional ARG)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-indent" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "org-info" "org-info.el" (0 0 0 0))
+;;; Generated autoloads from org-info.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-info" '("org-info-")))
+
+;;;***
+
+;;;### (autoloads nil "org-inlinetask" "org-inlinetask.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from org-inlinetask.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-inlinetask" '("org-inlinetask-")))
+
;;;***
-;;;### (autoloads (org-irc-store-link) "org-irc" "org-irc.el" "844cf138fe188afd472820c355b395ae")
+;;;### (autoloads nil "org-irc" "org-irc.el" (0 0 0 0))
;;; Generated autoloads from org-irc.el
(autoload 'org-irc-store-link "org-irc" "\
@@ -1178,37 +1662,62 @@ Dispatch to the appropriate function to store a link to an IRC session.
\(fn)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-irc" '("org-irc-")))
+
;;;***
-;;;### (autoloads (org-lint) "org-lint" "org-lint.el" (22106 38585))
+;;;### (autoloads nil "org-lint" "org-lint.el" (0 0 0 0))
;;; Generated autoloads from org-lint.el
(autoload 'org-lint "org-lint" "\
Check current Org buffer for syntax mistakes.
-By default, run all checkers. With a single prefix ARG \\[universal-argument],
-select one category of checkers only. With a double prefix
-\\[universal-argument] \\[universal-argument], select one precise checker by its name.
+By default, run all checkers. With a `\\[universal-argument]' prefix ARG, select one
+category of checkers only. With a `\\[universal-argument] \\[universal-argument]' prefix, run one precise
+checker by its name.
ARG can also be a list of checker names, as symbols, to run.
\(fn &optional ARG)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-lint" '("org-lint-")))
+
+;;;***
+
+;;;### (autoloads nil "org-list" "org-list.el" (0 0 0 0))
+;;; Generated autoloads from org-list.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-list" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "org-macro" "org-macro.el" (0 0 0 0))
+;;; Generated autoloads from org-macro.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macro" '("org-macro-")))
+
;;;***
-;;;### (autoloads (org-load-noerror-mustsuffix) "org-macs" "org-macs.el"
-;;;;;; (22161 62906))
+;;;### (autoloads nil "org-macs" "org-macs.el" (0 0 0 0))
;;; Generated autoloads from org-macs.el
(autoload 'org-load-noerror-mustsuffix "org-macs" "\
-Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it.
+Load FILE with optional arguments NOERROR and MUSTSUFFIX.
+
+\(fn FILE)" nil t)
-\(fn FILE)" nil (quote macro))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macs" '("org-")))
;;;***
-;;;### (autoloads (org-mobile-pull org-mobile-push) "org-mobile"
-;;;;;; "org-mobile.el" "6fe291f3ef3fff1fbde9b1ec117c2d2a")
+;;;### (autoloads nil "org-mhe" "org-mhe.el" (0 0 0 0))
+;;; Generated autoloads from org-mhe.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mhe" '("org-mhe-")))
+
+;;;***
+
+;;;### (autoloads nil "org-mobile" "org-mobile.el" (0 0 0 0))
;;; Generated autoloads from org-mobile.el
(autoload 'org-mobile-push "org-mobile" "\
@@ -1225,9 +1734,25 @@ agenda view showing the flagged items.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mobile" '("org-mobile-")))
+
+;;;***
+
+;;;### (autoloads nil "org-mouse" "org-mouse.el" (0 0 0 0))
+;;; Generated autoloads from org-mouse.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mouse" '("org-mouse-")))
+
+;;;***
+
+;;;### (autoloads nil "org-pcomplete" "org-pcomplete.el" (0 0 0 0))
+;;; Generated autoloads from org-pcomplete.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-pcomplete" '("org-" "pcomplete/org-mode/")))
+
;;;***
-;;;### (autoloads (org-plot/gnuplot) "org-plot" "org-plot.el" "e480cdf4e7d3e91e180354e60f40dd55")
+;;;### (autoloads nil "org-plot" "org-plot.el" (0 0 0 0))
;;; Generated autoloads from org-plot.el
(autoload 'org-plot/gnuplot "org-plot" "\
@@ -1237,35 +1762,37 @@ line directly before or after the table.
\(fn &optional PARAMS)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-plot" '("org-plot")))
+
+;;;***
+
+;;;### (autoloads nil "org-protocol" "org-protocol.el" (0 0 0 0))
+;;; Generated autoloads from org-protocol.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-protocol" '("org-protocol-")))
+
;;;***
-;;;### (autoloads (orgtbl-ascii-plot orgtbl-to-orgtbl orgtbl-to-texinfo
-;;;;;; orgtbl-to-html orgtbl-to-latex orgtbl-to-csv orgtbl-to-tsv
-;;;;;; orgtbl-to-generic org-table-to-lisp orgtbl-mode org-table-toggle-formula-debugger
-;;;;;; org-table-toggle-coordinate-overlays org-table-edit-formulas
-;;;;;; org-table-iterate-buffer-tables org-table-recalculate-buffer-tables
-;;;;;; org-table-iterate org-table-recalculate org-table-eval-formula
-;;;;;; org-table-maybe-recalculate-line org-table-analyze org-table-rotate-recalc-marks
-;;;;;; org-table-maybe-eval-formula org-table-get-stored-formulas
-;;;;;; org-table-sum org-table-edit-field org-table-wrap-region
-;;;;;; org-table-convert org-table-paste-rectangle org-table-copy-region
-;;;;;; org-table-cut-region org-table-sort-lines org-table-kill-row
-;;;;;; org-table-hline-and-move org-table-insert-hline org-table-insert-row
-;;;;;; org-table-move-row org-table-move-row-up org-table-move-row-down
-;;;;;; org-table-move-column org-table-move-column-left org-table-move-column-right
-;;;;;; org-table-delete-column org-table-insert-column org-table-goto-column
-;;;;;; org-table-current-dline org-table-field-info org-table-blank-field
-;;;;;; org-table-copy-down org-table-next-row org-table-previous-field
-;;;;;; org-table-next-field org-table-justify-field-maybe org-table-end
-;;;;;; org-table-begin org-table-align org-table-export org-table-import
-;;;;;; org-table-convert-region org-table-create org-table-create-or-convert-from-region
-;;;;;; org-table-create-with-table\.el) "org-table" "org-table.el"
-;;;;;; "e9359ea5b998c77257caa9b21313bf8a")
+;;;### (autoloads nil "org-rmail" "org-rmail.el" (0 0 0 0))
+;;; Generated autoloads from org-rmail.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-rmail" '("org-rmail-")))
+
+;;;***
+
+;;;### (autoloads nil "org-src" "org-src.el" (0 0 0 0))
+;;; Generated autoloads from org-src.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-src" '("org-")))
+
+;;;***
+
+;;;### (autoloads nil "org-table" "org-table.el" (0 0 0 0))
;;; Generated autoloads from org-table.el
(autoload 'org-table-create-with-table\.el "org-table" "\
Use the table.el package to insert a new table.
-If there is already a table at point, convert between Org-mode tables
+If there is already a table at point, convert between Org tables
and table.el tables.
\(fn)" t nil)
@@ -1540,13 +2067,13 @@ lines.
(autoload 'org-table-convert "org-table" "\
Convert from `org-mode' table to table.el and back.
-Obviously, this only works within limits. When an Org-mode table is
-converted to table.el, all horizontal separator lines get lost, because
-table.el uses these as cell boundaries and has no notion of horizontal lines.
-A table.el table can be converted to an Org-mode table only if it does not
-do row or column spanning. Multiline cells will become multiple cells.
-Beware, Org-mode does not test if the table can be successfully converted - it
-blindly applies a recipe that works for simple tables.
+Obviously, this only works within limits. When an Org table is converted
+to table.el, all horizontal separator lines get lost, because table.el uses
+these as cell boundaries and has no notion of horizontal lines. A table.el
+table can be converted to an Org table only if it does not do row or column
+spanning. Multiline cells will become multiple cells. Beware, Org mode
+does not test if the table can be successfully converted - it blindly
+applies a recipe that works for simple tables.
\(fn)" t nil)
@@ -1577,9 +2104,9 @@ blank, and the content is appended to the field above.
(autoload 'org-table-edit-field "org-table" "\
Edit table field in a different window.
-This is mainly useful for fields that contain hidden parts.
-When called with a \\[universal-argument] prefix, just make the full field visible so that
-it can be edited in place.
+This is mainly useful for fields that contain hidden parts. When called
+with a `\\[universal-argument]' prefix, just make the full field visible so that it can be
+edited in place.
\(fn ARG)" t nil)
@@ -1651,20 +2178,14 @@ Recompute the current line if marked for it, and if we haven't just done it.
(autoload 'org-table-eval-formula "org-table" "\
Replace the table field value at the cursor by the result of a calculation.
-This function makes use of Dave Gillespie's Calc package, in my view the
-most exciting program ever written for GNU Emacs. So you need to have Calc
-installed in order to use this function.
-
In a table, this command replaces the value in the current field with the
result of a formula. It also installs the formula as the \"current\" column
formula, by storing it in a special line below the table. When called
-with a `C-u' prefix, the current field must be a named field, and the
-formula is installed as valid in only this specific field.
+with a `\\[universal-argument]' prefix the formula is installed as a field formula.
-When called with two `C-u' prefixes, insert the active equation
-for the field back into the current field, so that it can be
-edited there. This is useful in order to use \\[org-table-show-reference]
-to check the referenced fields.
+When called with a `\\[universal-argument] \\[universal-argument]' prefix, insert the active equation for the field
+back into the current field, so that it can be edited there. This is useful
+in order to use \\<org-table-fedit-map>`\\[org-table-show-reference]' to check the referenced fields.
When called, the command first prompts for a formula, which is read in
the minibuffer. Previously entered formulas are available through the
@@ -1673,7 +2194,7 @@ These stored formulas are adapted correctly when moving, inserting, or
deleting columns with the corresponding commands.
The formula can be any algebraic expression understood by the Calc package.
-For details, see the Org-mode manual.
+For details, see the Org mode manual.
This function can also be called from Lisp programs and offers
additional arguments: EQUATION can be the formula to apply. If this
@@ -1683,15 +2204,19 @@ SUPPRESS-CONST suppresses the interpretation of constants in the
formula, assuming that this has been done already outside the function.
SUPPRESS-STORE means the formula should not be stored, either because
it is already stored, or because it is a modified equation that should
-not overwrite the stored one.
+not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to
+`org-table-analyze'.
\(fn &optional ARG EQUATION SUPPRESS-ALIGN SUPPRESS-CONST SUPPRESS-STORE SUPPRESS-ANALYSIS)" t nil)
(autoload 'org-table-recalculate "org-table" "\
Recalculate the current table line by applying all stored formulas.
+
With prefix arg ALL, do this for all lines in the table.
-With the prefix argument ALL is `(16)' (a double \\[universal-prefix] \\[universal-prefix] prefix), or if
-it is the symbol `iterate', recompute the table until it no longer changes.
+
+When called with a `\\[universal-argument] \\[universal-argument]' prefix, or if ALL is the symbol `iterate',
+recompute the table until it no longer changes.
+
If NOALIGN is not nil, do not re-align the table after the computations
are done. This is typically used internally to save time, if it is
known that the table will be realigned a little later anyway.
@@ -1928,19 +2453,22 @@ be set to provide ORGTBL directives for the generated table.
\(fn TABLE PARAMS)" nil nil)
(autoload 'orgtbl-ascii-plot "org-table" "\
-Draw an ascii bar plot in a column.
-With cursor in a column containing numerical values, this
-function will draw a plot in a new column.
+Draw an ASCII bar plot in a column.
+
+With cursor in a column containing numerical values, this function
+will draw a plot in a new column.
+
ASK, if given, is a numeric prefix to override the default 12
-characters width of the plot. ASK may also be the
-\\[universal-argument] prefix, which will prompt for the width.
+characters width of the plot. ASK may also be the `\\[universal-argument]' prefix,
+which will prompt for the width.
\(fn &optional ASK)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org")))
+
;;;***
-;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region
-;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "96624173cc52bc1945ce7cb5940a7d2b")
+;;;### (autoloads nil "org-timer" "org-timer.el" (0 0 0 0))
;;; Generated autoloads from org-timer.el
(autoload 'org-timer-start "org-timer" "\
@@ -1958,16 +2486,18 @@ the region 0:00:00.
(autoload 'org-timer "org-timer" "\
Insert a H:MM:SS string from the timer into the buffer.
-The first time this command is used, the timer is started. When used with
-a \\[universal-argument] prefix, force restarting the timer.
-When used with a double prefix argument \\[universal-argument], change all the timer string
-in the region by a fixed amount. This can be used to recalibrate a timer
-that was not started at the correct moment.
+The first time this command is used, the timer is started.
-If NO-INSERT-P is non-nil, return the string instead of inserting
+When used with a `\\[universal-argument]' prefix, force restarting the timer.
+
+When used with a `\\[universal-argument] \\[universal-argument]' prefix, change all the timer strings
+in the region by a fixed amount. This can be used to re-calibrate
+a timer that was not started at the correct moment.
+
+If NO-INSERT is non-nil, return the string instead of inserting
it in the buffer.
-\(fn &optional RESTART NO-INSERT-P)" t nil)
+\(fn &optional RESTART NO-INSERT)" t nil)
(autoload 'org-timer-change-times-in-region "org-timer" "\
Change all h:mm:ss time in region by a DELTA.
@@ -2002,21 +2532,22 @@ using three `C-u' prefix arguments.
\(fn &optional OPT)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-timer" '("org-timer-")))
+
;;;***
-;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el"
-;;;;;; (22219 35318))
+;;;### (autoloads nil "org-version" "org-version.el" (0 0 0 0))
;;; Generated autoloads from org-version.el
(autoload 'org-release "org-version" "\
-The release version of org-mode.
- Inserted by installing org-mode or when a release is made.
+The release version of Org.
+Inserted by installing Org mode or when a release is made.
\(fn)" nil nil)
(autoload 'org-git-version "org-version" "\
The Git version of org-mode.
- Inserted by installing org-mode or when a release is made.
+Inserted by installing Org or when a release is made.
\(fn)" nil nil)
@@ -2025,13 +2556,14 @@ The location of ODT styles.")
;;;***
-;;;### (autoloads (org-customize org-reload org-submit-bug-report
-;;;;;; org-cycle-agenda-files org-switchb org-open-link-from-string
-;;;;;; org-open-at-point-global org-insert-link-global org-store-link
-;;;;;; org-run-like-in-org-mode turn-on-orgstruct++ turn-on-orgstruct
-;;;;;; orgstruct-mode org-global-cycle org-cycle org-mode org-clock-persistence-insinuate
-;;;;;; turn-on-orgtbl org-version org-babel-load-file org-babel-do-load-languages)
-;;;;;; "org" "org.el" (22219 35205))
+;;;### (autoloads nil "org-w3m" "org-w3m.el" (0 0 0 0))
+;;; Generated autoloads from org-w3m.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-w3m" '("org-w3m-")))
+
+;;;***
+
+;;;### (autoloads nil "org" "org.el" (0 0 0 0))
;;; Generated autoloads from org.el
(autoload 'org-babel-do-load-languages "org" "\
@@ -2040,7 +2572,7 @@ Load the languages defined in `org-babel-load-languages'.
\(fn SYM VALUE)" nil nil)
(autoload 'org-babel-load-file "org" "\
-Load Emacs Lisp source code blocks in the Org-mode FILE.
+Load Emacs Lisp source code blocks in the Org FILE.
This function exports the source code using `org-babel-tangle'
and then loads the resulting file using `load-file'. With prefix
arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
@@ -2049,7 +2581,7 @@ file to byte-code before it is loaded.
\(fn FILE &optional COMPILE)" t nil)
(autoload 'org-version "org" "\
-Show the org-mode version.
+Show the Org version.
Interactively, or when MESSAGE is non-nil, show it in echo area.
With prefix argument, or when HERE is non-nil, insert it at point.
In non-interactive uses, a reduced version string is output unless
@@ -2071,15 +2603,15 @@ Set up hooks for clock persistence.
Outline-based notes management and organizer, alias
\"Carsten's outline-mode for keeping track of everything.\"
-Org-mode develops organizational tasks around a NOTES file which
-contains information about projects as plain text. Org-mode is
-implemented on top of outline-mode, which is ideal to keep the content
+Org mode develops organizational tasks around a NOTES file which
+contains information about projects as plain text. Org mode is
+implemented on top of Outline mode, which is ideal to keep the content
of large files well structured. It supports ToDo items, deadlines and
time stamps, which magically appear in the diary listing of the Emacs
calendar. Tables are easily created with a built-in table editor.
Plain text URL-like links connect to websites, emails (VM), Usenet
messages (Gnus), BBDB entries, and any files related to the project.
-For printing and sharing of notes, an Org-mode file (or a part of it)
+For printing and sharing of notes, an Org file (or a part of it)
can be exported as a structured ASCII or HTML file.
The following commands are available:
@@ -2089,57 +2621,60 @@ The following commands are available:
\(fn)" t nil)
(autoload 'org-cycle "org" "\
-TAB-action and visibility cycling for Org-mode.
+TAB-action and visibility cycling for Org mode.
-This is the command invoked in Org-mode by the TAB key. Its main purpose
-is outline visibility cycling, but it also invokes other actions
+This is the command invoked in Org mode by the `TAB' key. Its main
+purpose is outline visibility cycling, but it also invokes other actions
in special contexts.
-- When this function is called with a prefix argument, rotate the entire
- buffer through 3 states (global cycling)
+When this function is called with a `\\[universal-argument]' prefix, rotate the entire
+buffer through 3 states (global cycling)
1. OVERVIEW: Show only top-level headlines.
2. CONTENTS: Show all headlines of all levels, but no body text.
3. SHOW ALL: Show everything.
- With a double \\[universal-argument] prefix argument, switch to the startup visibility,
- determined by the variable `org-startup-folded', and by any VISIBILITY
- properties in the buffer.
- With a triple \\[universal-argument] prefix argument, show the entire buffer, including any drawers.
-- When inside a table, re-align the table and move to the next field.
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, switch to the startup visibility,
+determined by the variable `org-startup-folded', and by any VISIBILITY
+properties in the buffer.
+
+With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix argument, show the entire buffer, including
+any drawers.
+
+When inside a table, re-align the table and move to the next field.
-- When point is at the beginning of a headline, rotate the subtree started
- by this line through 3 different states (local cycling)
+When point is at the beginning of a headline, rotate the subtree started
+by this line through 3 different states (local cycling)
1. FOLDED: Only the main headline is shown.
2. CHILDREN: The main headline and the direct children are shown.
From this state, you can move to one of the children
and zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
- If there is no subtree, switch directly from CHILDREN to FOLDED.
+If there is no subtree, switch directly from CHILDREN to FOLDED.
-- When point is at the beginning of an empty headline and the variable
- `org-cycle-level-after-item/entry-creation' is set, cycle the level
- of the headline by demoting and promoting it to likely levels. This
- speeds up creation document structure by pressing TAB once or several
- times right after creating a new headline.
+When point is at the beginning of an empty headline and the variable
+`org-cycle-level-after-item/entry-creation' is set, cycle the level
+of the headline by demoting and promoting it to likely levels. This
+speeds up creation document structure by pressing `TAB' once or several
+times right after creating a new headline.
-- When there is a numeric prefix, go up to a heading with level ARG, do
- a `show-subtree' and return to the previous cursor position. If ARG
- is negative, go up that many levels.
+When there is a numeric prefix, go up to a heading with level ARG, do
+a `show-subtree' and return to the previous cursor position. If ARG
+is negative, go up that many levels.
-- When point is not at the beginning of a headline, execute the global
- binding for TAB, which is re-indenting the line. See the option
- `org-cycle-emulate-tab' for details.
+When point is not at the beginning of a headline, execute the global
+binding for `TAB', which is re-indenting the line. See the option
+`org-cycle-emulate-tab' for details.
-- Special case: if point is at the beginning of the buffer and there is
- no headline in line 1, this function will act as if called with prefix arg
- (\\[universal-argument] TAB, same as S-TAB) also when called without prefix arg.
- But only if also the variable `org-cycle-global-at-bob' is t.
+As a special case, if point is at the beginning of the buffer and there is
+no headline in line 1, this function will act as if called with prefix arg
+\(`\\[universal-argument] TAB', same as `S-TAB') also when called without prefix arg, but only
+if the variable `org-cycle-global-at-bob' is t.
\(fn &optional ARG)" t nil)
(autoload 'org-global-cycle "org" "\
Cycle the global visibility. For details see `org-cycle'.
-With \\[universal-argument] prefix arg, switch to startup visibility.
+With `\\[universal-argument]' prefix ARG, switch to startup visibility.
With a numeric prefix, show all headlines up to that level.
\(fn &optional ARG)" t nil)
@@ -2147,10 +2682,10 @@ With a numeric prefix, show all headlines up to that level.
(autoload 'orgstruct-mode "org" "\
Toggle the minor mode `orgstruct-mode'.
-This mode is for using Org-mode structure commands in other
-modes. The following keys behave as if Org-mode were active, if
+This mode is for using Org mode structure commands in other
+modes. The following keys behave as if Org mode were active, if
the cursor is on a headline, or on a plain list item (both as
-defined by Org-mode).
+defined by Org mode).
\(fn &optional ARG)" t nil)
@@ -2165,61 +2700,59 @@ Unconditionally turn on `orgstruct++-mode'.
\(fn)" nil nil)
(autoload 'org-run-like-in-org-mode "org" "\
-Run a command, pretending that the current buffer is in Org-mode.
+Run a command, pretending that the current buffer is in Org mode.
This will temporarily bind local variables that are typically bound in
-Org-mode to the values they have in Org-mode, and then interactively
+Org mode to the values they have in Org mode, and then interactively
call CMD.
\(fn CMD)" nil nil)
(autoload 'org-store-link "org" "\
-\\<org-mode-map>Store an org-link to the current location.
+Store an org-link to the current location.
+\\<org-mode-map>
This link is added to `org-stored-links' and can later be inserted
-into an Org buffer with \\[org-insert-link].
+into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
-For some link types, a prefix ARG is interpreted.
+For some link types, a `\\[universal-argument]' prefix ARG is interpreted.
For links to Usenet articles, ARG negates `org-gnus-prefer-web-links'.
For file links, ARG negates `org-context-in-file-links'.
-A double prefix ARG force skipping storing functions that are not
-part of Org's core.
+A `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping storing functions that are not
+part of Org core.
-A triple prefix ARG force storing a link for each line in the
+A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix ARG forces storing a link for each line in the
active region.
\(fn ARG)" t nil)
(autoload 'org-insert-link-global "org" "\
-Insert a link like Org-mode does.
-This command can be called in any mode to insert a link in Org-mode syntax.
+Insert a link like Org mode does.
+This command can be called in any mode to insert a link in Org syntax.
\(fn)" t nil)
(autoload 'org-open-at-point-global "org" "\
-Follow a link like Org-mode does.
-This command can be called in any mode to follow a link that has
-Org-mode syntax.
+Follow a link or time-stamp like Org mode does.
+This command can be called in any mode to follow an external link
+or a time-stamp that has Org mode syntax. Its behavior is
+undefined when called on internal links (e.g., fuzzy links).
+Raise an error when there is nothing to follow.
\(fn)" t nil)
(autoload 'org-open-link-from-string "org" "\
-Open a link in the string S, as if it was in Org-mode.
+Open a link in the string S, as if it was in Org mode.
\(fn S &optional ARG REFERENCE-BUFFER)" t nil)
(autoload 'org-switchb "org" "\
Switch between Org buffers.
-With one prefix argument, restrict available buffers to files.
-With two prefix arguments, restrict available buffers to agenda files.
-Defaults to `iswitchb' for buffer name completion.
-Set `org-completion-use-ido' to make it use ido instead.
+With `\\[universal-argument]' prefix, restrict available buffers to files.
-\(fn &optional ARG)" t nil)
-
-(defalias 'org-ido-switchb 'org-switchb)
+With `\\[universal-argument] \\[universal-argument]' prefix, restrict available buffers to agenda files.
-(defalias 'org-iswitchb 'org-switchb)
+\(fn &optional ARG)" t nil)
(autoload 'org-cycle-agenda-files "org" "\
Cycle through the files in `org-agenda-files'.
@@ -2229,13 +2762,13 @@ If the current buffer does not, find the first agenda file.
\(fn)" t nil)
(autoload 'org-submit-bug-report "org" "\
-Submit a bug report on Org-mode via mail.
+Submit a bug report on Org via mail.
Don't hesitate to report any problems or inaccurate documentation.
If you don't have setup sending mail from (X)Emacs, please copy the
output buffer into your mail program, as it gives us important
-information about your Org-mode version and configuration.
+information about your Org version and configuration.
\(fn)" t nil)
@@ -2250,11 +2783,11 @@ Call the customize function with org as argument.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org" '("org" "turn-on-org-cdlatex")))
+
;;;***
-;;;### (autoloads (org-ascii-publish-to-utf8 org-ascii-publish-to-latin1
-;;;;;; org-ascii-publish-to-ascii org-ascii-export-to-ascii org-ascii-export-as-ascii)
-;;;;;; "ox-ascii" "ox-ascii.el" "8b996711b8e315a0dd406d54c0854eaa")
+;;;### (autoloads nil "ox-ascii" "ox-ascii.el" (0 0 0 0))
;;; Generated autoloads from ox-ascii.el
(autoload 'org-ascii-export-as-ascii "ox-ascii" "\
@@ -2352,12 +2885,11 @@ Return output file name.
\(fn PLIST FILENAME PUB-DIR)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-ascii" '("org-ascii-")))
+
;;;***
-;;;### (autoloads (org-beamer-publish-to-pdf org-beamer-publish-to-latex
-;;;;;; org-beamer-select-environment org-beamer-export-to-pdf org-beamer-export-to-latex
-;;;;;; org-beamer-export-as-latex org-beamer-mode) "ox-beamer" "ox-beamer.el"
-;;;;;; "794938d6b0ee97f126e6c5d6330eeaff")
+;;;### (autoloads nil "ox-beamer" "ox-beamer.el" (0 0 0 0))
;;; Generated autoloads from ox-beamer.el
(autoload 'org-beamer-mode "ox-beamer" "\
@@ -2490,11 +3022,11 @@ Return output file name.
\(fn PLIST FILENAME PUB-DIR)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-beamer" '("org-beamer-")))
+
;;;***
-;;;### (autoloads (org-html-publish-to-html org-html-export-to-html
-;;;;;; org-html-convert-region-to-html org-html-export-as-html org-html-htmlize-generate-css)
-;;;;;; "ox-html" "ox-html.el" "8a71c624b1d1c388ab0adfe0baf74040")
+;;;### (autoloads nil "ox-html" "ox-html.el" (0 0 0 0))
;;; Generated autoloads from ox-html.el
(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
@@ -2550,10 +3082,10 @@ is non-nil.
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
(autoload 'org-html-convert-region-to-html "ox-html" "\
-Assume the current region has org-mode syntax, and convert it to HTML.
+Assume the current region has Org syntax, and convert it to HTML.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an HTML buffer and use this
-command to convert it.
+itemized list in Org syntax in an HTML buffer and use this command
+to convert it.
\(fn)" t nil)
@@ -2598,11 +3130,11 @@ Return output file name.
\(fn PLIST FILENAME PUB-DIR)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-html" '("org-html-")))
+
;;;***
-;;;### (autoloads (org-icalendar-combine-agenda-files org-icalendar-export-agenda-files
-;;;;;; org-icalendar-export-to-ics) "ox-icalendar" "ox-icalendar.el"
-;;;;;; "0420c450f1da4a87e24a8afbc23f75f3")
+;;;### (autoloads nil "ox-icalendar" "ox-icalendar.el" (0 0 0 0))
;;; Generated autoloads from ox-icalendar.el
(autoload 'org-icalendar-export-to-ics "ox-icalendar" "\
@@ -2650,11 +3182,11 @@ The file is stored under the name chosen in
\(fn &optional ASYNC)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-icalendar" '("org-icalendar-")))
+
;;;***
-;;;### (autoloads (org-latex-publish-to-pdf org-latex-publish-to-latex
-;;;;;; org-latex-export-to-pdf org-latex-export-to-latex org-latex-convert-region-to-latex
-;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "d27ca15eea14bcf3173e74f51b3d3e69")
+;;;### (autoloads nil "ox-latex" "ox-latex.el" (0 0 0 0))
;;; Generated autoloads from ox-latex.el
(autoload 'org-latex-export-as-latex "ox-latex" "\
@@ -2690,9 +3222,9 @@ is non-nil.
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
(autoload 'org-latex-convert-region-to-latex "ox-latex" "\
-Assume the current region has org-mode syntax, and convert it to LaTeX.
+Assume the current region has Org syntax, and convert it to LaTeX.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an LaTeX buffer and use this
+itemized list in Org syntax in an LaTeX buffer and use this
command to convert it.
\(fn)" t nil)
@@ -2777,11 +3309,18 @@ Return output file name.
\(fn PLIST FILENAME PUB-DIR)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-latex" '("org-latex-")))
+
+;;;***
+
+;;;### (autoloads nil "ox-man" "ox-man.el" (0 0 0 0))
+;;; Generated autoloads from ox-man.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-man" '("org-man-")))
+
;;;***
-;;;### (autoloads (org-md-publish-to-md org-md-export-to-markdown
-;;;;;; org-md-convert-region-to-md org-md-export-as-markdown) "ox-md"
-;;;;;; "ox-md.el" "875c98308c9f63cd880c47ae90b2fb91")
+;;;### (autoloads nil "ox-md" "ox-md.el" (0 0 0 0))
;;; Generated autoloads from ox-md.el
(autoload 'org-md-export-as-markdown "ox-md" "\
@@ -2810,9 +3349,9 @@ non-nil.
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY)" t nil)
(autoload 'org-md-convert-region-to-md "ox-md" "\
-Assume the current region has org-mode syntax, and convert it to Markdown.
+Assume the current region has Org syntax, and convert it to Markdown.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in a Markdown buffer and use
+itemized list in Org syntax in a Markdown buffer and use
this command to convert it.
\(fn)" t nil)
@@ -2851,10 +3390,11 @@ Return output file name.
\(fn PLIST FILENAME PUB-DIR)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-md" '("org-md-")))
+
;;;***
-;;;### (autoloads (org-odt-convert org-odt-export-to-odt org-odt-export-as-odf-and-open
-;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "e3a936f4f3bbe947f4d4b75ce359538f")
+;;;### (autoloads nil "ox-odt" "ox-odt.el" (0 0 0 0))
;;; Generated autoloads from ox-odt.el
(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp)
@@ -2908,16 +3448,17 @@ Return output file's name.
Convert IN-FILE to format OUT-FMT using a command line converter.
IN-FILE is the file to be converted. If unspecified, it defaults
to variable `buffer-file-name'. OUT-FMT is the desired output
-format. Use `org-odt-convert-process' as the converter.
-If PREFIX-ARG is non-nil then the newly converted file is opened
-using `org-open-file'.
+format. Use `org-odt-convert-process' as the converter. If OPEN
+is non-nil then the newly converted file is opened using
+`org-open-file'.
-\(fn &optional IN-FILE OUT-FMT PREFIX-ARG)" t nil)
+\(fn &optional IN-FILE OUT-FMT OPEN)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-odt" '("org-odt-")))
;;;***
-;;;### (autoloads (org-org-publish-to-org org-org-export-to-org org-org-export-as-org)
-;;;;;; "ox-org" "ox-org.el" "8f2b09ccf51699abf1204d296e93a399")
+;;;### (autoloads nil "ox-org" "ox-org.el" (0 0 0 0))
;;; Generated autoloads from ox-org.el
(autoload 'org-org-export-as-org "ox-org" "\
@@ -2993,11 +3534,11 @@ Return output file name.
\(fn PLIST FILENAME PUB-DIR)" nil nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-org" '("org-org-")))
+
;;;***
-;;;### (autoloads (org-publish-current-project org-publish-current-file
-;;;;;; org-publish-all org-publish) "ox-publish" "ox-publish.el"
-;;;;;; "a6e792ca3583d341a674e11cecfdd6e9")
+;;;### (autoloads nil "ox-publish" "ox-publish.el" (0 0 0 0))
;;; Generated autoloads from ox-publish.el
(defalias 'org-publish-project 'org-publish)
@@ -3038,10 +3579,11 @@ the project.
\(fn &optional FORCE ASYNC)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-publish" '("org-publish-")))
+
;;;***
-;;;### (autoloads (org-texinfo-convert-region-to-texinfo org-texinfo-publish-to-texinfo)
-;;;;;; "ox-texinfo" "ox-texinfo.el" "78e9355de19d5650647109cc50825a58")
+;;;### (autoloads nil "ox-texinfo" "ox-texinfo.el" (0 0 0 0))
;;; Generated autoloads from ox-texinfo.el
(autoload 'org-texinfo-publish-to-texinfo "ox-texinfo" "\
@@ -3056,18 +3598,18 @@ Return output file name.
\(fn PLIST FILENAME PUB-DIR)" nil nil)
(autoload 'org-texinfo-convert-region-to-texinfo "ox-texinfo" "\
-Assume the current region has org-mode syntax, and convert it to Texinfo.
+Assume the current region has Org syntax, and convert it to Texinfo.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an Texinfo buffer and use
-this command to convert it.
+itemized list in Org syntax in an Texinfo buffer and use this
+command to convert it.
\(fn)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-texinfo" '("org-texinfo-")))
+
;;;***
-;;;### (autoloads (org-export-dispatch org-export-to-file org-export-to-buffer
-;;;;;; org-export-insert-default-template org-export-replace-region-by
-;;;;;; org-export-string-as org-export-as) "ox" "ox.el" "666ded911b08be6cee87ae459dc28b1c")
+;;;### (autoloads nil "ox" "ox.el" (0 0 0 0))
;;; Generated autoloads from ox.el
(autoload 'org-export-as "ox" "\
@@ -3174,6 +3716,8 @@ This function returns BUFFER.
\(fn BACKEND BUFFER &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil)
+(function-put 'org-export-to-buffer 'lisp-indent-function '2)
+
(autoload 'org-export-to-file "ox" "\
Call `org-export-as' with output to a specified file.
@@ -3208,6 +3752,8 @@ or FILE.
\(fn BACKEND FILE &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil)
+(function-put 'org-export-to-file 'lisp-indent-function '2)
+
(autoload 'org-export-dispatch "ox" "\
Export dispatcher for Org mode.
@@ -3222,13 +3768,15 @@ SPC and DEL (resp. C-n and C-p) keys.
Set variable `org-export-dispatch-use-expert-ui' to switch to one
flavor or the other.
-When ARG is \\[universal-argument], repeat the last export action, with the same set
-of options used back then, on the current buffer.
+When ARG is `\\[universal-argument]', repeat the last export action, with the same
+set of options used back then, on the current buffer.
-When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack.
+When ARG is `\\[universal-argument] \\[universal-argument]', display the asynchronous export stack.
\(fn &optional ARG)" t nil)
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox" '("org-export-")))
+
;;;***
(provide 'org-loaddefs)
diff --git a/lisp/org-macro.el b/lisp/org-macro.el
index fee33f6..8560891 100644
--- a/lisp/org-macro.el
+++ b/lisp/org-macro.el
@@ -1,4 +1,4 @@
-;;; org-macro.el --- Macro Replacement Code for Org Mode
+;;; org-macro.el --- Macro Replacement Code for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
@@ -43,6 +43,7 @@
;; {{{email}}} and {{{title}}} macros.
;;; Code:
+(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
@@ -57,12 +58,13 @@
(declare-function org-element-type "org-element" (element))
(declare-function org-file-contents "org" (file &optional noerror))
(declare-function org-mode "org" ())
-(declare-function org-remove-double-quotes "org" (s))
-(declare-function org-with-wide-buffer "org-macs" (&rest body))
+(declare-function vc-backend "vc-hooks" (f))
+(declare-function vc-call "vc-hooks" (fun file &rest args) t)
+(declare-function vc-exec-after "vc-dispatcher" (code))
;;; Variables
-(defvar org-macro-templates nil
+(defvar-local org-macro-templates nil
"Alist containing all macro templates in current buffer.
Associations are in the shape of (NAME . TEMPLATE) where NAME
stands for macro's name and template for its replacement value,
@@ -70,50 +72,48 @@ both as strings. This is an internal variable. Do not set it
directly, use instead:
#+MACRO: name template")
-(make-variable-buffer-local 'org-macro-templates)
-
;;; Functions
(defun org-macro--collect-macros ()
"Collect macro definitions in current buffer and setup files.
Return an alist containing all macro templates found."
- (let* (collect-macros ; For byte-compiler.
- (collect-macros
- (lambda (files templates)
- ;; Return an alist of macro templates. FILES is a list of
- ;; setup files names read so far, used to avoid circular
- ;; dependencies. TEMPLATES is the alist collected so far.
- (let ((case-fold-search t))
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (let ((val (org-element-property :value element)))
- (if (equal (org-element-property :key element) "MACRO")
- ;; Install macro in TEMPLATES.
- (when (string-match
- "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)
- (let* ((name (match-string 1 val))
- (template (or (match-string 2 val) ""))
- (old-cell (assoc name templates)))
- (if old-cell (setcdr old-cell template)
- (push (cons name template) templates))))
- ;; Enter setup file.
- (let ((file (expand-file-name
- (org-remove-double-quotes val))))
- (unless (member file files)
- (with-temp-buffer
- (setq default-directory
- (file-name-directory file))
- (org-mode)
- (insert (org-file-contents file 'noerror))
- (setq templates
- (funcall collect-macros (cons file files)
- templates)))))))))))
- templates))))
+ (letrec ((collect-macros
+ (lambda (files templates)
+ ;; Return an alist of macro templates. FILES is a list
+ ;; of setup files names read so far, used to avoid
+ ;; circular dependencies. TEMPLATES is the alist
+ ;; collected so far.
+ (let ((case-fold-search t))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let ((val (org-element-property :value element)))
+ (if (equal (org-element-property :key element) "MACRO")
+ ;; Install macro in TEMPLATES.
+ (when (string-match
+ "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)
+ (let* ((name (match-string 1 val))
+ (template (or (match-string 2 val) ""))
+ (old-cell (assoc name templates)))
+ (if old-cell (setcdr old-cell template)
+ (push (cons name template) templates))))
+ ;; Enter setup file.
+ (let ((file (expand-file-name
+ (org-unbracket-string "\"" "\"" val))))
+ (unless (member file files)
+ (with-temp-buffer
+ (setq default-directory
+ (file-name-directory file))
+ (org-mode)
+ (insert (org-file-contents file 'noerror))
+ (setq templates
+ (funcall collect-macros (cons file files)
+ templates)))))))))))
+ templates))))
(funcall collect-macros nil nil)))
(defun org-macro-initialize-templates ()
@@ -148,7 +148,8 @@ function installs the following ones: \"property\",
(mapc update-templates
(list (cons "input-file" (file-name-nondirectory visited-file))
(cons "modification-time"
- (format "(eval (format-time-string \"$1\" '%s))"
+ (format "(eval (format-time-string \"$1\" (or (and (org-string-nw-p \"$2\") (org-macro--vc-modified-time %s)) '%s)))"
+ (prin1-to-string visited-file)
(prin1-to-string
(nth 5 (file-attributes visited-file)))))))))
(setq org-macro-templates templates)))
@@ -189,54 +190,54 @@ found in the buffer with no definition in TEMPLATES.
Optional argument KEYWORDS, when non-nil is a list of keywords,
as strings, where macro expansion is allowed."
(org-with-wide-buffer
- (goto-char (point-min))
- (let ((properties-regexp
- (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords)))
- record)
- (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
- (let* ((datum (save-match-data (org-element-context)))
- (type (org-element-type datum))
- (macro
- (cond
- ((eq type 'macro) datum)
- ;; In parsed keywords and associated node properties,
- ;; force macro recognition.
- ((or (and (eq type 'keyword)
- (member (org-element-property :key datum) keywords))
- (and (eq type 'node-property)
- (org-string-match-p
- properties-regexp
- (org-element-property :key datum))))
- (save-restriction
- (narrow-to-region (match-beginning 0) (line-end-position))
- (org-element-map (org-element-parse-buffer) 'macro
- #'identity nil t))))))
- (when macro
- (let* ((value (org-macro-expand macro templates))
- (begin (org-element-property :begin macro))
- (signature (list begin
- macro
- (org-element-property :args macro))))
- ;; Avoid circular dependencies by checking if the same
- ;; macro with the same arguments is expanded at the same
- ;; position twice.
- (cond ((member signature record)
- (error "Circular macro expansion: %s"
- (org-element-property :key macro)))
- (value
- (push signature record)
- (delete-region
- begin
- ;; Preserve white spaces after the macro.
- (progn (goto-char (org-element-property :end macro))
- (skip-chars-backward " \t")
- (point)))
- ;; Leave point before replacement in case of
- ;; recursive expansions.
- (save-excursion (insert value)))
- (finalize
- (error "Undefined Org macro: %s; aborting"
- (org-element-property :key macro)))))))))))
+ (goto-char (point-min))
+ (let ((properties-regexp
+ (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords)))
+ record)
+ (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
+ (let* ((datum (save-match-data (org-element-context)))
+ (type (org-element-type datum))
+ (macro
+ (cond
+ ((eq type 'macro) datum)
+ ;; In parsed keywords and associated node properties,
+ ;; force macro recognition.
+ ((or (and (eq type 'keyword)
+ (member (org-element-property :key datum) keywords))
+ (and (eq type 'node-property)
+ (string-match-p
+ properties-regexp
+ (org-element-property :key datum))))
+ (save-restriction
+ (narrow-to-region (match-beginning 0) (line-end-position))
+ (org-element-map (org-element-parse-buffer) 'macro
+ #'identity nil t))))))
+ (when macro
+ (let* ((value (org-macro-expand macro templates))
+ (begin (org-element-property :begin macro))
+ (signature (list begin
+ macro
+ (org-element-property :args macro))))
+ ;; Avoid circular dependencies by checking if the same
+ ;; macro with the same arguments is expanded at the same
+ ;; position twice.
+ (cond ((member signature record)
+ (error "Circular macro expansion: %s"
+ (org-element-property :key macro)))
+ (value
+ (push signature record)
+ (delete-region
+ begin
+ ;; Preserve white spaces after the macro.
+ (progn (goto-char (org-element-property :end macro))
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Leave point before replacement in case of
+ ;; recursive expansions.
+ (save-excursion (insert value)))
+ (finalize
+ (error "Undefined Org macro: %s; aborting"
+ (org-element-property :key macro)))))))))))
(defun org-macro-escape-arguments (&rest args)
"Build macro's arguments string from ARGS.
@@ -279,6 +280,30 @@ Return a list of arguments, as strings. This is the opposite of
s nil t)
"\000"))
+(defun org-macro--vc-modified-time (file)
+ (save-window-excursion
+ (when (vc-backend file)
+ (let ((buf (get-buffer-create " *org-vc*"))
+ (case-fold-search t)
+ date)
+ (unwind-protect
+ (progn
+ (vc-call print-log file buf nil nil 1)
+ (with-current-buffer buf
+ (vc-exec-after
+ (lambda ()
+ (goto-char (point-min))
+ (when (re-search-forward "Date:?[ \t]*" nil t)
+ (let ((time (parse-time-string
+ (buffer-substring
+ (point) (line-end-position)))))
+ (when (cl-some #'identity time)
+ (setq date (apply #'encode-time time))))))))
+ (let ((proc (get-buffer-process buf)))
+ (while (and proc (accept-process-output proc .5 nil t)))))
+ (kill-buffer buf))
+ date))))
+
(provide 'org-macro)
;;; org-macro.el ends here
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 631f83a..6c0abcb 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -1,4 +1,4 @@
-;;; org-macs.el --- Top-level definitions for Org-mode
+;;; org-macs.el --- Top-level Definitions for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -25,28 +25,12 @@
;;; Commentary:
;; This file contains macro definitions, defsubst definitions, other
-;; stuff needed for compilation and top-level forms in Org-mode, as well
-;; lots of small functions that are not org-mode specific but simply
-;; generally useful stuff.
+;; stuff needed for compilation and top-level forms in Org mode, as
+;; well lots of small functions that are not Org mode specific but
+;; simply generally useful stuff.
;;; Code:
-(eval-and-compile
- (unless (fboundp 'declare-function)
- (defmacro declare-function (fn file &optional _arglist _fileonly)
- `(autoload ',fn ,file)))
-
- (if (>= emacs-major-version 23)
- (defsubst org-char-to-string(c)
- "Defsubst to decode UTF-8 character values in emacs 23 and beyond."
- (char-to-string c))
- (defsubst org-char-to-string (c)
- "Defsubst to decode UTF-8 character values in emacs 22."
- (string (decode-char 'ucs c)))))
-
-(declare-function org-add-props "org-compat" (string plist &rest props))
-(declare-function org-string-match-p "org-compat" (&rest args))
-
(defmacro org-with-gensyms (symbols &rest body)
(declare (debug (sexp body)) (indent 1))
`(let ,(mapcar (lambda (s)
@@ -54,27 +38,11 @@
symbols)
,@body))
-(defmacro org-called-interactively-p (&optional kind)
- (declare (debug (&optional ("quote" symbolp)))) ;Why not just t?
- (if (featurep 'xemacs)
- `(interactive-p)
- (if (or (> emacs-major-version 23)
- (and (>= emacs-major-version 23)
- (>= emacs-minor-version 2)))
- ;; defined with no argument in <=23.1
- `(with-no-warnings (called-interactively-p ,kind))
- `(interactive-p))))
-
-(defmacro org-bound-and-true-p (var)
- "Return the value of symbol VAR if it is bound, else nil."
- (declare (debug (symbolp)))
- `(and (boundp (quote ,var)) ,var))
-
(defun org-string-nw-p (s)
"Return S if S is a string containing a non-blank character.
Otherwise, return nil."
(and (stringp s)
- (org-string-match-p "[^ \r\t\n]" s)
+ (string-match-p "[^ \r\t\n]" s)
s))
(defun org-not-nil (v)
@@ -82,25 +50,6 @@ Otherwise, return nil."
Otherwise return nil."
(and v (not (equal v "nil")) v))
-(defun org-substitute-posix-classes (re)
- "Substitute posix classes in regular expression RE."
- (let ((ss re))
- (save-match-data
- (while (string-match "\\[:alnum:\\]" ss)
- (setq ss (replace-match "a-zA-Z0-9" t t ss)))
- (while (string-match "\\[:word:\\]" ss)
- (setq ss (replace-match "a-zA-Z0-9" t t ss)))
- (while (string-match "\\[:alpha:\\]" ss)
- (setq ss (replace-match "a-zA-Z" t t ss)))
- (while (string-match "\\[:punct:\\]" ss)
- (setq ss (replace-match "\001-@[-`{-~" t t ss)))
- ss)))
-
-(defmacro org-re (s)
- "Replace posix classes in regular expression."
- (declare (debug (form)))
- (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s))
-
(defmacro org-preserve-lc (&rest body)
(declare (debug (body)))
(org-with-gensyms (line col)
@@ -136,19 +85,6 @@ Otherwise return nil."
(partial-completion-mode 1))
,@body))
-;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
-(defmacro org-maybe-intangible (props)
- "Add \\='(intangible t) to PROPS if Emacs version is earlier than Emacs 22.
-In Emacs 21, invisible text is not avoided by the command loop, so the
-intangible property is needed to make sure point skips this text.
-In Emacs 22, this is not necessary. The intangible text property has
-led to problems with flyspell. These problems are fixed in flyspell.el,
-but we still avoid setting the property in Emacs 22 and later.
-We use a macro so that the test can happen at compilation time."
- (if (< emacs-major-version 22)
- `(append '(intangible t) ,props)
- props))
-
(defmacro org-with-point-at (pom &rest body)
"Move to buffer and point of point-or-marker POM for the duration of BODY."
(declare (debug (form body)) (indent 1))
@@ -160,10 +96,6 @@ We use a macro so that the test can happen at compilation time."
(goto-char (or ,mpom (point)))
,@body)))))
-(defmacro org-no-warnings (&rest body)
- (declare (debug (body)))
- (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
-
(defmacro org-with-remote-undo (buffer &rest body)
"Execute BODY while recording undo information in two buffers."
(declare (debug (form body)) (indent 1))
@@ -199,22 +131,12 @@ We use a macro so that the test can happen at compilation time."
org-emphasis t)
"Properties to remove when a string without properties is wanted.")
-(defsubst org-match-string-no-properties (num &optional string)
- (if (featurep 'xemacs)
- (let ((s (match-string num string)))
- (and s (remove-text-properties 0 (length s) org-rm-props s))
- s)
- (match-string-no-properties num string)))
-
(defsubst org-no-properties (s &optional restricted)
"Remove all text properties from string S.
When RESTRICTED is non-nil, only remove the properties listed
in `org-rm-props'."
- (if (fboundp 'set-text-properties)
- (set-text-properties 0 (length s) nil s)
- (if restricted
- (remove-text-properties 0 (length s) org-rm-props s)
- (set-text-properties 0 (length s) nil s)))
+ (if restricted (remove-text-properties 0 (length s) org-rm-props s)
+ (set-text-properties 0 (length s) nil s))
s)
(defsubst org-get-alist-option (option key)
@@ -236,16 +158,6 @@ program is needed for, so that the error message can be more informative."
(error "Can't find `%s'%s" cmd
(if use (format " (%s)" use) "")))))
-(defsubst org-inhibit-invisibility ()
- "Modified `buffer-invisibility-spec' for Emacs 21.
-Some ops with invisible text do not work correctly on Emacs 21. For these
-we turn off invisibility temporarily. Use this in a `let' form."
- (if (< emacs-major-version 22) nil buffer-invisibility-spec))
-
-(defsubst org-set-local (var value)
- "Make VAR local in current buffer and set it to VALUE."
- (set (make-local-variable var) value))
-
(defsubst org-last (list)
"Return the last element of LIST."
(car (last list)))
@@ -298,13 +210,6 @@ This is in contrast to merely setting it to 0."
(setq plist (cddr plist)))
p))
-(defun org-replace-match-keep-properties (newtext &optional fixedcase
- literal string)
- "Like `replace-match', but add the text properties found original text."
- (setq newtext (org-add-props newtext (text-properties-at
- (match-beginning 0) string)))
- (replace-match newtext fixedcase literal string))
-
(defmacro org-save-outline-visibility (use-markers &rest body)
"Save and restore outline visibility around BODY.
If USE-MARKERS is non-nil, use markers for the positions.
@@ -313,19 +218,15 @@ but it also means that the buffer should stay alive
during the operation, because otherwise all these markers will
point nowhere."
(declare (debug (form body)) (indent 1))
- (org-with-gensyms (data rtn)
- `(let ((,data (org-outline-overlay-data ,use-markers))
- ,rtn)
+ (org-with-gensyms (data)
+ `(let ((,data (org-outline-overlay-data ,use-markers)))
(unwind-protect
- (progn
- (setq ,rtn (progn ,@body))
+ (prog1 (progn ,@body)
(org-set-outline-overlay-data ,data))
(when ,use-markers
- (mapc (lambda (c)
- (and (markerp (car c)) (move-marker (car c) nil))
- (and (markerp (cdr c)) (move-marker (cdr c) nil)))
- ,data)))
- ,rtn)))
+ (dolist (c ,data)
+ (when (markerp (car c)) (move-marker (car c) nil))
+ (when (markerp (cdr c)) (move-marker (cdr c) nil))))))))
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
@@ -366,12 +267,6 @@ The number of levels is controlled by `org-inlinetask-min-level'"
limit-level)))
(format "\\*\\{1,%d\\} " nstars)))))
-(defun org-format-seconds (string seconds)
- "Compatibility function replacing format-seconds."
- (if (fboundp 'format-seconds)
- (format-seconds string seconds)
- (format-time-string string (seconds-to-time seconds))))
-
(defmacro org-eval-in-environment (environment form)
(declare (debug (form form)) (indent 1))
`(eval (list 'let ,environment ',form)))
@@ -387,10 +282,17 @@ the value in cdr."
;;;###autoload
(defmacro org-load-noerror-mustsuffix (file)
- "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it."
- (if (featurep 'xemacs)
- `(load ,file 'noerror)
- `(load ,file 'noerror nil nil 'mustsuffix)))
+ "Load FILE with optional arguments NOERROR and MUSTSUFFIX."
+ `(load ,file 'noerror nil nil 'mustsuffix))
+
+(defun org-unbracket-string (pre post string)
+ "Remove PRE/POST from the beginning/end of STRING.
+Both PRE and POST must be pre-/suffixes of STRING, or neither is
+removed."
+ (if (and (string-prefix-p pre string)
+ (string-suffix-p post string))
+ (substring string (length pre) (- (length post)))
+ string))
(provide 'org-macs)
diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el
index e8abef9..5d9ae58 100644
--- a/lisp/org-mhe.el
+++ b/lisp/org-mhe.el
@@ -1,4 +1,4 @@
-;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
+;;; org-mhe.el --- Support for Links to MH-E Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -24,8 +24,8 @@
;;
;;; Commentary:
-;; This file implements links to MH-E messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to MH-E messages from within Org.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
@@ -74,34 +74,25 @@ supported by MH-E."
(defvar mh-search-regexp-builder)
;; Install the link type
-(org-add-link-type "mhe" 'org-mhe-open)
-(add-hook 'org-store-link-functions 'org-mhe-store-link)
+(org-link-set-parameters "mhe" :follow #'org-mhe-open :store #'org-mhe-store-link)
;; Implementation
(defun org-mhe-store-link ()
"Store a link to an MH-E folder or message."
- (when (or (equal major-mode 'mh-folder-mode)
- (equal major-mode 'mh-show-mode))
+ (when (or (eq major-mode 'mh-folder-mode)
+ (eq major-mode 'mh-show-mode))
(save-window-excursion
(let* ((from (org-mhe-get-header "From:"))
(to (org-mhe-get-header "To:"))
(message-id (org-mhe-get-header "Message-Id:"))
(subject (org-mhe-get-header "Subject:"))
(date (org-mhe-get-header "Date:"))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t) (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
link desc)
- (org-store-link-props :type "mh" :from from :to to
+ (org-store-link-props :type "mh" :from from :to to :date date
:subject subject :message-id message-id)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description))
(setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
- (org-remove-angle-brackets message-id)))
+ (org-unbracket-string "<" ">" message-id)))
(org-add-link-props :link link :description desc)
link))))
@@ -120,7 +111,7 @@ supported by MH-E."
So if you use sequences, it will now work."
(save-excursion
(let* ((folder
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
mh-current-folder
;; Refer to the show buffer
mh-show-folder-buffer))
@@ -132,7 +123,7 @@ So if you use sequences, it will now work."
;; mh-index-data is always nil in a show buffer.
(if (and (boundp 'mh-index-folder)
(string= mh-index-folder (substring folder 0 end-index)))
- (if (equal major-mode 'mh-show-mode)
+ (if (eq major-mode 'mh-show-mode)
(save-window-excursion
(let (pop-up-frames)
(when (buffer-live-p (get-buffer folder))
@@ -158,7 +149,7 @@ So if you use sequences, it will now work."
"Return the name of the current message folder.
Be careful if you use sequences."
(save-excursion
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
mh-current-folder
;; Refer to the show buffer
mh-show-folder-buffer)))
@@ -167,7 +158,7 @@ Be careful if you use sequences."
"Return the number of the current message.
Be careful if you use sequences."
(save-excursion
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
(mh-get-msg-num nil)
;; Refer to the show buffer
(mh-show-buffer-message-number))))
@@ -182,12 +173,12 @@ you have a better idea of how to do this then please let us know."
(header-field))
(with-current-buffer buffer
(mh-display-msg num folder)
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
(mh-header-display)
(mh-show-header-display))
(set-buffer buffer)
(setq header-field (mh-get-header-field header))
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
(mh-show)
(mh-show-show))
(org-trim header-field))))
@@ -206,7 +197,7 @@ folders."
(if (not article)
(mh-visit-folder (mh-normalize-folder-name folder))
(mh-search-choose)
- (if (equal mh-searcher 'pick)
+ (if (eq mh-searcher 'pick)
(progn
(setq article (org-add-angle-brackets article))
(mh-search folder (list "--message-id" article))
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index e6709e4..3ef3f4e 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -1,4 +1,4 @@
-;;; org-mobile.el --- Code for asymmetric sync with a mobile device
+;;; org-mobile.el --- Code for Asymmetric Sync With a Mobile Device -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
@@ -24,21 +24,20 @@
;;
;;; Commentary:
;;
-;; This file contains the code to interact with Richard Moreland's iPhone
-;; application MobileOrg, as well as with the Android version by Matthew Jones.
-;; This code is documented in Appendix B of the Org-mode manual. The code is
-;; not specific for the iPhone and Android - any external
-;; viewer/flagging/editing application that uses the same conventions could
-;; be used.
+;; This file contains the code to interact with Richard Moreland's
+;; iPhone application MobileOrg, as well as with the Android version
+;; by Matthew Jones. This code is documented in Appendix B of the Org
+;; manual. The code is not specific for the iPhone and Android - any
+;; external viewer/flagging/editing application that uses the same
+;; conventions could be used.
(require 'org)
(require 'org-agenda)
-;;; Code:
+(require 'cl-lib)
-(eval-when-compile (require 'cl))
+(defvar org-agenda-keep-restricted-file-list)
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
+;;; Code:
(defgroup org-mobile nil
"Options concerning support for a viewer/editor on a mobile device."
@@ -192,27 +191,6 @@ the editing types for which the mobile version should always dominate."
(const heading)
(const body))))
-(defcustom org-mobile-action-alist
- '(("edit" . (org-mobile-edit data old new)))
- "Alist with flags and actions for mobile sync.
-When flagging an entry, MobileOrg will create entries that look like
-
- * F(action:data) [[id:entry-id][entry title]]
-
-This alist defines that the ACTION in the parentheses of F() should mean,
-i.e. what action should be taken. The :data part in the parenthesis is
-optional. If present, the string after the colon will be passed to the
-action form as the `data' variable.
-The car of each elements of the alist is an actions string. The cdr is
-an Emacs Lisp form that will be evaluated with the cursor on the headline
-of that entry.
-
-For now, it is not recommended to change this variable."
- :group 'org-mobile
- :type '(repeat
- (cons (string :tag "Action flag")
- (sexp :tag "Action form"))))
-
(defcustom org-mobile-checksum-binary (or (executable-find "shasum")
(executable-find "sha1sum")
(executable-find "md5sum")
@@ -249,6 +227,23 @@ by the mobile device, this hook should be used to copy the emptied
capture file `mobileorg.org' back to the WebDAV directory, for example
using `rsync' or `scp'.")
+(defconst org-mobile-action-alist '(("edit" . org-mobile-edit))
+ "Alist with flags and actions for mobile sync.
+When flagging an entry, MobileOrg will create entries that look like
+
+ * F(action:data) [[id:entry-id][entry title]]
+
+This alist defines that the ACTION in the parentheses of F()
+should mean, i.e. what action should be taken. The :data part in
+the parenthesis is optional. If present, the string after the
+colon will be passed to the action function as the first argument
+variable.
+
+The car of each elements of the alist is an actions string. The
+cdr is a function that is called with the cursor on the headline
+of that entry. It should accept three arguments, the :data part,
+the old and new values for the entry.")
+
(defvar org-mobile-last-flagged-files nil
"List of files containing entries flagged in the latest pull.")
@@ -422,10 +417,10 @@ agenda view showing the flagged items."
(let ((files-alist (sort (copy-sequence org-mobile-files-alist)
(lambda (a b) (string< (cdr a) (cdr b)))))
(def-todo (default-value 'org-todo-keywords))
- (def-tags (default-value 'org-tag-alist))
+ (def-tags org-tag-alist)
(target-file (expand-file-name org-mobile-index-file
org-mobile-directory))
- file link-name todo-kwds done-kwds tags entry kwds dwds twds)
+ todo-kwds done-kwds tags)
(when (stringp (car def-todo))
(setq def-todo (list (cons 'sequence def-todo))))
(org-agenda-prepare-buffers (mapcar 'car files-alist))
@@ -435,35 +430,24 @@ agenda view showing the flagged items."
(org-uniquify org-todo-keywords-for-agenda)))
(setq tags (mapcar 'car (org-global-tags-completion-table
(mapcar 'car files-alist))))
- (with-temp-file
- (if org-mobile-use-encryption
- org-mobile-encryption-tempfile
- target-file)
+ (with-temp-file (if org-mobile-use-encryption org-mobile-encryption-tempfile
+ target-file)
(insert "#+READONLY\n")
- (while (setq entry (pop def-todo))
- (setq kwds (mapcar (lambda (x) (if (string-match "(" x)
- (substring x 0 (match-beginning 0))
- x))
- (cdr entry)))
- (insert "#+TODO: " (mapconcat 'identity kwds " ") "\n")
- (setq dwds (or (member "|" kwds) (last kwds))
- twds (org-delete-all dwds kwds)
- todo-kwds (org-delete-all twds todo-kwds)
- done-kwds (org-delete-all dwds done-kwds)))
+ (dolist (entry def-todo)
+ (let ((kwds (mapcar (lambda (x)
+ (if (string-match "(" x)
+ (substring x 0 (match-beginning 0))
+ x))
+ (cdr entry))))
+ (insert "#+TODO: " (mapconcat #'identity kwds " ") "\n")
+ (let* ((dwds (or (member "|" kwds) (last kwds)))
+ (twds (org-delete-all dwds kwds)))
+ (setq todo-kwds (org-delete-all twds todo-kwds))
+ (setq done-kwds (org-delete-all dwds done-kwds)))))
(when (or todo-kwds done-kwds)
(insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | "
(mapconcat 'identity done-kwds " ") "\n"))
- (setq def-tags (mapcar
- (lambda (x)
- (cond ((null x) nil)
- ((stringp x) x)
- ((eq (car x) :startgroup) "{")
- ((eq (car x) :endgroup) "}")
- ((eq (car x) :grouptags) nil)
- ((eq (car x) :newline) nil)
- ((listp x) (car x))))
- def-tags))
- (setq def-tags (delq nil def-tags))
+ (setq def-tags (split-string (org-tag-alist-to-string def-tags t)))
(setq tags (org-delete-all def-tags tags))
(setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b)))))
(setq tags (append def-tags tags nil))
@@ -472,11 +456,8 @@ agenda view showing the flagged items."
(when (file-exists-p (expand-file-name
org-mobile-directory "agendas.org"))
(insert "* [[file:agendas.org][Agenda Views]]\n"))
- (while (setq entry (pop files-alist))
- (setq file (car entry)
- link-name (cdr entry))
- (insert (format "* [[file:%s][%s]]\n"
- link-name link-name)))
+ (pcase-dolist (`(,_ . ,link-name) files-alist)
+ (insert (format "* [[file:%s][%s]]\n" link-name link-name)))
(push (cons org-mobile-index-file (md5 (buffer-string)))
org-mobile-checksum-files))
(when org-mobile-use-encryption
@@ -662,7 +643,7 @@ The table of checksums is written to the file mobile-checksums."
m 10 " " 'planning)
"\n")
(when (setq id
- (if (org-bound-and-true-p
+ (if (bound-and-true-p
org-mobile-force-id-on-agenda-items)
(org-id-get m 'create)
(or (org-entry-get m "ID")
@@ -822,14 +803,14 @@ If BEG and END are given, only do this in that region."
(cnt-flag 0)
(cnt-error 0)
buf-list
- id-pos org-mobile-error)
+ org-mobile-error)
;; Count the new captures
(goto-char beg)
(while (re-search-forward "^\\* \\(.*\\)" end t)
(and (>= (- (match-end 1) (match-beginning 1)) 2)
(not (equal (downcase (substring (match-string 1) 0 2)) "f("))
- (incf cnt-new)))
+ (cl-incf cnt-new)))
;; Find and apply the edits
(goto-char beg)
@@ -841,19 +822,21 @@ If BEG and END are given, only do this in that region."
(id-pos (condition-case msg
(org-mobile-locate-entry (match-string 4))
(error (nth 1 msg))))
- (bos (point-at-bol))
+ (bos (line-beginning-position))
(eos (save-excursion (org-end-of-subtree t t)))
(cmd (if (equal action "")
- '(progn
- (incf cnt-flag)
- (org-toggle-tag "FLAGGED" 'on)
- (and note
- (org-entry-put nil "THEFLAGGINGNOTE" note)))
- (incf cnt-edit)
+ (let ((note (buffer-substring-no-properties
+ (line-beginning-position 2) eos)))
+ (lambda (_data _old _new)
+ (cl-incf cnt-flag)
+ (org-toggle-tag "FLAGGED" 'on)
+ (org-entry-put
+ nil "THEFLAGGINGNOTE"
+ (replace-regexp-in-string "\n" "\\\\n" note))))
+ (cl-incf cnt-edit)
(cdr (assoc action org-mobile-action-alist))))
- (note (and (equal action "")
- (buffer-substring (1+ (point-at-eol)) eos)))
- (org-inhibit-logging 'note) ;; Do not take notes interactively
+ ;; Do not take notes interactively.
+ (org-inhibit-logging 'note)
old new)
(goto-char bos)
@@ -866,11 +849,11 @@ If BEG and END are given, only do this in that region."
(if (stringp id-pos)
(insert id-pos " ")
(insert "BAD REFERENCE "))
- (incf cnt-error)
+ (cl-incf cnt-error)
(throw 'next t))
(unless cmd
(insert "BAD FLAG ")
- (incf cnt-error)
+ (cl-incf cnt-error)
(throw 'next t))
(move-marker bos-marker (point))
(if (re-search-forward "^** Old value[ \t]*$" eos t)
@@ -883,34 +866,28 @@ If BEG and END are given, only do this in that region."
(progn (outline-next-heading)
(if (eobp) (org-back-over-empty-lines))
(point)))))
- (setq old (and old (if (string-match "\\S-" old) old nil)))
- (setq new (and new (if (string-match "\\S-" new) new nil)))
- (if (and note (> (length note) 0))
- ;; Make Note into a single line, to fit into a property
- (setq note (mapconcat 'identity
- (org-split-string (org-trim note) "\n")
- "\\n")))
+ (setq old (org-string-nw-p old))
+ (setq new (org-string-nw-p new))
(unless (equal data "body")
- (setq new (and new (org-trim new))
- old (and old (org-trim old))))
+ (setq new (and new (org-trim new)))
+ (setq old (and old (org-trim old))))
(goto-char (+ 2 bos-marker))
;; Remember this place so that we can return
(move-marker marker (point))
(setq org-mobile-error nil)
- (save-excursion
- (condition-case msg
- (org-with-point-at id-pos
- (progn
- (eval cmd)
- (unless (member data (list "delete" "archive" "archive-sibling" "addheading"))
- (if (member "FLAGGED" (org-get-tags))
- (add-to-list 'org-mobile-last-flagged-files
- (buffer-file-name (current-buffer)))))))
- (error (setq org-mobile-error msg))))
+ (condition-case msg
+ (org-with-point-at id-pos
+ (funcall cmd data old new)
+ (unless (member data '("delete" "archive" "archive-sibling"
+ "addheading"))
+ (when (member "FLAGGED" (org-get-tags))
+ (add-to-list 'org-mobile-last-flagged-files
+ (buffer-file-name)))))
+ (error (setq org-mobile-error msg)))
(when org-mobile-error
- (org-pop-to-buffer-same-window (marker-buffer marker))
+ (pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker)
- (incf cnt-error)
+ (cl-incf cnt-error)
(insert (if (stringp (nth 1 org-mobile-error))
(nth 1 org-mobile-error)
"EXECUTION FAILED")
@@ -923,8 +900,8 @@ If BEG and END are given, only do this in that region."
(save-buffer)
(move-marker marker nil)
(move-marker end nil)
- (message "%d new, %d edits, %d flags, %d errors" cnt-new
- cnt-edit cnt-flag cnt-error)
+ (message "%d new, %d edits, %d flags, %d errors"
+ cnt-new cnt-edit cnt-flag cnt-error)
(sit-for 1)))
(defun org-mobile-timestamp-buffer (buf)
@@ -1019,7 +996,7 @@ be returned that indicates what went wrong."
((equal new "DONEARCHIVE")
(org-todo 'done)
(org-archive-subtree-default))
- ((equal new current) t) ; nothing needs to be done
+ ((equal new current) t) ; nothing needs to be done
((or (equal current old)
(eq org-mobile-force-mobile-change t)
(memq 'todo org-mobile-force-mobile-change))
@@ -1041,33 +1018,35 @@ be returned that indicates what went wrong."
(or old "") (or current "")))))
((eq what 'priority)
- (when (looking-at org-complex-heading-regexp)
- (setq current (and (match-end 3) (substring (match-string 3) 2 3)))
- (cond
- ((equal current new) t) ; no action required
- ((or (equal current old)
- (eq org-mobile-force-mobile-change t)
- (memq 'tags org-mobile-force-mobile-change))
- (org-priority (and new (string-to-char new))))
- (t (error "Priority was expected to be %s, but is %s"
- old current)))))
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (let ((current (and (match-end 3) (substring (match-string 3) 2 3))))
+ (cond
+ ((equal current new) t) ;no action required
+ ((or (equal current old)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'tags org-mobile-force-mobile-change))
+ (org-priority (and new (string-to-char new))))
+ (t (error "Priority was expected to be %s, but is %s"
+ old current)))))))
((eq what 'heading)
- (when (looking-at org-complex-heading-regexp)
- (setq current (match-string 4))
- (cond
- ((equal current new) t) ; no action required
- ((or (equal current old)
- (eq org-mobile-force-mobile-change t)
- (memq 'heading org-mobile-force-mobile-change))
- (goto-char (match-beginning 4))
- (insert new)
- (delete-region (point) (+ (point) (length current)))
- (org-set-tags nil 'align))
- (t (error "Heading changed in MobileOrg and on the computer")))))
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (let ((current (match-string 4)))
+ (cond
+ ((equal current new) t) ;no action required
+ ((or (equal current old)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'heading org-mobile-force-mobile-change))
+ (goto-char (match-beginning 4))
+ (insert new)
+ (delete-region (point) (+ (point) (length current)))
+ (org-set-tags nil 'align))
+ (t (error "Heading changed in MobileOrg and on the computer")))))))
((eq what 'addheading)
- (if (org-at-heading-p) ; if false we are in top-level of file
+ (if (org-at-heading-p) ; if false we are in top-level of file
(progn
;; Workaround a `org-insert-heading-respect-content' bug
;; which prevents correct insertion when point is invisible
@@ -1082,7 +1061,7 @@ be returned that indicates what went wrong."
((eq what 'refile)
(org-copy-subtree)
(org-with-point-at (org-mobile-locate-entry new)
- (if (org-at-heading-p) ; if false we are in top-level of file
+ (if (org-at-heading-p) ; if false we are in top-level of file
(progn
(setq level (org-get-valid-level (funcall outline-level) 1))
(org-end-of-subtree t t)
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index 232a4be..797a21f 100644
--- a/lisp/org-mouse.el
+++ b/lisp/org-mouse.el
@@ -1,4 +1,4 @@
-;;; org-mouse.el --- Better mouse support for org-mode
+;;; org-mouse.el --- Better mouse support for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2016 Free Software Foundation, Inc.
@@ -26,8 +26,8 @@
;;
;; http://orgmode.org
;;
-;; Org-mouse implements the following features:
-;; * following links with the left mouse button (in Emacs 22)
+;; Org mouse implements the following features:
+;; * following links with the left mouse button
;; * subtree expansion/collapse (org-cycle) with the left mouse button
;; * several context menus on the right mouse button:
;; + general text
@@ -66,12 +66,12 @@
;; History:
;;
-;; Since version 5.10: Changes are listed in the general org-mode docs.
+;; Since version 5.10: Changes are listed in the general Org docs.
;;
-;; Version 5.09;; + Version number synchronization with Org-mode.
+;; Version 5.09;; + Version number synchronization with Org mode.
;;
;; Version 0.25
-;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch)
+;; + made compatible with Org 4.70 (thanks to Carsten for the patch)
;;
;; Version 0.24
;; + minor changes to the table menu
@@ -81,7 +81,7 @@
;; + context menu support for org-agenda-undo & org-sort-entries
;;
;; Version 0.22
-;; + handles undo support for the agenda buffer (requires org-mode >=4.58)
+;; + handles undo support for the agenda buffer (requires Org >=4.58)
;;
;; Version 0.21
;; + selected text activates its context menu
@@ -105,7 +105,7 @@
;; + added support for checkboxes
;;
;; Version 0.15
-;; + org-mode now works with the Agenda buffer as well
+;; + Org now works with the Agenda buffer as well
;;
;; Version 0.14
;; + added a menu option that converts plain list items to outline items
@@ -125,7 +125,7 @@
;;
;; Version 0.10
;; + added a menu option to remove highlights
-;; + compatible with org-mode 4.21 now
+;; + compatible with Org 4.21 now
;;
;; Version 0.08:
;; + trees can be moved/promoted/demoted by dragging with the right
@@ -136,8 +136,8 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'org)
+(require 'cl-lib)
(defvar org-agenda-allow-remote-undo)
(defvar org-agenda-undo-list)
@@ -149,6 +149,8 @@
(declare-function org-agenda-earlier "org-agenda" (arg))
(declare-function org-agenda-later "org-agenda" (arg))
+(defvar org-mouse-main-buffer nil
+ "Active buffer for mouse operations.")
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
"Regular expression that matches a plain list.")
(defvar org-mouse-direct t
@@ -191,15 +193,14 @@ Changing this variable requires a restart of Emacs to get activated."
(interactive)
(end-of-line)
(skip-chars-backward "\t ")
- (when (org-looking-back ":[A-Za-z]+:" (line-beginning-position))
+ (when (looking-back ":[A-Za-z]+:" (line-beginning-position))
(skip-chars-backward ":A-Za-z")
(skip-chars-backward "\t ")))
-(defvar org-mouse-context-menu-function nil
+(defvar-local org-mouse-context-menu-function nil
"Function to create the context menu.
The value of this variable is the function invoked by
`org-mouse-context-menu' as the context menu.")
-(make-variable-buffer-local 'org-mouse-context-menu-function)
(defun org-mouse-show-context-menu (event prefix)
"Invoke the context menu.
@@ -220,7 +221,7 @@ this function is called. Otherwise, the current major mode menu is used."
(funcall org-mouse-context-menu-function event)
(if (fboundp 'mouse-menu-major-mode-map)
(popup-menu (mouse-menu-major-mode-map) event prefix)
- (org-no-warnings ; don't warn about fallback, obsolete since 23.1
+ (with-no-warnings ; don't warn about fallback, obsolete since 23.1
(mouse-major-mode-menu event prefix)))))
(setq this-command 'mouse-save-then-kill)
(mouse-save-then-kill event)))
@@ -257,7 +258,7 @@ If the point is at the :beginning (`org-mouse-line-position') of the line,
insert the new heading before the current line. Otherwise, insert it
after the current heading."
(interactive)
- (case (org-mouse-line-position)
+ (cl-case (org-mouse-line-position)
(:beginning (beginning-of-line)
(org-insert-heading))
(t (org-mouse-next-heading)
@@ -313,10 +314,10 @@ nor a function, elements of KEYWORDS are used directly."
(just-one-space))
(defvar org-mouse-rest)
-(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
- literal string subexp)
+(defun org-mouse-replace-match-and-surround
+ (_newtext &optional _fixedcase _literal _string subexp)
"The same as `replace-match', but surrounds the replacement with spaces."
- (apply 'replace-match org-mouse-rest)
+ (apply #'replace-match org-mouse-rest)
(save-excursion
(goto-char (match-beginning (or subexp 0)))
(just-one-space)
@@ -406,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(> (match-end 0) point))))))
(defun org-mouse-priority-list ()
- (loop for priority from ?A to org-lowest-priority
- collect (char-to-string priority)))
+ (cl-loop for priority from ?A to org-lowest-priority
+ collect (char-to-string priority)))
(defun org-mouse-todo-menu (state)
"Create the menu with TODO keywords."
@@ -459,33 +460,33 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(insert " [ ] "))))
(defun org-mouse-agenda-type (type)
- (case type
- ('tags "Tags: ")
- ('todo "TODO: ")
- ('tags-tree "Tags tree: ")
- ('todo-tree "TODO tree: ")
- ('occur-tree "Occur tree: ")
- (t "Agenda command ???")))
+ (pcase type
+ (`tags "Tags: ")
+ (`todo "TODO: ")
+ (`tags-tree "Tags tree: ")
+ (`todo-tree "TODO tree: ")
+ (`occur-tree "Occur tree: ")
+ (_ "Agenda command ???")))
(defun org-mouse-list-options-menu (alloptions &optional function)
(let ((options (save-match-data
(split-string (match-string-no-properties 1)))))
(print options)
- (loop for name in alloptions
- collect
- (vector name
- `(progn
- (replace-match
- (mapconcat 'identity
- (sort (if (member ',name ',options)
- (delete ',name ',options)
- (cons ',name ',options))
- 'string-lessp)
- " ")
- nil nil nil 1)
- (when (functionp ',function) (funcall ',function)))
- :style 'toggle
- :selected (and (member name options) t)))))
+ (cl-loop for name in alloptions
+ collect
+ (vector name
+ `(progn
+ (replace-match
+ (mapconcat 'identity
+ (sort (if (member ',name ',options)
+ (delete ',name ',options)
+ (cons ',name ',options))
+ 'string-lessp)
+ " ")
+ nil nil nil 1)
+ (when (functionp ',function) (funcall ',function)))
+ :style 'toggle
+ :selected (and (member name options) t)))))
(defun org-mouse-clip-text (text maxlength)
(if (> (length text) maxlength)
@@ -555,12 +556,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(let ((contextdata (assq context contextlist)))
(when contextdata
(save-excursion
- (goto-char (second contextdata))
- (re-search-forward ".*" (third contextdata))))))
+ (goto-char (nth 1 contextdata))
+ (re-search-forward ".*" (nth 2 contextdata))))))
(defun org-mouse-for-each-item (funct)
- ;; Functions called by `org-apply-on-list' need an argument
- (let ((wrap-fun (lambda (c) (funcall funct))))
+ ;; Functions called by `org-apply-on-list' need an argument.
+ (let ((wrap-fun (lambda (_) (funcall funct))))
(when (ignore-errors (goto-char (org-in-item-p)))
(save-excursion (org-apply-on-list wrap-fun nil)))))
@@ -571,14 +572,14 @@ This means, between the beginning of line and the point."
(skip-chars-backward " \t*") (bolp)))
(defun org-mouse-insert-item (text)
- (case (org-mouse-line-position)
- (:beginning ; insert before
+ (cl-case (org-mouse-line-position)
+ (:beginning ; insert before
(beginning-of-line)
(looking-at "[ \t]*")
(open-line 1)
- (org-indent-to-column (- (match-end 0) (match-beginning 0)))
+ (indent-to-column (- (match-end 0) (match-beginning 0)))
(insert "+ "))
- (:middle ; insert after
+ (:middle ; insert after
(end-of-line)
(newline t)
(indent-relative)
@@ -586,7 +587,7 @@ This means, between the beginning of line and the point."
(:end ; insert text here
(skip-chars-backward " \t")
(kill-region (point) (point-at-eol))
- (unless (org-looking-back org-mouse-punctuation (line-beginning-position))
+ (unless (looking-back org-mouse-punctuation (line-beginning-position))
(insert (concat org-mouse-punctuation " ")))))
(insert text)
(beginning-of-line))
@@ -644,8 +645,8 @@ This means, between the beginning of line and the point."
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
- (org-looking-back " \\|\t" (- (point) 2)
- (line-beginning-position))))
+ (looking-back " \\|\t" (- (point) 2)
+ (line-beginning-position))))
(org-mouse-popup-global-menu))
((funcall get-context :checkbox)
(popup-menu
@@ -737,13 +738,13 @@ This means, between the beginning of line and the point."
["- 1 Month" (org-timestamp-change -1 'month)])))
((funcall get-context :table-special)
(let ((mdata (match-data)))
- (incf (car mdata) 2)
+ (cl-incf (car mdata) 2)
(store-match-data mdata))
(message "match: %S" (match-string 0))
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
'(" " "!" "^" "_" "$" "#" "*" "'") 0
(lambda (mark)
- (case (string-to-char mark)
+ (cl-case (string-to-char mark)
(? "( ) Nothing Special")
(?! "(!) Column Names")
(?^ "(^) Field Names Above")
@@ -914,7 +915,7 @@ This means, between the beginning of line and the point."
((org-footnote-at-reference-p) nil)
(t ad-do-it))))))
-(defun org-mouse-move-tree-start (event)
+(defun org-mouse-move-tree-start (_event)
(interactive "e")
(message "Same line: promote/demote, (***):move before, (text): make a child"))
@@ -993,7 +994,7 @@ This means, between the beginning of line and the point."
(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'.
(defun org-mouse-do-remotely (command)
- ; (org-agenda-check-no-diary)
+ ;; (org-agenda-check-no-diary)
(when (get-text-property (point) 'org-marker)
(let* ((anticol (- (point-at-eol) (point)))
(marker (get-text-property (point) 'org-marker))
@@ -1031,7 +1032,7 @@ This means, between the beginning of line and the point."
(org-agenda-change-all-lines newhead hdmarker 'fixface))))
t))))
-(defun org-mouse-agenda-context-menu (&optional event)
+(defun org-mouse-agenda-context-menu (&optional _event)
(or (org-mouse-do-remotely 'org-mouse-context-menu)
(popup-menu
'("Agenda"
@@ -1093,17 +1094,17 @@ This means, between the beginning of line and the point."
; (setq org-agenda-mode-hook nil)
(defvar org-agenda-mode-map)
(add-hook 'org-agenda-mode-hook
- #'(lambda ()
- (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
- (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
- (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
- (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
- (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
- (org-defkey org-agenda-mode-map [drag-mouse-3]
- #'(lambda (event) (interactive "e")
- (case (org-mouse-get-gesture event)
- (:left (org-agenda-earlier 1))
- (:right (org-agenda-later 1)))))))
+ (lambda ()
+ (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
+ (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
+ (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
+ (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
+ (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
+ (org-defkey org-agenda-mode-map [drag-mouse-3]
+ (lambda (event) (interactive "e")
+ (cl-case (org-mouse-get-gesture event)
+ (:left (org-agenda-earlier 1))
+ (:right (org-agenda-later 1)))))))
(provide 'org-mouse)
diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el
index e27492c..f3b498e 100644
--- a/lisp/org-pcomplete.el
+++ b/lisp/org-pcomplete.el
@@ -1,4 +1,4 @@
-;;; org-pcomplete.el --- In-buffer completion code
+;;; org-pcomplete.el --- In-buffer Completion Code -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
;;
@@ -27,21 +27,17 @@
;;;; Require other packages
-(eval-when-compile
- (require 'cl))
-
(require 'org-macs)
(require 'org-compat)
(require 'pcomplete)
-(declare-function org-split-string "org" (string &optional separators))
-(declare-function org-make-org-heading-search-string "org"
- (&optional string))
+(declare-function org-make-org-heading-search-string "org" (&optional string))
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-tags "org" ())
(declare-function org-buffer-property-keys "org"
- (&optional include-specials include-defaults include-columns))
-(declare-function org-entry-properties "org" (&optional pom which specific))
+ (&optional specials defaults columns ignore-malformed))
+(declare-function org-entry-properties "org" (&optional pom which))
+(declare-function org-tag-alist-to-string "org" (alist &optional skip-key))
;;;; Customization variables
@@ -52,12 +48,13 @@
(defvar org-drawer-regexp)
(defvar org-property-re)
+(defvar org-current-tag-alist)
(defun org-thing-at-point ()
"Examine the thing at point and let the caller know what it is.
The return value is a string naming the thing at point."
(let ((beg1 (save-excursion
- (skip-chars-backward (org-re "[:alnum:]-_@"))
+ (skip-chars-backward "[:alnum:]-_@")
(point)))
(beg (save-excursion
(skip-chars-backward "a-zA-Z0-9-_:$")
@@ -93,10 +90,10 @@ The return value is a string naming the thing at point."
(skip-chars-backward "[ \t\n]")
;; org-drawer-regexp matches a whole line but while
;; looking-back, we just ignore trailing whitespaces
- (or (org-looking-back (substring org-drawer-regexp 0 -1)
- (line-beginning-position))
- (org-looking-back org-property-re
- (line-beginning-position)))))
+ (or (looking-back (substring org-drawer-regexp 0 -1)
+ (line-beginning-position))
+ (looking-back org-property-re
+ (line-beginning-position)))))
(cons "prop" nil))
((and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*)))
@@ -142,7 +139,6 @@ When completing for #+STARTUP, for example, this function returns
pcomplete-default-completion-function))))
(defvar org-options-keywords) ; From org.el
-(defvar org-element-block-name-alist) ; From org-element.el
(defvar org-element-affiliated-keywords) ; From org-element.el
(declare-function org-get-export-keywords "org" ())
(defun pcomplete/org-mode/file-option ()
@@ -155,16 +151,19 @@ When completing for #+STARTUP, for example, this function returns
(mapcar (lambda (keyword) (concat keyword ": "))
org-element-affiliated-keywords)
(let (block-names)
- (dolist (block-info org-element-block-name-alist block-names)
- (let ((name (car block-info)))
- (push (format "END_%s" name) block-names)
- (push (concat "BEGIN_"
- name
- ;; Since language is compulsory in
- ;; source blocks, add a space.
- (and (equal name "SRC") " "))
- block-names)
- (push (format "ATTR_%s: " name) block-names))))
+ (dolist (name
+ '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC"
+ "VERSE")
+ block-names)
+ (push (format "END_%s" name) block-names)
+ (push (concat "BEGIN_"
+ name
+ ;; Since language is compulsory in
+ ;; export blocks source blocks, add
+ ;; a space.
+ (and (member name '("EXPORT" "SRC")) " "))
+ block-names)
+ (push (format "ATTR_%s: " name) block-names)))
(mapcar (lambda (keyword) (concat keyword ": "))
(org-get-export-keywords))))
(substring pcomplete-stub 2)))
@@ -235,20 +234,10 @@ When completing for #+STARTUP, for example, this function returns
(setq opts (delete "showstars" opts)))))
opts))))
-(defvar org-tag-alist)
(defun pcomplete/org-mode/file-option/tags ()
"Complete arguments for the #+TAGS file option."
(pcomplete-here
- (list
- (mapconcat (lambda (x)
- (cond
- ((eq :startgroup (car x)) "{")
- ((eq :endgroup (car x)) "}")
- ((eq :grouptags (car x)) ":")
- ((eq :newline (car x)) "\\n")
- ((cdr x) (format "%s(%c)" (car x) (cdr x)))
- (t (car x))))
- org-tag-alist " "))))
+ (list (org-tag-alist-to-string org-current-tag-alist))))
(defun pcomplete/org-mode/file-option/title ()
"Complete arguments for the #+TITLE file option."
@@ -260,7 +249,7 @@ When completing for #+STARTUP, for example, this function returns
(buffer-name (buffer-base-buffer)))))))
-(declare-function org-export-backend-options "org-export" (cl-x))
+(declare-function org-export-backend-options "ox" (cl-x) t)
(defun pcomplete/org-mode/file-option/options ()
"Complete arguments for the #+OPTIONS file option."
(while (pcomplete-here
@@ -273,7 +262,7 @@ When completing for #+STARTUP, for example, this function returns
"|:" "tags:" "tasks:" "<:" "todo:")
;; OPTION items from registered back-ends.
(let (items)
- (dolist (backend (org-bound-and-true-p
+ (dolist (backend (bound-and-true-p
org-export-registered-backends))
(dolist (option (org-export-backend-options backend))
(let ((item (nth 2 option)))
@@ -285,7 +274,7 @@ When completing for #+STARTUP, for example, this function returns
(while (pcomplete-here
(pcomplete-uniqify-list
(mapcar (lambda (item) (format "%s:" (car item)))
- (org-bound-and-true-p org-html-infojs-opts-table))))))
+ (bound-and-true-p org-html-infojs-opts-table))))))
(defun pcomplete/org-mode/file-option/bind ()
"Complete arguments for the #+BIND file option, which are variable names."
@@ -333,19 +322,16 @@ This needs more work, to handle headings with lots of spaces in them."
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
-(defvar org-tag-alist)
(defun pcomplete/org-mode/tag ()
"Complete a tag name. Omit tags already set."
(while (pcomplete-here
- (mapcar (lambda (x)
- (concat x ":"))
+ (mapcar (lambda (x) (concat x ":"))
(let ((lst (pcomplete-uniqify-list
- (or (remove
+ (or (remq
nil
- (mapcar (lambda (x)
- (and (stringp (car x)) (car x)))
- org-tag-alist))
- (mapcar 'car (org-get-buffer-tags))))))
+ (mapcar (lambda (x) (org-string-nw-p (car x)))
+ org-current-tag-alist))
+ (mapcar #'car (org-get-buffer-tags))))))
(dolist (tag (org-get-tags))
(setq lst (delete tag lst)))
lst))
@@ -359,7 +345,7 @@ This needs more work, to handle headings with lots of spaces in them."
(concat x ": "))
(let ((lst (pcomplete-uniqify-list
(copy-sequence
- (org-buffer-property-keys nil t t)))))
+ (org-buffer-property-keys nil t t t)))))
(dolist (prop (org-entry-properties))
(setq lst (delete (car prop) lst)))
lst))
diff --git a/lisp/org-plot.el b/lisp/org-plot.el
index 9dbf882..6b51368 100644
--- a/lisp/org-plot.el
+++ b/lisp/org-plot.el
@@ -1,4 +1,4 @@
-;;; org-plot.el --- Support for plotting from Org-mode
+;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;;
@@ -25,14 +25,14 @@
;; Borrows ideas and a couple of lines of code from org-exp.el.
-;; Thanks to the org-mode mailing list for testing and implementation
-;; and feature suggestions
+;; Thanks to the Org mailing list for testing and implementation and
+;; feature suggestions
;;; Code:
+
+(require 'cl-lib)
(require 'org)
(require 'org-table)
-(eval-when-compile
- (require 'cl))
(declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg))
(declare-function gnuplot-mode "ext:gnuplot" ())
@@ -49,41 +49,39 @@
(defun org-plot/add-options-to-plist (p options)
"Parse an OPTIONS line and set values in the property list P.
Returns the resulting property list."
- (let (o)
- (when options
- (let ((op '(("type" . :plot-type)
- ("script" . :script)
- ("line" . :line)
- ("set" . :set)
- ("title" . :title)
- ("ind" . :ind)
- ("deps" . :deps)
- ("with" . :with)
- ("file" . :file)
- ("labels" . :labels)
- ("map" . :map)
- ("timeind" . :timeind)
- ("timefmt" . :timefmt)))
- (multiples '("set" "line"))
- (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
- (start 0)
- o)
- (while (setq o (pop op))
- (if (member (car o) multiples) ;; keys with multiple values
- (while (string-match
- (concat (regexp-quote (car o)) regexp)
- options start)
- (setq start (match-end 0))
- (setq p (plist-put p (cdr o)
- (cons (car (read-from-string
- (match-string 1 options)))
- (plist-get p (cdr o)))))
- p)
- (if (string-match (concat (regexp-quote (car o)) regexp)
- options)
- (setq p (plist-put p (cdr o)
- (car (read-from-string
- (match-string 1 options)))))))))))
+ (when options
+ (let ((op '(("type" . :plot-type)
+ ("script" . :script)
+ ("line" . :line)
+ ("set" . :set)
+ ("title" . :title)
+ ("ind" . :ind)
+ ("deps" . :deps)
+ ("with" . :with)
+ ("file" . :file)
+ ("labels" . :labels)
+ ("map" . :map)
+ ("timeind" . :timeind)
+ ("timefmt" . :timefmt)))
+ (multiples '("set" "line"))
+ (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
+ (start 0))
+ (dolist (o op)
+ (if (member (car o) multiples) ;; keys with multiple values
+ (while (string-match
+ (concat (regexp-quote (car o)) regexp)
+ options start)
+ (setq start (match-end 0))
+ (setq p (plist-put p (cdr o)
+ (cons (car (read-from-string
+ (match-string 1 options)))
+ (plist-get p (cdr o)))))
+ p)
+ (if (string-match (concat (regexp-quote (car o)) regexp)
+ options)
+ (setq p (plist-put p (cdr o)
+ (car (read-from-string
+ (match-string 1 options))))))))))
p)
(defun org-plot/goto-nearest-table ()
@@ -119,10 +117,9 @@ will be added. Returns the resulting property list."
Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
(with-temp-file
data-file
- (make-local-variable 'org-plot-timestamp-fmt)
- (setq org-plot-timestamp-fmt (or
- (plist-get params :timefmt)
- "%Y-%m-%d-%H:%M:%S"))
+ (setq-local org-plot-timestamp-fmt (or
+ (plist-get params :timefmt)
+ "%Y-%m-%d-%H:%M:%S"))
(insert (orgtbl-to-generic
table
(org-combine-plists
@@ -140,7 +137,7 @@ and dependant variables."
(deps (if (plist-member params :deps)
(mapcar (lambda (val) (- val 1)) (plist-get params :deps))
(let (collector)
- (dotimes (col (length (first table)))
+ (dotimes (col (length (nth 0 table)))
(setf collector (cons col collector)))
collector)))
(counter 0)
@@ -158,7 +155,7 @@ and dependant variables."
table)))
;; write table to gnuplot grid datafile format
(with-temp-file data-file
- (let ((num-rows (length table)) (num-cols (length (first table)))
+ (let ((num-rows (length table)) (num-cols (length (nth 0 table)))
(gnuplot-row (lambda (col row value)
(setf col (+ 1 col)) (setf row (+ 1 row))
(format "%f %f %f\n%f %f %f\n"
@@ -202,10 +199,10 @@ manner suitable for prepending to a user-specified script."
(x-labels (plist-get params :xlabels))
(y-labels (plist-get params :ylabels))
(plot-str "'%s' using %s%d%s with %s title '%s'")
- (plot-cmd (case type
- ('2d "plot")
- ('3d "splot")
- ('grid "splot")))
+ (plot-cmd (pcase type
+ (`2d "plot")
+ (`3d "splot")
+ (`grid "splot")))
(script "reset")
;; ats = add-to-script
(ats (lambda (line) (setf script (concat script "\n" line))))
@@ -213,15 +210,15 @@ manner suitable for prepending to a user-specified script."
(when file ; output file
(funcall ats (format "set term %s" (file-name-extension file)))
(funcall ats (format "set output '%s'" file)))
- (case type ; type
- (2d ())
- (3d (when map (funcall ats "set map")))
- (grid (if map (funcall ats "set pm3d map") (funcall ats "set pm3d"))))
+ (pcase type ; type
+ (`2d ())
+ (`3d (when map (funcall ats "set map")))
+ (`grid (funcall ats (if map "set pm3d map" "set pm3d"))))
(when title (funcall ats (format "set title '%s'" title))) ; title
(mapc ats lines) ; line
(dolist (el sets) (funcall ats (format "set %s" el))) ; set
;; Unless specified otherwise, values are TAB separated.
- (unless (org-string-match-p "^set datafile separator" script)
+ (unless (string-match-p "^set datafile separator" script)
(funcall ats "set datafile separator \"\\t\""))
(when x-labels ; x labels (xtics)
(funcall ats
@@ -241,26 +238,27 @@ manner suitable for prepending to a user-specified script."
(or timefmt ; timefmt passed to gnuplot
"%Y-%m-%d-%H:%M:%S") "\"")))
(unless preface
- (case type ; plot command
- (2d (dotimes (col num-cols)
- (unless (and (eq type '2d)
- (or (and ind (equal (1+ col) ind))
- (and deps (not (member (1+ col) deps)))))
- (setf plot-lines
- (cons
- (format plot-str data-file
- (or (and ind (> ind 0)
- (not text-ind)
- (format "%d:" ind)) "")
- (1+ col)
- (if text-ind (format ":xticlabel(%d)" ind) "")
- with
- (or (nth col col-labels) (format "%d" (1+ col))))
- plot-lines)))))
- (3d
+ (pcase type ; plot command
+ (`2d (dotimes (col num-cols)
+ (unless (and (eq type '2d)
+ (or (and ind (equal (1+ col) ind))
+ (and deps (not (member (1+ col) deps)))))
+ (setf plot-lines
+ (cons
+ (format plot-str data-file
+ (or (and ind (> ind 0)
+ (not text-ind)
+ (format "%d:" ind)) "")
+ (1+ col)
+ (if text-ind (format ":xticlabel(%d)" ind) "")
+ with
+ (or (nth col col-labels)
+ (format "%d" (1+ col))))
+ plot-lines)))))
+ (`3d
(setq plot-lines (list (format "'%s' matrix with %s title ''"
data-file with))))
- (grid
+ (`grid
(setq plot-lines (list (format "'%s' with %s title ''"
data-file with)))))
(funcall ats
@@ -291,24 +289,25 @@ line directly before or after the table."
;; collect table and table information
(let* ((data-file (make-temp-file "org-plot"))
(table (org-table-to-lisp))
- (num-cols (length (if (eq (first table) 'hline) (second table)
- (first table)))))
+ (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table)
+ (nth 0 table)))))
(run-with-idle-timer 0.1 nil #'delete-file data-file)
(while (eq 'hline (car table)) (setf table (cdr table)))
(when (eq (cadr table) 'hline)
- (setf params (plist-put params :labels (first table))) ; headers to labels
+ (setf params
+ (plist-put params :labels (nth 0 table))) ; headers to labels
(setf table (delq 'hline (cdr table)))) ; clean non-data from table
;; Collect options.
(save-excursion (while (and (equal 0 (forward-line -1))
(looking-at "[[:space:]]*#\\+"))
(setf params (org-plot/collect-options params))))
;; Dump table to datafile (very different for grid).
- (case (plist-get params :plot-type)
- (2d (org-plot/gnuplot-to-data table data-file params))
- (3d (org-plot/gnuplot-to-data table data-file params))
- (grid (let ((y-labels (org-plot/gnuplot-to-grid-data
- table data-file params)))
- (when y-labels (plist-put params :ylabels y-labels)))))
+ (pcase (plist-get params :plot-type)
+ (`2d (org-plot/gnuplot-to-data table data-file params))
+ (`3d (org-plot/gnuplot-to-data table data-file params))
+ (`grid (let ((y-labels (org-plot/gnuplot-to-grid-data
+ table data-file params)))
+ (when y-labels (plist-put params :ylabels y-labels)))))
;; Check for timestamp ind column.
(let ((ind (1- (plist-get params :ind))))
(when (and (>= ind 0) (eq '2d (plist-get params :plot-type)))
diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el
index 2f2c54b..4ffa030 100644
--- a/lisp/org-protocol.el
+++ b/lisp/org-protocol.el
@@ -1,4 +1,4 @@
-;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
+;;; org-protocol.el --- Intercept Calls from Emacsclient to Trigger Custom Actions -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;;
@@ -49,7 +49,7 @@
;; 4.) Try this from the command line (adjust the URL as needed):
;;
;; $ emacsclient \
-;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title
+;; org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
;;
;; 5.) Optionally add custom sub-protocols and handlers:
;;
@@ -60,7 +60,7 @@
;;
;; A "sub-protocol" will be found in URLs like this:
;;
-;; org-protocol://sub-protocol://data
+;; org-protocol://sub-protocol?key=val&key2=val2
;;
;; If it works, you can now setup other applications for using this feature.
;;
@@ -81,12 +81,12 @@
;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps
;; URLs to local filenames defined in `org-protocol-project-alist'.
;;
-;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and
+;; * `org-protocol-store-link' stores an Org link (if Org is present) and
;; pushes the browsers URL to the `kill-ring' for yanking. This handler is
;; triggered through the sub-protocol \"store-link\".
;;
;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If
-;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the
+;; Org is loaded, Emacs will pop-up a capture buffer and fill the
;; template with the data provided. I.e. the browser's URL is inserted as an
;; Org-link of which the page title will be the description part. If text
;; was select in the browser, that text will be the body of the entry.
@@ -94,20 +94,20 @@
;; You may use the same bookmark URL for all those standard handlers and just
;; adjust the sub-protocol used:
;;
-;; location.href='org-protocol://sub-protocol://'+
-;; encodeURIComponent(location.href)+'/'+
-;; encodeURIComponent(document.title)+'/'+
+;; location.href='org-protocol://sub-protocol?url='+
+;; encodeURIComponent(location.href)+'&title='+
+;; encodeURIComponent(document.title)+'&body='+
;; encodeURIComponent(window.getSelection())
;;
;; The handler for the sub-protocol \"capture\" detects an optional template
;; char that, if present, triggers the use of a special template.
;; Example:
;;
-;; location.href='org-protocol://sub-protocol://x/'+ ...
+;; location.href='org-protocol://capture?template=x'+ ...
;;
-;; use template ?x.
+;; uses template ?x.
;;
-;; Note, that using double slashes is optional from org-protocol.el's point of
+;; Note that using double slashes is optional from org-protocol.el's point of
;; view because emacsclient squashes the slashes to one.
;;
;;
@@ -116,25 +116,12 @@
;;; Code:
(require 'org)
-(eval-when-compile
- (require 'cl))
-(declare-function org-publish-get-project-from-filename "org-publish"
+(declare-function org-publish-get-project-from-filename "ox-publish"
(filename &optional up))
(declare-function server-edit "server" (&optional arg))
-(define-obsolete-function-alias
- 'org-protocol-unhex-compound 'org-link-unescape-compound
- "2011-02-17")
-
-(define-obsolete-function-alias
- 'org-protocol-unhex-string 'org-link-unescape
- "2011-02-17")
-
-(define-obsolete-function-alias
- 'org-protocol-unhex-single-byte-sequence
- 'org-link-unescape-single-byte-sequence
- "2011-02-17")
+(defvar org-capture-link-is-already-stored)
(defgroup org-protocol nil
"Intercept calls from emacsclient to trigger custom actions.
@@ -225,27 +212,36 @@ Each element of this list must be of the form:
(module-name :protocol protocol :function func :kill-client nil)
-protocol - protocol to detect in a filename without trailing colon and slashes.
- See rfc1738 section 2.1 for more on this.
- If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol'
- will search filenames for \"org-protocol:/my-protocol:/\"
- and trigger your action for every match. `org-protocol' is defined in
- `org-protocol-the-protocol'. Double and triple slashes are compressed
- to one by emacsclient.
-
-function - function that handles requests with protocol and takes exactly one
- argument: the filename with all protocols stripped. If the function
- returns nil, emacsclient and -server do nothing. Any non-nil return
- value is considered a valid filename and thus passed to the server.
-
- `org-protocol.el provides some support for handling those filenames,
- if you stay with the conventions used for the standard handlers in
- `org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
+protocol - protocol to detect in a filename without trailing
+ colon and slashes. See rfc1738 section 2.1 for more
+ on this. If you define a protocol \"my-protocol\",
+ `org-protocol-check-filename-for-protocol' will search
+ filenames for \"org-protocol:/my-protocol\" and
+ trigger your action for every match. `org-protocol'
+ is defined in `org-protocol-the-protocol'. Double and
+ triple slashes are compressed to one by emacsclient.
+
+function - function that handles requests with protocol and takes
+ one argument. If a new-style link (key=val&key2=val2)
+ is given, the argument will be a property list with
+ the values from the link. If an old-style link is
+ given (val1/val2), the argument will be the filename
+ with all protocols stripped.
+
+ If the function returns nil, emacsclient and -server
+ do nothing. Any non-nil return value is considered a
+ valid filename and thus passed to the server.
+
+ `org-protocol.el' provides some support for handling
+ old-style filenames, if you follow the conventions
+ used for the standard handlers in
+ `org-protocol-protocol-alist-default'. See
+ `org-protocol-parse-parameters'.
kill-client - If t, kill the client immediately, once the sub-protocol is
detected. This is necessary for actions that can be interrupted by
- `C-g' to avoid dangling emacsclients. Note, that all other command
- line arguments but the this one will be discarded, greedy handlers
+ `C-g' to avoid dangling emacsclients. Note that all other command
+ line arguments but the this one will be discarded. Greedy handlers
still receive the whole list of arguments though.
Here is an example:
@@ -269,7 +265,7 @@ string with two characters."
(defcustom org-protocol-data-separator "/+\\|\\?"
"The default data separator to use.
- This should be a single regexp string."
+This should be a single regexp string."
:group 'org-protocol
:version "24.4"
:package-version '(Org . "8.0")
@@ -278,21 +274,20 @@ string with two characters."
;;; Helper functions:
(defun org-protocol-sanitize-uri (uri)
- "emacsclient compresses double and triple slashes.
-Slashes are sanitized to double slashes here."
+ "Sanitize slashes to double-slashes in URI.
+Emacsclient compresses double and triple slashes."
(when (string-match "^\\([a-z]+\\):/" uri)
(let* ((splitparts (split-string uri "/+")))
(setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
uri)
(defun org-protocol-split-data (data &optional unhexify separator)
- "Split what an org-protocol handler function gets as only argument.
-DATA is that one argument. DATA is split at each occurrence of
-SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
-nil, assume \"/+\". The results of that splitting are returned
-as a list. If UNHEXIFY is non-nil, hex-decode each split part.
-If UNHEXIFY is a function, use that function to decode each split
-part."
+ "Split the DATA argument for an org-protocol handler function.
+If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY
+is a function, use that function to decode each split part. The
+string is split at each occurrence of SEPARATOR (regexp). If no
+SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The
+results of that splitting are returned as a list."
(let* ((sep (or separator "/+\\|\\?"))
(split-parts (split-string data sep)))
(if unhexify
@@ -302,23 +297,25 @@ part."
split-parts)))
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
- "Greedy handlers might receive a list like this from emacsclient:
- ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
-where \"/dir/\" is the absolute path to emacsclients working directory. This
+ "Transform PARAM-LIST into a flat list for greedy handlers.
+
+Greedy handlers might receive a list like this from emacsclient:
+\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
+where \"/dir/\" is the absolute path to emacsclient's working directory. This
function transforms it into a flat list using `org-protocol-flatten' and
transforms the elements of that list as follows:
-If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
+If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of
param-list.
-If replacement is string, replace the \"/dir/\" prefix with it.
+If REPLACEMENT is string, replace the \"/dir/\" prefix with it.
The first parameter, the one that contains the protocols, is always changed.
Everything up to the end of the protocols is stripped.
Note, that this function will always behave as if
`org-protocol-reverse-list-of-files' was set to t and the returned list will
-reflect that. I.e. emacsclients first parameter will be the first one in the
+reflect that. emacsclient's first parameter will be the first one in the
returned list."
(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
param-list
@@ -345,50 +342,106 @@ returned list."
ret)
l)))
-(defun org-protocol-flatten (l)
- "Greedy handlers might receive a list like this from emacsclient:
- ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
+(defun org-protocol-flatten (list)
+ "Transform LIST into a flat list.
+
+Greedy handlers might receive a list like this from emacsclient:
+\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
where \"/dir/\" is the absolute path to emacsclients working directory.
This function transforms it into a flat list."
- (if (null l) ()
- (if (listp l)
- (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
- (list l))))
-
+ (if (null list) ()
+ (if (listp list)
+ (append (org-protocol-flatten (car list)) (org-protocol-flatten (cdr list)))
+ (list list))))
+
+(defun org-protocol-parse-parameters (info &optional new-style default-order)
+ "Return a property list of parameters from INFO.
+If NEW-STYLE is non-nil, treat INFO as a query string (ex:
+url=URL&title=TITLE). If old-style links are used (ex:
+org-protocol://store-link/url/title), assign them to attributes
+following DEFAULT-ORDER.
+
+If no DEFAULT-ORDER is specified, return the list of values.
+
+If INFO is already a property list, return it unchanged."
+ (if (listp info)
+ info
+ (if new-style
+ (let ((data (org-protocol-convert-query-to-plist info))
+ result)
+ (while data
+ (setq result
+ (append
+ result
+ (list
+ (pop data)
+ (org-link-unescape (pop data))))))
+ result)
+ (let ((data (org-protocol-split-data info t org-protocol-data-separator)))
+ (if default-order
+ (org-protocol-assign-parameters data default-order)
+ data)))))
+
+(defun org-protocol-assign-parameters (data default-order)
+ "Return a property list of parameters from DATA.
+Key names are taken from DEFAULT-ORDER, which should be a list of
+symbols. If DEFAULT-ORDER is shorter than the number of values
+specified, the rest of the values are treated as :key value pairs."
+ (let (result)
+ (while default-order
+ (setq result
+ (append result
+ (list (pop default-order)
+ (pop data)))))
+ (while data
+ (setq result
+ (append result
+ (list (intern (concat ":" (pop data)))
+ (pop data)))))
+ result))
;;; Standard protocol handlers:
(defun org-protocol-store-link (fname)
- "Process an org-protocol://store-link:// style url.
+ "Process an org-protocol://store-link style url.
Additionally store a browser URL as an org link. Also pushes the
link's URL to the `kill-ring'.
+Parameters: url, title (optional), body (optional)
+
+Old-style links such as org-protocol://store-link://URL/TITLE are
+also recognized.
+
The location for a browser's bookmark has to look like this:
- javascript:location.href=\\='org-protocol://store-link://\\='+ \\
- encodeURIComponent(location.href)
- encodeURIComponent(document.title)+\\='/\\='+ \\
+ javascript:location.href = \\
+ \\='org-protocol://store-link?url=\\=' + \\
+ encodeURIComponent(location.href) + \\='&title=\\=' + \\
+ encodeURIComponent(document.title);
-Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
-could contain slashes and the location definitely will.
+Don't use `escape()'! Use `encodeURIComponent()' instead. The
+title of the page could contain slashes and the location
+definitely will.
The sub-protocol used to reach this function is set in
-`org-protocol-protocol-alist'."
- (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator))
- (uri (org-protocol-sanitize-uri (car splitparts)))
- (title (cadr splitparts))
- orglink)
- (if (boundp 'org-stored-links)
- (setq org-stored-links (cons (list uri title) org-stored-links)))
+`org-protocol-protocol-alist'.
+
+FNAME should be a property list. If not, an old-style link of the
+form URL/TITLE can also be used."
+ (let* ((splitparts (org-protocol-parse-parameters fname nil '(:url :title)))
+ (uri (org-protocol-sanitize-uri (plist-get splitparts :url)))
+ (title (plist-get splitparts :title)))
+ (when (boundp 'org-stored-links)
+ (push (list uri title) org-stored-links))
(kill-new uri)
(message "`%s' to insert new org-link, `%s' to insert `%s'"
- (substitute-command-keys"\\[org-insert-link]")
- (substitute-command-keys"\\[yank]")
+ (substitute-command-keys "`\\[org-insert-link]'")
+ (substitute-command-keys "`\\[yank]'")
uri))
nil)
(defun org-protocol-capture (info)
- "Process an org-protocol://capture:// style url.
+ "Process an org-protocol://capture style url with INFO.
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'.
@@ -396,16 +449,16 @@ The sub-protocol used to reach this function is set in
This function detects an URL, title and optional text, separated
by `/'. The location for a browser's bookmark looks like this:
- javascript:location.href=\\='org-protocol://capture://\\='+ \\
- encodeURIComponent(location.href)+\\='/\\=' \\
- encodeURIComponent(document.title)+\\='/\\='+ \\
+ javascript:location.href = \\='org-protocol://capture?url=\\='+ \\
+ encodeURIComponent(location.href) + \\='&title=\\=' \\
+ encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection())
By default, it uses the character `org-protocol-default-template-key',
which should be associated with a template in `org-capture-templates'.
-But you may prepend the encoded URL with a character and a slash like so:
+You may specify the template with a template= query parameter, like this:
- javascript:location.href=\\='org-protocol://capture://b/\\='+ ...
+ javascript:location.href = \\='org-protocol://capture?template=b\\='+ ...
Now template ?b will be used."
(if (and (boundp 'org-stored-links)
@@ -414,7 +467,7 @@ Now template ?b will be used."
nil)
(defun org-protocol-convert-query-to-plist (query)
- "Convert query string that is part of url to property list."
+ "Convert QUERY key=value pairs in the URL to a property list."
(if query
(apply 'append (mapcar (lambda (x)
(let ((c (split-string x "=")))
@@ -422,18 +475,26 @@ Now template ?b will be used."
(split-string query "&")))))
(defun org-protocol-do-capture (info)
- "Support `org-capture'."
- (let* ((parts (org-protocol-split-data info t org-protocol-data-separator))
- (template (or (and (>= 2 (length (car parts))) (pop parts))
+ "Perform the actual capture based on INFO."
+ (let* ((temp-parts (org-protocol-parse-parameters info))
+ (parts
+ (cond
+ ((and (listp info) (symbolp (car info))) info)
+ ((= (length (car temp-parts)) 1) ;; First parameter is exactly one character long
+ (org-protocol-assign-parameters temp-parts '(:template :url :title :body)))
+ (t
+ (org-protocol-assign-parameters temp-parts '(:url :title :body)))))
+ (template (or (plist-get parts :template)
org-protocol-default-template-key))
- (url (org-protocol-sanitize-uri (car parts)))
- (type (if (string-match "^\\([a-z]+\\):" url)
- (match-string 1 url)))
- (title (or (cadr parts) ""))
- (region (or (caddr parts) ""))
- (orglink (org-make-link-string
- url (if (string-match "[^[:space:]]" title) title url)))
- (query (or (org-protocol-convert-query-to-plist (cadddr parts)) ""))
+ (url (and (plist-get parts :url) (org-protocol-sanitize-uri (plist-get parts :url))))
+ (type (and url (if (string-match "^\\([a-z]+\\):" url)
+ (match-string 1 url))))
+ (title (or (plist-get parts :title) ""))
+ (region (or (plist-get parts :body) ""))
+ (orglink (if url
+ (org-make-link-string
+ url (if (string-match "[^[:space:]]" title) title url))
+ title))
(org-capture-link-is-already-stored t)) ;; avoid call to org-store-link
(setq org-stored-links
(cons (list url title) org-stored-links))
@@ -443,24 +504,24 @@ Now template ?b will be used."
:description title
:annotation orglink
:initial region
- :query query)
+ :query parts)
(raise-frame)
(funcall 'org-capture nil template)))
(defun org-protocol-open-source (fname)
- "Process an org-protocol://open-source:// style url.
+ "Process an org-protocol://open-source?url= style URL with FNAME.
Change a filename by mapping URLs to local filenames as set
in `org-protocol-project-alist'.
The location for a browser's bookmark should look like this:
- javascript:location.href=\\='org-protocol://open-source://\\='+ \\
+ javascript:location.href = \\='org-protocol://open-source?url=\\=' + \\
encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value
;; defaults to nil.
(let ((result nil)
- (f (org-link-unescape fname)))
+ (f (plist-get (org-protocol-parse-parameters fname nil '(:url)) :url)))
(catch 'result
(dolist (prolist org-protocol-project-alist)
(let* ((base-url (plist-get (cdr prolist) :base-url))
@@ -490,13 +551,12 @@ The location for a browser's bookmark should look like this:
(let ((rewrites (plist-get (cdr prolist) :rewrites)))
(when rewrites
(message "Rewrites found: %S" rewrites)
- (mapc
- (lambda (rewrite)
- "Try to match a rewritten URL and map it to a real file."
- ;; Compare redirects without suffix:
- (if (string-match (car rewrite) f2)
- (throw 'result (concat wdir (cdr rewrite)))))
- rewrites))))
+ (dolist (rewrite rewrites)
+ ;; Try to match a rewritten URL and map it to
+ ;; a real file. Compare redirects without
+ ;; suffix.
+ (when (string-match-p (car rewrite) f2)
+ (throw 'result (concat wdir (cdr rewrite))))))))
;; -- end of redirects --
(if (file-readable-p the-file)
@@ -509,22 +569,30 @@ The location for a browser's bookmark should look like this:
;;; Core functions:
-(defun org-protocol-check-filename-for-protocol (fname restoffiles client)
- "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname.
+(defun org-protocol-check-filename-for-protocol (fname restoffiles _client)
+ "Check if `org-protocol-the-protocol' and a valid protocol are used in FNAME.
Sub-protocols are registered in `org-protocol-protocol-alist' and
-`org-protocol-protocol-alist-default'.
-This is, how the matching is done:
+`org-protocol-protocol-alist-default'. This is how the matching is done:
- (string-match \"protocol:/+sub-protocol:/+\" ...)
+ (string-match \"protocol:/+sub-protocol\\\\(://\\\\|\\\\?\\\\)\" ...)
protocol and sub-protocol are regexp-quoted.
-If a matching protocol is found, the protocol is stripped from fname and the
-result is passed to the protocols function as the only parameter. If the
-function returns nil, the filename is removed from the list of filenames
-passed from emacsclient to the server.
-If the function returns a non nil value, that value is passed to the server
-as filename."
+Old-style links such as \"protocol://sub-protocol://param1/param2\" are
+also recognized.
+
+If a matching protocol is found, the protocol is stripped from
+fname and the result is passed to the protocol function as the
+first parameter. The second parameter will be non-nil if FNAME
+uses key=val&key2=val2-type arguments, or nil if FNAME uses
+val/val2-type arguments. If the function returns nil, the
+filename is removed from the list of filenames passed from
+emacsclient to the server. If the function returns a non-nil
+value, that value is passed to the server as filename.
+
+If the handler function is greedy, RESTOFFILES will also be passed to it.
+
+CLIENT is ignored."
(let ((sub-protocols (append org-protocol-protocol-alist
org-protocol-protocol-alist-default)))
(catch 'fname
@@ -532,21 +600,27 @@ as filename."
(when (string-match the-protocol fname)
(dolist (prolist sub-protocols)
(let ((proto (concat the-protocol
- (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+")))
+ (regexp-quote (plist-get (cdr prolist) :protocol)) "\\(:/+\\|\\?\\)")))
(when (string-match proto fname)
(let* ((func (plist-get (cdr prolist) :function))
(greedy (plist-get (cdr prolist) :greedy))
(split (split-string fname proto))
- (result (if greedy restoffiles (cadr split))))
+ (result (if greedy restoffiles (cadr split)))
+ (new-style (string= (match-string 1 fname) "?")))
(when (plist-get (cdr prolist) :kill-client)
(message "Greedy org-protocol handler. Killing client.")
(server-edit))
(when (fboundp func)
(unless greedy
- (throw 'fname (funcall func result)))
- (funcall func result)
+ (throw 'fname
+ (condition-case nil
+ (funcall func (org-protocol-parse-parameters result new-style))
+ (error
+ (warn "Please update your org protocol handler to deal with new-style links.")
+ (funcall func result)))))
+ ;; Greedy protocol handlers are responsible for parsing their own filenames
+ (funcall func result)
(throw 'fname t))))))))
- ;; (message "fname: %s" fname)
fname)))
(defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
@@ -572,7 +646,7 @@ as filename."
;;; Org specific functions:
(defun org-protocol-create-for-org ()
- "Create a org-protocol project for the current file's Org-mode project.
+ "Create a Org protocol project for the current file's project.
The visited file needs to be part of a publishing project in
`org-publish-project-alist' for this to work. The function
delegates most of the work to `org-protocol-create'."
@@ -580,8 +654,8 @@ delegates most of the work to `org-protocol-create'."
(require 'org-publish)
(let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
(if all (org-protocol-create (cdr all))
- (message "Not in an org-project. Did mean %s?"
- (substitute-command-keys"\\[org-protocol-create]")))))
+ (message "Not in an org-project. Did you mean `%s'?"
+ (substitute-command-keys "`\\[org-protocol-create]'")))))
(defun org-protocol-create (&optional project-plist)
"Create a new org-protocol project interactively.
@@ -600,19 +674,18 @@ the cdr of an element in `org-publish-project-alist', reuse
(working-suffix (if (plist-get project-plist :base-extension)
(concat "." (plist-get project-plist :base-extension))
".org"))
- (worglet-buffer nil)
(insert-default-directory t)
(minibuffer-allow-text-properties nil))
(setq base-url (read-string "Base URL of published content: " base-url nil base-url t))
- (if (not (string-match "\\/$" base-url))
- (setq base-url (concat base-url "/")))
+ (or (string-suffix-p "/" base-url)
+ (setq base-url (concat base-url "/")))
(setq working-dir
(expand-file-name
(read-directory-name "Local working directory: " working-dir working-dir t)))
- (if (not (string-match "\\/$" working-dir))
- (setq working-dir (concat working-dir "/")))
+ (or (string-suffix-p "/" working-dir)
+ (setq working-dir (concat working-dir "/")))
(setq strip-suffix
(read-string
diff --git a/lisp/org-rmail.el b/lisp/org-rmail.el
index d737aff..f24e25b 100644
--- a/lisp/org-rmail.el
+++ b/lisp/org-rmail.el
@@ -1,4 +1,4 @@
-;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode
+;;; org-rmail.el --- Support for Links to Rmail Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -24,9 +24,9 @@
;;
;;; Commentary:
-;; This file implements links to Rmail messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
+;; This file implements links to Rmail messages from within Org mode.
+;; Org mode loads this module by default - if this is not what you
+;; want, configure the variable `org-modules'.
;;; Code:
@@ -43,8 +43,7 @@
(defvar rmail-file-name) ; From rmail.el
;; Install the link type
-(org-add-link-type "rmail" 'org-rmail-open)
-(add-hook 'org-store-link-functions 'org-rmail-store-link)
+(org-link-set-parameters "rmail" :follow #'org-rmail-open :store #'org-rmail-store-link)
;; Implementation
(defun org-rmail-store-link ()
@@ -65,20 +64,11 @@
(to (mail-fetch-field "to"))
(subject (mail-fetch-field "subject"))
(date (mail-fetch-field "date"))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t)
- (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
desc link)
(org-store-link-props
- :type "rmail" :from from :to to
+ :type "rmail" :from from :to to :date date
:subject subject :message-id message-id)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
- (setq message-id (org-remove-angle-brackets message-id))
+ (setq message-id (org-unbracket-string "<" ">" message-id))
(setq desc (org-email-link-description))
(setq link (concat "rmail:" folder "#" message-id))
(org-add-link-props :link link :description desc)
diff --git a/lisp/org-src.el b/lisp/org-src.el
index b7bbf31..bcc93ac 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -1,4 +1,4 @@
-;;; org-src.el --- Source code examples in Org
+;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
;;
@@ -26,19 +26,21 @@
;;
;;; Commentary:
-;; This file contains the code dealing with source code examples in Org-mode.
+;; This file contains the code dealing with source code examples in
+;; Org mode.
;;; Code:
+(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
(require 'ob-keys)
(require 'ob-comint)
-(eval-when-compile (require 'cl))
(declare-function org-base-buffer "org" (buffer))
(declare-function org-do-remove-indentation "org" (&optional n))
(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-class "org-element" (datum &optional parent))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element"
(blob &optional types with-self))
@@ -47,13 +49,9 @@
(declare-function org-footnote-goto-definition "org-footnote"
(label &optional location))
(declare-function org-get-indentation "org" (&optional line))
-(declare-function org-pop-to-buffer-same-window "org-compat"
- (&optional buffer-or-name norecord label))
-(declare-function org-some "org" (pred seq))
(declare-function org-switch-to-buffer-other-window "org" (&rest args))
-(declare-function org-trim "org" (s))
+(declare-function org-trim "org" (s &optional keep-lead))
-(defvar org-element-all-elements)
(defvar org-inhibit-startup)
(defcustom org-edit-src-turn-on-auto-save nil
@@ -109,11 +107,12 @@ These are the regions where each line starts with a colon."
(defcustom org-src-preserve-indentation nil
"If non-nil preserve leading whitespace characters on export.
+\\<org-mode-map>
If non-nil leading whitespace characters in source code blocks
are preserved on export, and when switching between the org
buffer and the language mode edit buffer.
-When this variable is nil, after editing with \\[org-edit-src-code],
+When this variable is nil, after editing with `\\[org-edit-src-code]',
the minimum (across-lines) number of leading whitespace characters
are removed from all lines, and the code block is uniformly indented
according to the value of `org-edit-src-content-indentation'."
@@ -122,10 +121,12 @@ according to the value of `org-edit-src-content-indentation'."
(defcustom org-edit-src-content-indentation 2
"Indentation for the content of a source code block.
+
This should be the number of spaces added to the indentation of the #+begin
line in order to compute the indentation of the block content after
-editing it with \\[org-edit-src-code]. Has no effect if
-`org-src-preserve-indentation' is non-nil."
+editing it with `\\[org-edit-src-code]'.
+
+It has no effect if `org-src-preserve-indentation' is non-nil."
:group 'org-edit-structure
:type 'integer)
@@ -170,7 +171,7 @@ other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
"Hook run after Org switched a source code snippet to its Emacs mode.
\\<org-mode-map>
This hook will run:
-- when editing a source code snippet with \\[org-edit-special]
+- when editing a source code snippet with `\\[org-edit-special]'
- when formatting a source code snippet for export with htmlize.
You may want to use this hook for example to turn off `outline-minor-mode'
@@ -195,6 +196,28 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(string "Language name")
(symbol "Major mode"))))
+(defcustom org-src-block-faces nil
+ "Alist of faces to be used for source-block.
+Each element is a cell of the format
+
+ (\"language\" FACE)
+
+Where FACE is either a defined face or an anonymous face.
+
+For instance, the following value would color the background of
+emacs-lisp source blocks and python source blocks in purple and
+green, respectability.
+
+ \\='((\"emacs-lisp\" (:background \"#EEE2FF\"))
+ (\"python\" (:background \"#e5ffb8\")))"
+ :group 'org-edit-structure
+ :type '(repeat (list (string :tag "language")
+ (choice
+ (face :tag "Face")
+ (sexp :tag "Anonymous face"))))
+ :version "25.2"
+ :package-version '(Org . "9.0"))
+
(defcustom org-src-tab-acts-natively nil
"If non-nil, the effect of TAB in a code block is as if it were
issued in the language major mode buffer."
@@ -292,6 +315,12 @@ where BEG and END are buffer positions and CONTENTS is a string."
(search-forward "]")))
(end (or (org-element-property :contents-end datum) beg)))
(list beg end (buffer-substring-no-properties beg end))))
+ ((eq type 'inline-src-block)
+ (let ((beg (progn (goto-char (org-element-property :begin datum))
+ (search-forward "{" (line-end-position) t)))
+ (end (progn (goto-char (org-element-property :end datum))
+ (search-backward "}" (line-beginning-position) t))))
+ (list beg end (buffer-substring-no-properties beg end))))
((org-element-property :contents-begin datum)
(let ((beg (org-element-property :contents-begin datum))
(end (org-element-property :contents-end datum)))
@@ -351,7 +380,7 @@ spaces after it as being outside."
(org-with-wide-buffer
(goto-char (org-element-property :end datum))
(skip-chars-backward " \r\t\n")
- (if (memq (org-element-type datum) org-element-all-elements)
+ (if (eq (org-element-class datum) 'element)
(line-end-position)
(point))))))
@@ -370,7 +399,7 @@ Assume point is in the corresponding edit buffer."
(let ((ind (make-string indentation ?\s)))
(goto-char (point-min))
(while (not (eobp))
- (when (org-looking-at-p "[ \t]*\\S-") (insert ind))
+ (when (looking-at-p "[ \t]*\\S-") (insert ind))
(forward-line))))
(buffer-string))))
@@ -448,14 +477,14 @@ Leave point in edit buffer."
;; Transmit buffer-local variables for exit function. It must
;; be done after initializing major mode, as this operation
;; may reset them otherwise.
- (org-set-local 'org-src--from-org-mode org-mode-p)
- (org-set-local 'org-src--beg-marker beg)
- (org-set-local 'org-src--end-marker end)
- (org-set-local 'org-src--remote remote)
- (org-set-local 'org-src--block-indentation ind)
- (org-set-local 'org-src--preserve-indentation preserve-ind)
- (org-set-local 'org-src--overlay overlay)
- (org-set-local 'org-src--allow-write-back write-back)
+ (setq-local org-src--from-org-mode org-mode-p)
+ (setq-local org-src--beg-marker beg)
+ (setq-local org-src--end-marker end)
+ (setq-local org-src--remote remote)
+ (setq-local org-src--block-indentation ind)
+ (setq-local org-src--preserve-indentation preserve-ind)
+ (setq-local org-src--overlay overlay)
+ (setq-local org-src--allow-write-back write-back)
;; Start minor mode.
(org-src-mode)
;; Move mark and point in edit buffer to the corresponding
@@ -488,27 +517,36 @@ as `org-src-fontify-natively' is non-nil."
(when (fboundp lang-mode)
(let ((string (buffer-substring-no-properties start end))
(modified (buffer-modified-p))
- (org-buffer (current-buffer)) pos next)
+ (org-buffer (current-buffer)))
(remove-text-properties start end '(face nil))
(with-current-buffer
(get-buffer-create
- (concat " org-src-fontification:" (symbol-name lang-mode)))
- (delete-region (point-min) (point-max))
- (insert string " ") ;; so there's a final property change
+ (format " *org-src-fontification:%s*" lang-mode))
+ (erase-buffer)
+ ;; Add string and a final space to ensure property change.
+ (insert string " ")
(unless (eq major-mode lang-mode) (funcall lang-mode))
(org-font-lock-ensure)
- (setq pos (point-min))
- (while (setq next (next-single-property-change pos 'face))
- (put-text-property
- (+ start (1- pos)) (1- (+ start next)) 'face
- (get-text-property pos 'face) org-buffer)
- (setq pos next)))
+ (let ((pos (point-min)) next)
+ (while (setq next (next-property-change pos))
+ ;; Handle additional properties from font-lock, so as to
+ ;; preserve, e.g., composition.
+ (dolist (prop (cons 'face font-lock-extra-managed-props))
+ (let ((new-prop (get-text-property pos prop)))
+ (put-text-property
+ (+ start (1- pos)) (1- (+ start next)) prop new-prop
+ org-buffer)))
+ (setq pos next))))
+ ;; Add Org faces.
+ (let ((src-face (nth 1 (assoc-string lang org-src-block-faces t))))
+ (when (or (facep src-face) (listp src-face))
+ (font-lock-append-text-property start end 'face src-face))
+ (font-lock-append-text-property start end 'face 'org-block))
(add-text-properties
start end
'(font-lock-fontified t fontified t font-lock-multiline t))
(set-buffer-modified-p modified)))))
-
;;; Escape contents
@@ -560,7 +598,7 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
"Minor mode for language major mode buffers generated by Org.
\\<org-mode-map>
This minor mode is turned on in two situations:
- - when editing a source code snippet with \\[org-edit-special]
+ - when editing a source code snippet with `\\[org-edit-special]'
- when formatting a source code snippet for export with htmlize.
\\{org-src-mode-map}
@@ -568,14 +606,14 @@ This minor mode is turned on in two situations:
See also `org-src-mode-hook'."
nil " OrgSrc" nil
(when org-edit-src-persistent-message
- (org-set-local
- 'header-line-format
+ (setq-local
+ header-line-format
(substitute-command-keys
(if org-src--allow-write-back
- "Edit, then exit with \\[org-edit-src-exit] or abort with \
-\\[org-edit-src-abort]"
- "Exit with \\[org-edit-src-exit] or abort with \
-\\[org-edit-src-abort]"))))
+ "Edit, then exit with `\\[org-edit-src-exit]' or abort with \
+`\\[org-edit-src-abort]'"
+ "Exit with `\\[org-edit-src-exit]' or abort with \
+`\\[org-edit-src-abort]'"))))
;; Possibly activate various auto-save features (for the edit buffer
;; or the source buffer).
(when org-edit-src-turn-on-auto-save
@@ -600,22 +638,17 @@ See also `org-src-mode-hook'."
(setq org-src--auto-save-timer nil)))))))))
(defun org-src-mode-configure-edit-buffer ()
- (when (org-bound-and-true-p org-src--from-org-mode)
- (org-add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local)
- (if (org-bound-and-true-p org-src--allow-write-back)
+ (when (bound-and-true-p org-src--from-org-mode)
+ (add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local)
+ (if (bound-and-true-p org-src--allow-write-back)
(progn
(setq buffer-offer-save t)
(setq buffer-file-name
(concat (buffer-file-name (marker-buffer org-src--beg-marker))
- "[" (buffer-name) "]"))
- (if (featurep 'xemacs)
- (progn
- (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4
- (setq write-contents-hooks '(org-edit-src-save)))
- (setq write-contents-functions '(org-edit-src-save))))
+ "[" (buffer-name) "]")))
(setq buffer-read-only t))))
-(org-add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer)
+(add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer)
@@ -624,7 +657,7 @@ See also `org-src-mode-hook'."
(defun org-src-associate-babel-session (info)
"Associate edit buffer with comint session."
(interactive)
- (let ((session (cdr (assoc :session (nth 2 info)))))
+ (let ((session (cdr (assq :session (nth 2 info)))))
(and session (not (string= session "none"))
(org-babel-comint-buffer-livep session)
(let ((f (intern (format "org-babel-%s-associate-session"
@@ -635,16 +668,19 @@ See also `org-src-mode-hook'."
(when org-src--babel-info
(org-src-associate-babel-session org-src--babel-info)))
-(org-add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer)
+(add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer)
+
+
+;;; Public API
(defmacro org-src-do-at-code-block (&rest body)
- "Execute a command from an edit buffer in the Org mode buffer."
+ "Execute BODY from an edit buffer in the Org mode buffer."
+ (declare (debug (body)))
`(let ((beg-marker org-src--beg-marker))
(when beg-marker
(with-current-buffer (marker-buffer beg-marker)
(goto-char beg-marker)
,@body))))
-(def-edebug-spec org-src-do-at-code-block (body))
(defun org-src-do-key-sequence-at-code-block (&optional key)
"Execute key sequence at code block in the source Org buffer.
@@ -670,10 +706,6 @@ Org-babel commands."
(org-src-do-at-code-block
(call-interactively (lookup-key org-babel-map key)))))
-
-
-;;; Public functions
-
(defun org-src-edit-buffer-p (&optional buffer)
"Non-nil when current buffer is a source editing buffer.
If BUFFER is non-nil, test it instead."
@@ -683,29 +715,62 @@ If BUFFER is non-nil, test it instead."
(local-variable-p 'org-src--end-marker buffer))))
(defun org-src-switch-to-buffer (buffer context)
- (case org-src-window-setup
- (current-window (org-pop-to-buffer-same-window buffer))
- (other-window
+ (pcase org-src-window-setup
+ (`current-window (pop-to-buffer-same-window buffer))
+ (`other-window
(switch-to-buffer-other-window buffer))
- (other-frame
- (case context
- (exit
+ (`other-frame
+ (pcase context
+ (`exit
(let ((frame (selected-frame)))
(switch-to-buffer-other-frame buffer)
(delete-frame frame)))
- (save
+ (`save
(kill-buffer (current-buffer))
- (org-pop-to-buffer-same-window buffer))
- (t (switch-to-buffer-other-frame buffer))))
- (reorganize-frame
+ (pop-to-buffer-same-window buffer))
+ (_ (switch-to-buffer-other-frame buffer))))
+ (`reorganize-frame
(when (eq context 'edit) (delete-other-windows))
(org-switch-to-buffer-other-window buffer)
(when (eq context 'exit) (delete-other-windows)))
- (switch-invisibly (set-buffer buffer))
- (t
+ (`switch-invisibly (set-buffer buffer))
+ (_
(message "Invalid value %s for `org-src-window-setup'"
org-src-window-setup)
- (org-pop-to-buffer-same-window buffer))))
+ (pop-to-buffer-same-window buffer))))
+
+(defun org-src-coderef-format (&optional element)
+ "Return format string for block at point.
+
+When optional argument ELEMENT is provided, use that block.
+Otherwise, assume point is either at a source block, at an
+example block.
+
+If point is in an edit buffer, retrieve format string associated
+to the remote source block."
+ (cond
+ ((and element (org-element-property :label-fmt element)))
+ ((org-src-edit-buffer-p) (org-src-do-at-code-block (org-src-coderef-format)))
+ ((org-element-property :label-fmt (org-element-at-point)))
+ (t org-coderef-label-format)))
+
+(defun org-src-coderef-regexp (fmt &optional label)
+ "Return regexp matching a coderef format string FMT.
+
+When optional argument LABEL is non-nil, match coderef for that
+label only.
+
+Match group 1 contains the full coderef string with surrounding
+white spaces. Match group 2 contains the same string without any
+surrounding space. Match group 3 contains the label.
+
+A coderef format regexp can only match at the end of a line."
+ (format "\\S-\\([ \t]*\\(%s\\)[ \t]*\\)$"
+ (replace-regexp-in-string
+ "%s"
+ (if label (regexp-quote label) "\\([-a-zA-Z0-9_][-a-zA-Z0-9_ ]*\\)")
+ (regexp-quote fmt)
+ nil t)))
(defun org-edit-footnote-reference ()
"Edit definition of footnote reference at point."
@@ -765,11 +830,12 @@ If BUFFER is non-nil, test it instead."
(defun org-edit-table.el ()
"Edit \"table.el\" table at point.
-
+\\<org-src-mode-map>
A new buffer is created and the table is copied into it. Then
the table is recognized with `table-recognize'. When done
-editing, exit with \\[org-edit-src-exit]. The edited text will
-then replace the area in the Org mode buffer.
+editing, exit with `\\[org-edit-src-exit]'. The edited text will \
+then replace
+the area in the Org mode buffer.
Throw an error when not at such a table."
(interactive)
@@ -782,18 +848,20 @@ Throw an error when not at such a table."
element
(org-src--construct-edit-buffer-name (buffer-name) "Table")
#'text-mode t)
- (when (org-bound-and-true-p flyspell-mode) (flyspell-mode -1))
+ (when (bound-and-true-p flyspell-mode) (flyspell-mode -1))
(table-recognize)
t))
(defun org-edit-export-block ()
"Edit export block at point.
-
+\\<org-src-mode-map>
A new buffer is created and the block is copied into it, and the
buffer is switched into an appropriate major mode. See also
-`org-src-lang-modes'. When done, exit with
-\\[org-edit-src-exit]. The edited text will then replace the
-area in the Org mode buffer.
+`org-src-lang-modes'.
+
+When done, exit with `\\[org-edit-src-exit]'. The edited text \
+will then replace
+the area in the Org mode buffer.
Throw an error when not at an export block."
(interactive)
@@ -815,7 +883,7 @@ Throw an error when not at an export block."
"Edit the source or example block at point.
\\<org-src-mode-map>
The code is copied to a separate buffer and the appropriate mode
-is turned on. When done, exit with \\[org-edit-src-exit]. This \
+is turned on. When done, exit with `\\[org-edit-src-exit]'. This \
will remove the
original code in the Org buffer, and replace it with the edited
version. See `org-src-window-setup' to configure the display of
@@ -850,36 +918,71 @@ name of the sub-editing buffer."
`(lambda ()
(unless ,(or org-src-preserve-indentation
(org-element-property :preserve-indent element))
- (untabify (point-min) (point-max))
(when (> org-edit-src-content-indentation 0)
- (let ((ind (make-string org-edit-src-content-indentation
- ?\s)))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$") (insert ind))
- (forward-line)))))
+ (while (not (eobp))
+ (unless (looking-at "[ \t]*$")
+ (indent-line-to (+ (org-get-indentation)
+ org-edit-src-content-indentation)))
+ (forward-line))))
(org-escape-code-in-region (point-min) (point-max))))
(and code (org-unescape-code-in-string code)))
;; Finalize buffer.
- (org-set-local 'org-coderef-label-format
- (or (org-element-property :label-fmt element)
- org-coderef-label-format))
+ (setq-local org-coderef-label-format
+ (or (org-element-property :label-fmt element)
+ org-coderef-label-format))
(when (eq type 'src-block)
- (org-set-local 'org-src--babel-info babel-info)
+ (setq-local org-src--babel-info babel-info)
(let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
(when (fboundp edit-prep-func)
(funcall edit-prep-func babel-info))))
t)))
+(defun org-edit-inline-src-code ()
+ "Edit inline source code at point."
+ (interactive)
+ (let ((context (org-element-context)))
+ (unless (and (eq (org-element-type context) 'inline-src-block)
+ (org-src--on-datum-p context))
+ (user-error "Not on inline source code"))
+ (let* ((lang (org-element-property :language context))
+ (lang-f (org-src--get-lang-mode lang))
+ (babel-info (org-babel-get-src-block-info 'light))
+ deactivate-mark)
+ (unless (functionp lang-f) (error "No such language mode: %s" lang-f))
+ (org-src--edit-element
+ context
+ (org-src--construct-edit-buffer-name (buffer-name) lang)
+ lang-f
+ (lambda ()
+ ;; Inline src blocks are limited to one line.
+ (while (re-search-forward "\n[ \t]*" nil t) (replace-match " "))
+ ;; Trim contents.
+ (goto-char (point-min))
+ (skip-chars-forward " \t")
+ (delete-region (point-min) (point))
+ (goto-char (point-max))
+ (skip-chars-backward " \t")
+ (delete-region (point) (point-max))))
+ ;; Finalize buffer.
+ (setq-local org-src--babel-info babel-info)
+ (setq-local org-src--preserve-indentation t)
+ (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
+ (when (fboundp edit-prep-func) (funcall edit-prep-func babel-info)))
+ ;; Return success.
+ t)))
+
(defun org-edit-fixed-width-region ()
"Edit the fixed-width ASCII drawing at point.
-
+\\<org-src-mode-map>
This must be a region where each line starts with a colon
followed by a space or a newline character.
A new buffer is created and the fixed-width region is copied into
it, and the buffer is switched into the major mode defined in
-`org-edit-fixed-width-region-mode', which see. When done, exit
-with \\[org-edit-src-exit]. The edited text will then replace
+`org-edit-fixed-width-region-mode', which see.
+
+When done, exit with `\\[org-edit-src-exit]'. The edited text \
+will then replace
the area in the Org mode buffer."
(interactive)
(let ((element (org-element-at-point)))
@@ -962,7 +1065,7 @@ Throw an error if there is no such buffer."
(goto-char beg)
(cond
;; Block is hidden; move at start of block.
- ((org-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
+ ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
(overlays-at (point)))
(beginning-of-line 0))
(write-back (org-src--goto-coordinates coordinates beg end))))
diff --git a/lisp/org-table.el b/lisp/org-table.el
index e43f0f8..e2bbe87 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -1,4 +1,4 @@
-;;; org-table.el --- The table editor for Org mode
+;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -34,8 +34,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org)
(declare-function org-element-at-point "org-element" ())
@@ -52,20 +51,26 @@
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
-(declare-function org-export-create-backend "org-export" (&rest rest))
-(declare-function org-export-data-with-backend "org-export" (arg1 arg2 arg3))
-(declare-function org-export-first-sibling-p "org-export" (arg1 arg2))
-(declare-function org-export-get-backend "org-export" (arg1))
-(declare-function org-export-get-environment "org-export" (&optional arg1 arg2 arg3))
-(declare-function org-export-table-has-special-column-p "org-export" (arg1))
-(declare-function org-export-table-row-is-special-p "org-export" (arg1 arg2))
+(declare-function org-export-create-backend "ox" (&rest rest) t)
+(declare-function org-export-data-with-backend "ox" (data backend info))
+(declare-function org-export-filter-apply-functions "ox"
+ (filters value info))
+(declare-function org-export-first-sibling-p "ox" (blob info))
+(declare-function org-export-get-backend "ox" (name))
+(declare-function org-export-get-environment "ox"
+ (&optional backend subtreep ext-plist))
+(declare-function org-export-install-filters "ox" (info))
+(declare-function org-export-table-has-special-column-p "ox" (table))
+(declare-function org-export-table-row-is-special-p "ox" (table-row info))
(declare-function calc-eval "calc" (str &optional separator &rest args))
(defvar orgtbl-mode) ; defined below
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
(defvar constants-unit-system)
+(defvar org-export-filters-alist)
(defvar org-table-follow-field-mode)
+(defvar sort-fold-case)
(defvar orgtbl-after-send-table-hook nil
"Hook for functions attaching to `C-c C-c', if the table is sent.
@@ -84,7 +89,7 @@ for empty fields). Outside tables, the correct binding of the keys is
restored.
The default for this option is t if the optimized version is also used in
-Org-mode. See the variable `org-enable-table-editor' for details. Changing
+Org mode. See the variable `org-enable-table-editor' for details. Changing
this variable requires a restart of Emacs to become effective."
:group 'org-table
:type 'boolean)
@@ -139,7 +144,7 @@ table, obtained by prompting the user."
(string :tag "Format"))))
(defgroup org-table-settings nil
- "Settings for tables in Org-mode."
+ "Settings for tables in Org mode."
:tag "Org Table Settings"
:group 'org-table)
@@ -188,13 +193,13 @@ alignment to the right border applies."
:type 'number)
(defgroup org-table-editing nil
- "Behavior of tables during editing in Org-mode."
+ "Behavior of tables during editing in Org mode."
:tag "Org Table Editing"
:group 'org-table)
(defcustom org-table-automatic-realign t
"Non-nil means automatically re-align table when pressing TAB or RETURN.
-When nil, aligning is only done with \\[org-table-align], or after column
+When nil, aligning is only done with `\\[org-table-align]', or after column
removal/insertion."
:group 'org-table-editing
:type 'boolean)
@@ -240,12 +245,12 @@ this line."
:type 'boolean)
(defgroup org-table-calculation nil
- "Options concerning tables in Org-mode."
+ "Options concerning tables in Org mode."
:tag "Org Table Calculation"
:group 'org-table)
(defcustom org-table-use-standard-references 'from
- "Should org-mode work with table references like B3 instead of @3$2?
+ "Non-nil means using table references like B3 instead of @3$2.
Possible values are:
nil never use them
from accept as input, do not present for editing
@@ -257,9 +262,10 @@ t accept as input and present for editing"
(const :tag "Convert user input, don't offer during editing" from)))
(defcustom org-table-copy-increment t
- "Non-nil means increment when copying current field with \\[org-table-copy-down]."
+ "Non-nil means increment when copying current field with \
+`\\[org-table-copy-down]'."
:group 'org-table-calculation
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "Use the difference between the current and the above fields" t)
@@ -277,7 +283,7 @@ t accept as input and present for editing"
)
"List with Calc mode settings for use in `calc-eval' for table formulas.
The list must contain alternating symbols (Calc modes variables and values).
-Don't remove any of the default settings, just change the values. Org-mode
+Don't remove any of the default settings, just change the values. Org mode
relies on the variables to be present in the list."
:group 'org-table-calculation
:type 'plist)
@@ -311,7 +317,7 @@ which should be evaluated as described in the manual and in the documentation
string of the command `org-table-eval-formula'. This feature requires the
Emacs calc package.
When this variable is nil, formula calculation is only available through
-the command \\[org-table-eval-formula]."
+the command `\\[org-table-eval-formula]'."
:group 'org-table-calculation
:type 'boolean)
@@ -344,7 +350,7 @@ Constants can also be defined on a per-file basis using a line like
(defcustom org-table-allow-automatic-line-recalculation t
"Non-nil means lines marked with |#| or |*| will be recomputed automatically.
\\<org-mode-map>\
-Automatically means when TAB or RET or \\[org-ctrl-c-ctrl-c] \
+Automatically means when `TAB' or `RET' or `\\[org-ctrl-c-ctrl-c]' \
are pressed in the line."
:group 'org-table-calculation
:type 'boolean)
@@ -372,7 +378,7 @@ portability of tables."
"Non-nil means that evaluation of a field formula can add new
columns if an out-of-bounds field is being set."
:group 'org-table-calculation
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "Setting an out-of-bounds field generates an error (default)" nil)
@@ -381,7 +387,7 @@ columns if an out-of-bounds field is being set."
(const :tag "When setting an out-of-bounds field, the user is prompted" prompt)))
(defgroup org-table-import-export nil
- "Options concerning table import and export in Org-mode."
+ "Options concerning table import and export in Org mode."
:tag "Org Table Import Export"
:group 'org-table)
@@ -401,7 +407,7 @@ The function can be slow on larger regions; this safety feature
prevents it from hanging emacs."
:group 'org-table-import-export
:type 'integer
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3"))
(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
@@ -494,13 +500,13 @@ Field is restored even in case of abnormal exit."
;;;###autoload
(defun org-table-create-with-table.el ()
"Use the table.el package to insert a new table.
-If there is already a table at point, convert between Org-mode tables
+If there is already a table at point, convert between Org tables
and table.el tables."
(interactive)
(require 'table)
(cond
((org-at-table.el-p)
- (if (y-or-n-p "Convert table to Org-mode table? ")
+ (if (y-or-n-p "Convert table to Org table? ")
(org-table-convert)))
((org-at-table-p)
(when (y-or-n-p "Convert table to table.el table? ")
@@ -544,7 +550,7 @@ SIZE is a string Columns x Rows like for example \"3x2\"."
(beginning-of-line 1)
(newline))
;; (mapcar (lambda (x) (insert line)) (make-list rows t))
- (dotimes (i rows) (insert line))
+ (dotimes (_ rows) (insert line))
(goto-char pos)
(if (> rows 1)
;; Insert a hline after the first row.
@@ -665,7 +671,7 @@ extension of the given file name, and finally on the variable
(when (file-directory-p file)
(user-error "This is a directory path, not a file"))
(when (and (buffer-file-name (buffer-base-buffer))
- (org-file-equal-p
+ (file-equal-p
(file-truename file)
(file-truename (buffer-file-name (buffer-base-buffer)))))
(user-error "Please specify a file name that is different from current"))
@@ -684,7 +690,7 @@ extension of the given file name, and finally on the variable
(or (car (delq nil
(mapcar
(lambda (f)
- (and (org-string-match-p fileext f) f))
+ (and (string-match-p fileext f) f))
formats)))
org-table-export-default-format)
t t) t t)))
@@ -723,13 +729,11 @@ This is being used to correctly align a single field after TAB or RET.")
(defvar org-table-last-column-widths nil
"List of max width of fields in each column.
This is being used to correctly align a single field after TAB or RET.")
-(defvar org-table-formula-debug nil
+(defvar-local org-table-formula-debug nil
"Non-nil means debug table formulas.
When nil, simply write \"#ERROR\" in corrupted fields.")
-(make-variable-buffer-local 'org-table-formula-debug)
-(defvar org-table-overlay-coordinates nil
+(defvar-local org-table-overlay-coordinates nil
"Overlay coordinates after each align of a table.")
-(make-variable-buffer-local 'org-table-overlay-coordinates)
(defvar org-last-recalc-line nil)
(defvar org-table-do-narrow t) ; for dynamic scoping
@@ -753,7 +757,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
;; Table's rows. Separators are replaced by nil. Trailing
;; spaces are also removed.
(lines (mapcar (lambda (l)
- (and (not (org-string-match-p "\\`[ \t]*|-" l))
+ (and (not (string-match-p "\\`[ \t]*|-" l))
(let ((l (org-trim l)))
(remove-text-properties
0 (length l) '(display t org-cwidth t) l)
@@ -795,9 +799,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(org-add-props x nil
'help-echo
(concat
- (substitute-command-keys
- "Clipped table field, use \\[org-table-edit-field] to \
-edit. Full value is:\n")
+ "Clipped table field, use `\\[org-table-edit-field]' to \
+edit. Full value is:\n"
(substring-no-properties x)))
(let ((l (length x))
(f1 (min fmax
@@ -811,7 +814,7 @@ edit. Full value is:\n")
(if (= (org-string-width x) l) (setq f2 f1)
(setq f2 1)
(while (< (org-string-width (substring x 0 f2)) f1)
- (incf f2)))
+ (cl-incf f2)))
(add-text-properties f2 l (list 'org-cwidth t) x)
(add-text-properties
(if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
@@ -831,10 +834,10 @@ edit. Full value is:\n")
(unless (equal x "")
(setq frac
(/ (+ (* frac cnt)
- (if (org-string-match-p org-table-number-regexp x)
+ (if (string-match-p org-table-number-regexp x)
1
0))
- (incf cnt)))))
+ (cl-incf cnt)))))
(push (>= frac org-table-number-fraction) typenums)))))
(setq lengths (nreverse lengths))
(setq typenums (nreverse typenums))
@@ -942,41 +945,40 @@ Optional argument NEW may specify text to replace the current field content."
((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
((org-at-table-hline-p))
((and (not new)
- (or (not (equal (marker-buffer org-table-aligned-begin-marker)
- (current-buffer)))
+ (or (not (eq (marker-buffer org-table-aligned-begin-marker)
+ (current-buffer)))
(< (point) org-table-aligned-begin-marker)
(>= (point) org-table-aligned-end-marker)))
- ;; This is not the same table, force a full re-align
+ ;; This is not the same table, force a full re-align.
(setq org-table-may-need-update t))
- (t ;; realign the current field, based on previous full realign
- (let* ((pos (point)) s
- (col (org-table-current-column))
- (num (if (> col 0) (nth (1- col) org-table-last-alignment)))
- l f n o e)
+ (t
+ ;; Realign the current field, based on previous full realign.
+ (let ((pos (point))
+ (col (org-table-current-column)))
(when (> col 0)
- (skip-chars-backward "^|\n")
- (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")
- (progn
- (setq s (match-string 1)
- o (match-string 0)
- l (max 1
- (- (org-string-width
- (buffer-substring-no-properties
- (match-end 0) (match-beginning 0))) 3))
- e (not (= (match-beginning 2) (match-end 2))))
- (setq f (format (if num " %%%ds %s" " %%-%ds %s")
- l (if e "|" (setq org-table-may-need-update t) ""))
- n (format f s))
- (if new
- (if (<= (org-string-width new) l)
- (setq n (format f new))
- (setq n (concat new "|") org-table-may-need-update t)))
- (if (equal (string-to-char n) ?-) (setq n (concat " " n)))
- (or (equal n o)
- (let (org-table-may-need-update)
- (replace-match n t t))))
- (setq org-table-may-need-update t))
- (goto-char pos))))))
+ (skip-chars-backward "^|")
+ (if (not (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)"))
+ (setq org-table-may-need-update t)
+ (let* ((numbers? (nth (1- col) org-table-last-alignment))
+ (cell (match-string 0))
+ (field (match-string 1))
+ (len (max 1 (- (org-string-width cell) 3)))
+ (properly-closed? (/= (match-beginning 2) (match-end 2)))
+ (fmt (format (if numbers? " %%%ds %s" " %%-%ds %s")
+ len
+ (if properly-closed? "|"
+ (setq org-table-may-need-update t)
+ "")))
+ (new-cell
+ (cond ((not new) (format fmt field))
+ ((<= (org-string-width new) len) (format fmt new))
+ (t
+ (setq org-table-may-need-update t)
+ (format " %s |" new)))))
+ (unless (equal new-cell cell)
+ (let (org-table-may-need-update)
+ (replace-match new-cell t t)))
+ (goto-char pos))))))))
;;;###autoload
(defun org-table-next-field ()
@@ -1161,7 +1163,7 @@ to a number. In the case of a timestamp, increment by days."
(user-error "No non-empty field found")
(if (and org-table-copy-increment
(not (equal orig-n 0))
- (string-match "^[-+^/*0-9eE.]+$" txt)
+ (string-match-p "^[-+^/*0-9eE.]+$" txt)
(< (string-to-number txt) 100000000))
(setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
(insert txt)
@@ -1232,7 +1234,7 @@ Return t when the line exists, nil if it does not exist."
"Blank the current table field or active region."
(interactive)
(org-table-check-inside-data-field)
- (if (and (org-called-interactively-p 'any) (org-region-active-p))
+ (if (and (called-interactively-p 'any) (org-region-active-p))
(let (org-table-clip)
(org-table-cut-region (region-beginning) (region-end)))
(skip-chars-backward "^|")
@@ -1264,7 +1266,7 @@ is always the old value."
(forward-char 1) ""))
;;;###autoload
-(defun org-table-field-info (arg)
+(defun org-table-field-info (_arg)
"Show info about the current field, and highlight any reference at point."
(interactive "P")
(unless (org-at-table-p) (user-error "Not at a table"))
@@ -1304,19 +1306,22 @@ is always the old value."
(concat ", formula: "
(org-table-formula-to-user
(concat
- (if (string-match "^[$@]"(car eqn)) "" "$")
+ (if (or (string-prefix-p "$" (car eqn))
+ (string-prefix-p "@" (car eqn)))
+ ""
+ "$")
(car eqn) "=" (cdr eqn))))
"")))))
(defun org-table-current-column ()
"Find out which column we are in."
(interactive)
- (when (org-called-interactively-p 'any) (org-table-check-inside-data-field))
+ (when (called-interactively-p 'any) (org-table-check-inside-data-field))
(save-excursion
(let ((column 0) (pos (point)))
(beginning-of-line)
- (while (search-forward "|" pos t) (incf column))
- (when (org-called-interactively-p 'interactive)
+ (while (search-forward "|" pos t) (cl-incf column))
+ (when (called-interactively-p 'interactive)
(message "In table column %d" column))
column)))
@@ -1325,16 +1330,16 @@ is always the old value."
"Find out what table data line we are in.
Only data lines count for this."
(interactive)
- (when (org-called-interactively-p 'any)
+ (when (called-interactively-p 'any)
(org-table-check-inside-data-field))
(save-excursion
(let ((c 0)
(pos (point)))
(goto-char (org-table-begin))
(while (<= (point) pos)
- (when (looking-at org-table-dataline-regexp) (incf c))
+ (when (looking-at org-table-dataline-regexp) (cl-incf c))
(forward-line))
- (when (org-called-interactively-p 'any)
+ (when (called-interactively-p 'any)
(message "This is table line %d" c))
c)))
@@ -1552,19 +1557,21 @@ non-nil, the one above is used."
"Insert a new row above the current line into the table.
With prefix ARG, insert below the current line."
(interactive "P")
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
- (let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
+ (unless (org-at-table-p) (user-error "Not at a table"))
+ (let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
(new (org-table-clean-line line)))
;; Fix the first field if necessary
(if (string-match "^[ \t]*| *[#$] *|" line)
(setq new (replace-match (match-string 0 line) t t new)))
(beginning-of-line (if arg 2 1))
+ ;; Buffer may not end of a newline character, so ensure
+ ;; (beginning-of-line 2) moves point to a new line.
+ (unless (bolp) (insert "\n"))
(let (org-table-may-need-update) (insert-before-markers new "\n"))
(beginning-of-line 0)
- (re-search-forward "| ?" (point-at-eol) t)
- (and (or org-table-may-need-update org-table-overlay-coordinates)
- (org-table-align))
+ (re-search-forward "| ?" (line-end-position) t)
+ (when (or org-table-may-need-update org-table-overlay-coordinates)
+ (org-table-align))
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
@@ -1577,7 +1584,7 @@ With prefix ABOVE, insert above the current line."
(if (not (org-at-table-p))
(user-error "Not at a table"))
(when (eobp) (insert "\n") (backward-char 1))
- (if (not (string-match "|[ \t]*$" (org-current-line-string)))
+ (if (not (string-match-p "|[ \t]*$" (org-current-line-string)))
(org-table-align))
(let ((line (org-table-clean-line
(buffer-substring (point-at-bol) (point-at-eol))))
@@ -1676,7 +1683,7 @@ numeric compare based on the type of the first key in the table."
;; Set appropriate case sensitivity and column used for sorting.
(let ((column (let ((c (org-table-current-column)))
(cond ((> c 0) c)
- ((org-called-interactively-p 'any)
+ ((called-interactively-p 'any)
(read-number "Use column N for sorting: "))
(t 1))))
(sorting-type
@@ -1711,27 +1718,27 @@ numeric compare based on the type of the first key in the table."
(extract-key-from-field
;; Function to be called on the contents of the field
;; used for sorting in the current row.
- (case sorting-type
+ (cl-case sorting-type
((?n ?N) #'string-to-number)
((?a ?A) #'org-sort-remove-invisible)
((?t ?T)
(lambda (f)
(cond ((string-match org-ts-regexp-both f)
- (org-float-time
+ (float-time
(org-time-string-to-time (match-string 0 f))))
((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" f)
(org-hh:mm-string-to-minutes f))
(t 0))))
((?f ?F)
(or getkey-func
- (and (org-called-interactively-p 'any)
+ (and (called-interactively-p 'any)
(intern
(completing-read "Sort using function: "
obarray #'fboundp t)))
(error "Missing key extractor to sort rows")))
(t (user-error "Invalid sorting type `%c'" sorting-type))))
(predicate
- (case sorting-type
+ (cl-case sorting-type
((?n ?N ?t ?T) #'<)
((?a ?A) #'string<)
((?f ?F) compare-func))))
@@ -1821,24 +1828,24 @@ lines."
(dolist (field row)
(org-table-goto-column c nil 'force)
(org-table-get-field nil field)
- (incf c)))
+ (cl-incf c)))
(forward-line)))
(org-table-align)))
;;;###autoload
(defun org-table-convert ()
"Convert from `org-mode' table to table.el and back.
-Obviously, this only works within limits. When an Org-mode table is
-converted to table.el, all horizontal separator lines get lost, because
-table.el uses these as cell boundaries and has no notion of horizontal lines.
-A table.el table can be converted to an Org-mode table only if it does not
-do row or column spanning. Multiline cells will become multiple cells.
-Beware, Org-mode does not test if the table can be successfully converted - it
-blindly applies a recipe that works for simple tables."
+Obviously, this only works within limits. When an Org table is converted
+to table.el, all horizontal separator lines get lost, because table.el uses
+these as cell boundaries and has no notion of horizontal lines. A table.el
+table can be converted to an Org table only if it does not do row or column
+spanning. Multiline cells will become multiple cells. Beware, Org mode
+does not test if the table can be successfully converted - it blindly
+applies a recipe that works for simple tables."
(interactive)
(require 'table)
(if (org-at-table.el-p)
- ;; convert to Org-mode table
+ ;; convert to Org table
(let ((beg (copy-marker (org-table-begin t)))
(end (copy-marker (org-table-end t))))
(table-unrecognize-region beg end)
@@ -1892,10 +1899,10 @@ Note that horizontal lines disappear."
(let* ((table (delete 'hline (org-table-to-lisp)))
(dline_old (org-table-current-line))
(col_old (org-table-current-column))
- (contents (mapcar (lambda (p)
+ (contents (mapcar (lambda (_)
(let ((tp table))
(mapcar
- (lambda (rown)
+ (lambda (_)
(prog1
(pop (car tp))
(setq tp (cdr tp))))
@@ -1983,9 +1990,10 @@ blank, and the content is appended to the field above."
;;;###autoload
(defun org-table-edit-field (arg)
"Edit table field in a different window.
-This is mainly useful for fields that contain hidden parts.
-When called with a \\[universal-argument] prefix, just make the full field visible so that
-it can be edited in place."
+This is mainly useful for fields that contain hidden parts. When called
+with a `\\[universal-argument]' prefix, just make the full field \
+visible so that it can be
+edited in place."
(interactive "P")
(cond
((equal arg '(16))
@@ -2025,9 +2033,9 @@ it can be edited in place."
'(invisible t org-cwidth t display t
intangible t))
(goto-char p)
- (org-set-local 'org-finish-function 'org-table-finish-edit-field)
- (org-set-local 'org-window-configuration cw)
- (org-set-local 'org-field-marker pos)
+ (setq-local org-finish-function 'org-table-finish-edit-field)
+ (setq-local org-window-configuration cw)
+ (setq-local org-field-marker pos)
(message "Edit and finish with C-c C-c")))))
(defun org-table-finish-edit-field ()
@@ -2060,8 +2068,8 @@ current field. The mode exits automatically when the cursor leaves the
table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
nil " TblFollow" nil
(if org-table-follow-field-mode
- (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor
- 'append 'local)
+ (add-hook 'post-command-hook 'org-table-follow-fields-with-editor
+ 'append 'local)
(remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local)
(let* ((buf (get-buffer "*Org Table Edit Field*"))
(win (and buf (get-buffer-window buf))))
@@ -2136,11 +2144,10 @@ If NLAST is a number, only the NLAST fields will actually be summed."
s diff)
(format "%.0f:%02.0f:%02.0f" h m s))))
(kill-new sres)
- (if (org-called-interactively-p 'interactive)
- (message "%s"
- (substitute-command-keys
- (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
- (length numbers) sres))))
+ (when (called-interactively-p 'interactive)
+ (message "%s" (substitute-command-keys
+ (format "Sum of %d items: %-20s \
+\(\\[yank] will insert result into buffer)" (length numbers) sres))))
sres))))
(defun org-table-get-number-for-summing (s)
@@ -2184,7 +2191,7 @@ with \"=\" or \":=\"."
(assoc ref stored-list)
(assoc scol stored-list))))
(cond (key (car ass))
- (ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=")
+ (ass (concat (if (string-match-p "^[0-9]+$" (car ass)) "=" ":=")
(cdr ass))))))
(noerror nil)
(t (error "No formula active for the current field")))))
@@ -2200,22 +2207,15 @@ When NAMED is non-nil, look for a named equation."
(ref (format "@%d$%d"
(org-table-current-dline)
(org-table-current-column)))
- (refass (assoc ref stored-list))
- (nameass (assoc name stored-list))
(scol (cond
((not named) (format "$%d" (org-table-current-column)))
((and name (not (string-match "\\`LR[0-9]+\\'" name))) name)
(t ref)))
- (dummy (and (or nameass refass)
- (not named)
- (not (y-or-n-p "Replace existing field formula with \
-column formula? " ))
- (message "Formula not replaced")))
(name (or name ref))
(org-table-may-need-update nil)
(stored (cdr (assoc scol stored-list)))
(eq (cond
- ((and stored equation (string-match "^ *=? *$" equation))
+ ((and stored equation (string-match-p "^ *=? *$" equation))
stored)
((stringp equation)
equation)
@@ -2307,7 +2307,7 @@ LOCATION is a buffer position, consider the formulas there."
(goto-char (org-table-end)))
(let ((case-fold-search t))
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
- (let ((strings (org-split-string (org-match-string-no-properties 2)
+ (let ((strings (org-split-string (match-string-no-properties 2)
" *:: *"))
eq-alist seen)
(dolist (string strings (nreverse eq-alist))
@@ -2319,7 +2319,7 @@ LOCATION is a buffer position, consider the formulas there."
(cond
((not (match-end 2)) m)
;; Is it a column reference?
- ((org-string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m)
+ ((string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m)
;; Since named columns are not possible in
;; LHS, assume this is a named field.
(t (match-string 2 string)))))
@@ -2386,11 +2386,8 @@ If yes, store the formula and apply it."
(when (string-match "^:?=\\(.*[^=]\\)$" field)
(setq named (equal (string-to-char field) ?:)
eq (match-string 1 field))
- (if (or (fboundp 'calc-eval)
- (equal (substring eq 0 (min 2 (length eq))) "'("))
- (org-table-eval-formula (if named '(4) nil)
- (org-table-formula-from-user eq))
- (user-error "Calc does not seem to be installed, and is needed to evaluate the formula"))))))
+ (org-table-eval-formula (and named '(4))
+ (org-table-formula-from-user eq))))))
(defvar org-recalc-commands nil
"List of commands triggering the recalculation of a line.
@@ -2472,7 +2469,7 @@ of the new mark."
(when l1 (set-marker l1 nil))
(when l2 (set-marker l2 nil))
(set-marker l nil)
- (when (org-called-interactively-p 'interactive)
+ (when (called-interactively-p 'interactive)
(message "%s" (cdr (assoc newchar org-recalc-marks))))))
;;;###autoload
@@ -2500,7 +2497,7 @@ This function sets up the following dynamically scoped variables:
(re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t))
(let ((c 1))
(dolist (name (org-split-string (match-string 1) " *| *"))
- (incf c)
+ (cl-incf c)
(when (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" name)
(push (cons name (int-to-string c)) org-table-column-names)))))
(setq org-table-column-names (nreverse org-table-column-names))
@@ -2529,13 +2526,13 @@ This function sets up the following dynamically scoped variables:
(let ((fields1
(and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
(org-split-string (match-string 1) " *| *")))
- (line (incf (cdr last) (count-lines (car last) (point))))
+ (line (cl-incf (cdr last) (count-lines (car last) (point))))
(col 1))
(setcar last (point)) ; Update last known position.
(while (and fields fields1)
(let ((field (pop fields))
(v (pop fields1)))
- (incf col)
+ (cl-incf col)
(when (and (stringp field)
(stringp v)
(string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'"
@@ -2553,7 +2550,7 @@ This function sets up the following dynamically scoped variables:
(push (if (match-end 1) 'hline 'dline) types)
(if (match-end 1) (push l hlines) (push l dlines))
(forward-line)
- (incf l))
+ (cl-incf l))
(push 'hline types) ; Add an imaginary extra hline to the end.
(setq org-table-current-line-types (apply #'vector (nreverse types)))
(setq org-table-dlines (apply #'vector (cons nil (nreverse dlines))))
@@ -2640,20 +2637,18 @@ This function assumes the table is already analyzed (i.e., using
suppress-store suppress-analysis)
"Replace the table field value at the cursor by the result of a calculation.
-This function makes use of Dave Gillespie's Calc package, in my view the
-most exciting program ever written for GNU Emacs. So you need to have Calc
-installed in order to use this function.
-
In a table, this command replaces the value in the current field with the
result of a formula. It also installs the formula as the \"current\" column
formula, by storing it in a special line below the table. When called
-with a `C-u' prefix, the current field must be a named field, and the
-formula is installed as valid in only this specific field.
+with a `\\[universal-argument]' prefix the formula is installed as a \
+field formula.
-When called with two `C-u' prefixes, insert the active equation
-for the field back into the current field, so that it can be
-edited there. This is useful in order to use \\[org-table-show-reference]
-to check the referenced fields.
+When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
+insert the active equation for the field
+back into the current field, so that it can be edited there. This is \
+useful
+in order to use \\<org-table-fedit-map>`\\[org-table-show-reference]' to \
+check the referenced fields.
When called, the command first prompts for a formula, which is read in
the minibuffer. Previously entered formulas are available through the
@@ -2662,7 +2657,7 @@ These stored formulas are adapted correctly when moving, inserting, or
deleting columns with the corresponding commands.
The formula can be any algebraic expression understood by the Calc package.
-For details, see the Org-mode manual.
+For details, see the Org mode manual.
This function can also be called from Lisp programs and offers
additional arguments: EQUATION can be the formula to apply. If this
@@ -2672,7 +2667,8 @@ SUPPRESS-CONST suppresses the interpretation of constants in the
formula, assuming that this has been done already outside the function.
SUPPRESS-STORE means the formula should not be stored, either because
it is already stored, or because it is a modified equation that should
-not overwrite the stored one."
+not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to
+`org-table-analyze'."
(interactive "P")
(org-table-check-inside-data-field)
(or suppress-analysis (org-table-analyze))
@@ -2737,9 +2733,10 @@ not overwrite the stored one."
(setq fmt (replace-match "" t t fmt)))
(unless (string-match "\\S-" fmt)
(setq fmt nil))))
- (if (and (not suppress-const) org-table-formula-use-constants)
- (setq formula (org-table-formula-substitute-names formula)))
+ (when (and (not suppress-const) org-table-formula-use-constants)
+ (setq formula (org-table-formula-substitute-names formula)))
(setq orig (or (get-text-property 1 :orig-formula formula) "?"))
+ (setq formula (org-table-formula-handle-first/last-rc formula))
(while (> ndown 0)
(setq fields (org-split-string
(org-trim
@@ -2823,11 +2820,12 @@ not overwrite the stored one."
(replace-match
(save-match-data
(org-table-make-reference
- (org-sublist fields
- (+ (if (match-end 2) n0 0)
- (string-to-number (match-string 1 form)))
- (+ (if (match-end 4) n0 0)
- (string-to-number (match-string 3 form))))
+ (cl-subseq fields
+ (+ (if (match-end 2) n0 0)
+ (string-to-number (match-string 1 form))
+ -1)
+ (+ (if (match-end 4) n0 0)
+ (string-to-number (match-string 3 form))))
keep-empty numbers lispp))
t t form)))
(setq form0 form)
@@ -2854,20 +2852,23 @@ not overwrite the stored one."
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)
duration-output-format) ev))
- (or (fboundp 'calc-eval)
- (user-error "Calc does not seem to be installed, and is needed to evaluate the formula"))
- ;; Use <...> time-stamps so that Calc can handle them
- (while (string-match (concat "\\[" org-ts-regexp1 "\\]") form)
- (setq form (replace-match "<\\1>" nil nil form)))
- ;; I18n-ize local time-stamps by setting (system-time-locale "C")
- (when (string-match org-ts-regexp2 form)
- (let* ((ts (match-string 0 form))
- (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts))))
- (system-time-locale "C")
- (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
- (cdr org-time-stamp-formats))
- (car org-time-stamp-formats))))
- (setq form (replace-match (format-time-string tf tsp) t t form))))
+
+ ;; Use <...> time-stamps so that Calc can handle them.
+ (setq form
+ (replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form))
+ ;; Internationalize local time-stamps by setting locale to
+ ;; "C".
+ (setq form
+ (replace-regexp-in-string
+ org-ts-regexp
+ (lambda (ts)
+ (let ((system-time-locale "C"))
+ (format-time-string
+ (org-time-stamp-format
+ (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
+ (apply #'encode-time
+ (save-match-data (org-parse-time-string ts))))))
+ form t t))
(setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
form
@@ -2895,7 +2896,7 @@ $1-> %s\n" orig formula form0 form))
(if fmt (format fmt (string-to-number ev)) ev)))))
(setq bw (get-buffer-window "*Substitution History*"))
(org-fit-window-to-buffer bw)
- (unless (and (org-called-interactively-p 'any) (not ndown))
+ (unless (and (called-interactively-p 'any) (not ndown))
(unless (let (inhibit-redisplay)
(y-or-n-p "Debugging Formula. Continue to next? "))
(org-table-align)
@@ -2931,7 +2932,7 @@ When CORNERS-ONLY is set, only return the corners of the range as
a list (line1 column1 line2 column2) where line1 and line2 are
line numbers relative to beginning of table, or TBEG, and column1
and column2 are table column numbers."
- (let* ((desc (if (org-string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc)
+ (let* ((desc (if (string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc)
(replace-regexp-in-string "\\$" "@0$" desc)
desc))
(col (or col (org-table-current-column)))
@@ -2979,7 +2980,7 @@ and column2 are table column numbers."
(forward-line (- first-row thisline))
(while (not (looking-at org-table-dataline-regexp))
(forward-line)
- (incf first-row))
+ (cl-incf first-row))
(org-table-goto-column first-column)
(let ((beg (point)))
(forward-line (- last-row first-row))
@@ -3017,7 +3018,7 @@ The cursor is currently in relative line number CLINE."
(when (and hn (not hdir))
(setq cline 0)
(setq hdir "+")
- (when (eq (aref org-table-current-line-types 0) 'hline) (decf hn)))
+ (when (eq (aref org-table-current-line-types 0) 'hline) (cl-decf hn)))
(when (and (not hn) on (not odir)) (user-error "Should never happen"))
(when hn
(setq cline
@@ -3036,7 +3037,7 @@ search, as a string."
(let ((l (length org-table-current-line-types)))
(catch :exit
(dotimes (_ n)
- (while (and (incf i (if backwards -1 1))
+ (while (and (cl-incf i (if backwards -1 1))
(>= i 0)
(< i l)
(not (eq (aref org-table-current-line-types i) type))
@@ -3048,7 +3049,7 @@ search, as a string."
((eq org-table-relative-ref-may-cross-hline t))
((eq org-table-relative-ref-may-cross-hline 'error)
(user-error "Row descriptor %s crosses hline" desc))
- (t (decf i (if backwards -1 1)) ; Step back.
+ (t (cl-decf i (if backwards -1 1)) ; Step back.
(throw :exit nil)))))))
(cond ((or (< i 0) (>= i l))
(user-error "Row descriptor %s leads outside table" desc))
@@ -3126,10 +3127,13 @@ T1 is nil, always messages."
;;;###autoload
(defun org-table-recalculate (&optional all noalign)
"Recalculate the current table line by applying all stored formulas.
+
With prefix arg ALL, do this for all lines in the table.
-With the prefix argument ALL is `(16)' \
-\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if
-it is the symbol `iterate', recompute the table until it no longer changes.
+
+When called with a `\\[universal-argument] \\[universal-argument]' prefix, or \
+if ALL is the symbol `iterate',
+recompute the table until it no longer changes.
+
If NOALIGN is not nil, do not re-align the table after the computations
are done. This is typically used internally to save time, if it is
known that the table will be realigned a little later anyway."
@@ -3172,7 +3176,7 @@ existing formula for column %s"
new))
new))
(t old-lhs)))))
- (if (org-string-match-p "\\`\\$[0-9]+\\'" lhs)
+ (if (string-match-p "\\`\\$[0-9]+\\'" lhs)
(push (cons lhs rhs) eqlcol)
(push (cons lhs rhs) eqlfield))))
(setq eqlcol (nreverse eqlcol))
@@ -3193,8 +3197,8 @@ existing formula for column %s"
(re-search-forward org-table-hline-regexp end t)
(re-search-forward org-table-dataline-regexp end t))
(setq beg (match-beginning 0)))
- ;; Just leave BEG where it is.
- (t (setq beg (line-beginning-position)))))
+ ;; Just leave BEG at the start of the table.
+ (t nil)))
(setq beg (line-beginning-position)
end (copy-marker (line-beginning-position 2))))
(goto-char beg)
@@ -3233,7 +3237,7 @@ existing formula for column %s"
(while (re-search-forward line-re end t)
(unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1))
;; Unprotected line, recalculate.
- (incf cnt)
+ (cl-incf cnt)
(when all
(setq log-last-time
(org-table-message-once-per-second
@@ -3264,19 +3268,19 @@ existing formula for column %s"
;; `org-table-formula-create-columns' allows it.
(let ((column-count (progn (end-of-line)
(1- (org-table-current-column)))))
- `(lambda (column)
- (when (> column 1000)
- (user-error "Formula column target too large"))
- (and (> column ,column-count)
- (or (eq org-table-formula-create-columns t)
- (and (eq org-table-formula-create-columns 'warn)
- (progn
- (org-display-warning
- "Out-of-bounds formula added columns")
- t))
- (and (eq org-table-formula-create-columns 'prompt)
- (yes-or-no-p
- "Out-of-bounds formula. Add columns? ")))))))
+ (lambda (column)
+ (when (> column 1000)
+ (user-error "Formula column target too large"))
+ (and (> column column-count)
+ (or (eq org-table-formula-create-columns t)
+ (and (eq org-table-formula-create-columns 'warn)
+ (progn
+ (org-display-warning
+ "Out-of-bounds formula added columns")
+ t))
+ (and (eq org-table-formula-create-columns 'prompt)
+ (yes-or-no-p
+ "Out-of-bounds formula. Add columns? ")))))))
(org-table-eval-formula nil formula t t t t))))
;; Clean up markers and internal text property.
(remove-text-properties (point-min) (point-max) '(org-untouchable t))
@@ -3316,10 +3320,15 @@ with the prefix ARG."
(defun org-table-recalculate-buffer-tables ()
"Recalculate all tables in the current buffer."
(interactive)
- (save-excursion
- (save-restriction
- (widen)
- (org-table-map-tables (lambda () (org-table-recalculate t)) t))))
+ (org-with-wide-buffer
+ (org-table-map-tables
+ (lambda ()
+ ;; Reason for separate `org-table-align': When repeating
+ ;; (org-table-recalculate t) `org-table-may-need-update' gets in
+ ;; the way.
+ (org-table-recalculate t t)
+ (org-table-align))
+ t)))
;;;###autoload
(defun org-table-iterate-buffer-tables ()
@@ -3329,19 +3338,19 @@ with the prefix ARG."
(i imax)
(checksum (md5 (buffer-string)))
c1)
- (save-excursion
- (save-restriction
- (widen)
- (catch 'exit
- (while (> i 0)
- (setq i (1- i))
- (org-table-map-tables (lambda () (org-table-recalculate t)) t)
- (if (equal checksum (setq c1 (md5 (buffer-string))))
- (progn
- (message "Convergence after %d iterations" (- imax i))
- (throw 'exit t))
- (setq checksum c1)))
- (user-error "No convergence after %d iterations" imax))))))
+ (org-with-wide-buffer
+ (catch 'exit
+ (while (> i 0)
+ (setq i (1- i))
+ (org-table-map-tables (lambda () (org-table-recalculate t t)) t)
+ (if (equal checksum (setq c1 (md5 (buffer-string))))
+ (progn
+ (org-table-map-tables #'org-table-align t)
+ (message "Convergence after %d iterations" (- imax i))
+ (throw 'exit t))
+ (setq checksum c1)))
+ (org-table-map-tables #'org-table-align t)
+ (user-error "No convergence after %d iterations" imax)))))
(defun org-table-calc-current-TBLFM (&optional arg)
"Apply the #+TBLFM in the line at point to the table."
@@ -3385,13 +3394,13 @@ function assumes the table is already analyzed (i.e., using
(let ((lhs (car e))
(rhs (cdr e)))
(cond
- ((org-string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
+ ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
;; This just refers to one fixed field.
(push e res))
- ((org-string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
+ ((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
;; This just refers to one fixed named field.
(push e res))
- ((org-string-match-p "\\`\\$[0-9]+\\'" lhs)
+ ((string-match-p "\\`\\$[0-9]+\\'" lhs)
;; Column formulas are treated specially and are not
;; expanded.
(push e res))
@@ -3407,12 +3416,12 @@ function assumes the table is already analyzed (i.e., using
(c1 (nth 1 range))
(r2 (org-table-line-to-dline (nth 2 range) 'above))
(c2 (nth 3 range)))
- (loop for ir from r1 to r2 do
- (loop for ic from c1 to c2 do
- (push
- (cons (propertize (format "@%d$%d" ir ic) :orig-eqn e)
- rhs)
- res))))))))))
+ (cl-loop for ir from r1 to r2 do
+ (cl-loop for ic from c1 to c2 do
+ (push (cons (propertize
+ (format "@%d$%d" ir ic) :orig-eqn e)
+ rhs)
+ res))))))))))
(defun org-table-formula-handle-first/last-rc (s)
"Replace @<, @>, $<, $> with first/last row/column of the table.
@@ -3438,7 +3447,7 @@ borders of the table using the @< @> $< $> makers."
(- nmax len -1)))
(if (or (< n 1) (> n nmax))
(user-error "Reference \"%s\" in expression \"%s\" points outside table"
- (match-string 0 s) s))
+ (match-string 0 s) s))
(setq start (match-beginning 0))
(setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s)))))
s)
@@ -3447,7 +3456,7 @@ borders of the table using the @< @> $< $> makers."
"Replace $const with values in string F."
(let ((start 0)
(pp (/= (string-to-char f) ?'))
- (duration (org-string-match-p ";.*[Tt].*\\'" f))
+ (duration (string-match-p ";.*[Tt].*\\'" f))
(new (replace-regexp-in-string ; Check for column names.
org-table-column-name-regexp
(lambda (m)
@@ -3460,7 +3469,7 @@ borders of the table using the @< @> $< $> makers."
"\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)"
new start))
(if (match-end 2) (setq start (match-end 2))
- (incf start)
+ (cl-incf start)
;; When a duration is expected, convert value on the fly.
(let ((value
(save-match-data
@@ -3471,7 +3480,7 @@ borders of the table using the @< @> $< $> makers."
(when value
(setq new (replace-match
(concat (and pp "(") value (and pp ")")) t t new))))))
- (if org-table-formula-debug (org-propertize new :orig-formula f)) new))
+ (if org-table-formula-debug (propertize new :orig-formula f) new)))
(defun org-table-get-constant (const)
"Find the value for a parameter or constant in a formula.
@@ -3567,13 +3576,13 @@ Parameters get priority."
;; Keep global-font-lock-mode from turning on font-lock-mode
(let ((font-lock-global-modes '(not fundamental-mode)))
(fundamental-mode))
- (org-set-local 'font-lock-global-modes (list 'not major-mode))
- (org-set-local 'org-pos pos)
- (org-set-local 'org-table--fedit-source source)
- (org-set-local 'org-window-configuration wc)
- (org-set-local 'org-selected-window sel-win)
+ (setq-local font-lock-global-modes (list 'not major-mode))
+ (setq-local org-pos pos)
+ (setq-local org-table--fedit-source source)
+ (setq-local org-window-configuration wc)
+ (setq-local org-selected-window sel-win)
(use-local-map org-table-fedit-map)
- (org-add-hook 'post-command-hook #'org-table-fedit-post-command t t)
+ (add-hook 'post-command-hook #'org-table-fedit-post-command t t)
(easy-menu-add org-table-fedit-menu)
(setq startline (org-current-line))
(dolist (entry eql)
@@ -3597,8 +3606,7 @@ Parameters get priority."
(when (eq org-table-use-standard-references t)
(org-table-fedit-toggle-ref-type))
(org-goto-line startline)
- (message
- (substitute-command-keys "\\<org-mode-map>\
+ (message "%s" (substitute-command-keys "\\<org-mode-map>\
Edit formulas, finish with `\\[org-ctrl-c-ctrl-c]' or `\\[org-edit-special]'. \
See menu for more commands.")))))
@@ -3731,7 +3739,7 @@ minutes or seconds."
(format "%.1f" (/ (float secs0) 60)))
((eq output-format 'seconds)
(format "%d" secs0))
- (t (org-format-seconds "%.2h:%.2m:%.2s" secs0)))))
+ (t (format-seconds "%.2h:%.2m:%.2s" secs0)))))
(if (< secs 0) (concat "-" res) res)))
(defun org-table-fedit-convert-buffer (function)
@@ -3748,7 +3756,7 @@ minutes or seconds."
(defun org-table-fedit-toggle-ref-type ()
"Convert all references in the buffer from B3 to @3$2 and back."
(interactive)
- (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an))
+ (setq-local org-table-buffer-is-an (not org-table-buffer-is-an))
(org-table-fedit-convert-buffer
(if org-table-buffer-is-an
'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc))
@@ -3961,8 +3969,8 @@ When LOCAL is non-nil, show references for the table at point."
(when (and match (not (equal (match-beginning 0) (point-at-bol))))
(org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
'secondary-selection))
- (org-add-hook 'before-change-functions
- #'org-table-remove-rectangle-highlight)
+ (add-hook 'before-change-functions
+ #'org-table-remove-rectangle-highlight)
(when (eq what 'name) (setq var (substring match 1)))
(when (eq what 'range)
(unless (eq (string-to-char match) ?@) (setq match (concat "@" match)))
@@ -3991,10 +3999,10 @@ When LOCAL is non-nil, show references for the table at point."
(when dest
(setq name (substring dest 1))
(cond
- ((org-string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest)
+ ((string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest)
(org-table-goto-field dest))
- ((org-string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'"
- dest)
+ ((string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'"
+ dest)
(org-table-goto-field dest))
(t (org-table-goto-column (string-to-number name))))
(move-marker pos (point))
@@ -4148,16 +4156,15 @@ FACE, when non-nil, for the highlight."
(goto-char (car start-coordinates)))
(add-hook 'before-change-functions #'org-table-remove-rectangle-highlight))
-(defun org-table-remove-rectangle-highlight (&rest ignore)
+(defun org-table-remove-rectangle-highlight (&rest _ignore)
"Remove the rectangle overlays."
(unless org-inhibit-highlight-removal
(remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight)
(mapc 'delete-overlay org-table-rectangle-overlays)
(setq org-table-rectangle-overlays nil)))
-(defvar org-table-coordinate-overlays nil
+(defvar-local org-table-coordinate-overlays nil
"Collects the coordinate grid overlays, so that they can be removed.")
-(make-variable-buffer-local 'org-table-coordinate-overlays)
(defun org-table-overlay-coordinates ()
"Add overlays to the table at point, to show row/column coordinates."
@@ -4212,19 +4219,20 @@ FACE, when non-nil, for the highlight."
;;; The orgtbl minor mode
;; Define a minor mode which can be used in other modes in order to
-;; integrate the org-mode table editor.
-
-;; This is really a hack, because the org-mode table editor uses several
-;; keys which normally belong to the major mode, for example the TAB and
-;; RET keys. Here is how it works: The minor mode defines all the keys
-;; necessary to operate the table editor, but wraps the commands into a
-;; function which tests if the cursor is currently inside a table. If that
-;; is the case, the table editor command is executed. However, when any of
-;; those keys is used outside a table, the function uses `key-binding' to
-;; look up if the key has an associated command in another currently active
-;; keymap (minor modes, major mode, global), and executes that command.
-;; There might be problems if any of the keys used by the table editor is
-;; otherwise used as a prefix key.
+;; integrate the Org table editor.
+
+;; This is really a hack, because the Org table editor uses several
+;; keys which normally belong to the major mode, for example the TAB
+;; and RET keys. Here is how it works: The minor mode defines all the
+;; keys necessary to operate the table editor, but wraps the commands
+;; into a function which tests if the cursor is currently inside
+;; a table. If that is the case, the table editor command is
+;; executed. However, when any of those keys is used outside a table,
+;; the function uses `key-binding' to look up if the key has an
+;; associated command in another currently active keymap (minor modes,
+;; major mode, global), and executes that command. There might be
+;; problems if any of the keys used by the table editor is otherwise
+;; used as a prefix key.
;; Another challenge is that the key binding for TAB can be tab or \C-i,
;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
@@ -4274,16 +4282,16 @@ FACE, when non-nil, for the highlight."
;; FIXME: maybe it should use emulation-mode-map-alists?
(and c (setq minor-mode-map-alist
(cons c (delq c minor-mode-map-alist)))))
- (org-set-local (quote org-table-may-need-update) t)
- (org-add-hook 'before-change-functions 'org-before-change-function
- nil 'local)
- (org-set-local 'org-old-auto-fill-inhibit-regexp
- auto-fill-inhibit-regexp)
- (org-set-local 'auto-fill-inhibit-regexp
- (if auto-fill-inhibit-regexp
- (concat orgtbl-line-start-regexp "\\|"
- auto-fill-inhibit-regexp)
- orgtbl-line-start-regexp))
+ (setq-local org-table-may-need-update t)
+ (add-hook 'before-change-functions 'org-before-change-function
+ nil 'local)
+ (setq-local org-old-auto-fill-inhibit-regexp
+ auto-fill-inhibit-regexp)
+ (setq-local auto-fill-inhibit-regexp
+ (if auto-fill-inhibit-regexp
+ (concat orgtbl-line-start-regexp "\\|"
+ auto-fill-inhibit-regexp)
+ orgtbl-line-start-regexp))
(add-to-invisibility-spec '(org-cwidth))
(when (fboundp 'font-lock-add-keywords)
(font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
@@ -4383,27 +4391,26 @@ to execute outside of tables."
cmd (orgtbl-make-binding fun nfunc key))
(org-defkey orgtbl-mode-map key cmd))
- ;; Special treatment needed for TAB and RET
+ ;; Special treatment needed for TAB, RET and DEL
(org-defkey orgtbl-mode-map [(return)]
(orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
(org-defkey orgtbl-mode-map "\C-m"
(orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
-
(org-defkey orgtbl-mode-map [(tab)]
(orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
(org-defkey orgtbl-mode-map "\C-i"
(orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
-
(org-defkey orgtbl-mode-map [(shift tab)]
(orgtbl-make-binding 'org-table-previous-field 104
[(shift tab)] [(tab)] "\C-i"))
+ (org-defkey orgtbl-mode-map [backspace]
+ (orgtbl-make-binding 'org-delete-backward-char 109
+ [backspace] (kbd "DEL")))
-
- (unless (featurep 'xemacs)
- (org-defkey orgtbl-mode-map [S-iso-lefttab]
- (orgtbl-make-binding 'org-table-previous-field 107
- [S-iso-lefttab] [backtab] [(shift tab)]
- [(tab)] "\C-i")))
+ (org-defkey orgtbl-mode-map [S-iso-lefttab]
+ (orgtbl-make-binding 'org-table-previous-field 107
+ [S-iso-lefttab] [backtab] [(shift tab)]
+ [(tab)] "\C-i"))
(org-defkey orgtbl-mode-map [backtab]
(orgtbl-make-binding 'org-table-previous-field 108
@@ -4522,7 +4529,7 @@ With prefix arg, also recompute table."
(t (let (orgtbl-mode)
(call-interactively (key-binding "\C-c\C-c")))))))
-(defun orgtbl-create-or-convert-from-region (arg)
+(defun orgtbl-create-or-convert-from-region (_arg)
"Create table or convert region to table, if no conflicting binding.
This installs the table binding `C-c |', but only if there is no
conflicting binding to this key outside orgtbl-mode."
@@ -4566,11 +4573,9 @@ overwritten, and the table is not marked as requiring realignment."
(org-table-blank-field))
t)
(eq N 1)
- (looking-at "[^|\n]* +|"))
+ (looking-at "[^|\n]* \\( \\)|"))
(let (org-table-may-need-update)
- (goto-char (1- (match-end 0)))
- (org-delete-backward-char 1)
- (goto-char (match-beginning 0))
+ (delete-region (match-beginning 1) (match-end 1))
(self-insert-command N))
(setq org-table-may-need-update t)
(let* (orgtbl-mode
@@ -4616,20 +4621,24 @@ a radio table."
(beginning-of-line 0)))
rtn)))
-(defun orgtbl-send-replace-tbl (name txt)
- "Find and replace table NAME with TXT."
+(defun orgtbl-send-replace-tbl (name text)
+ "Find and replace table NAME with TEXT."
(save-excursion
(goto-char (point-min))
- (unless (re-search-forward
- (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
- (user-error "Don't know where to insert translated table"))
- (let ((beg (line-beginning-position 2)))
- (unless (re-search-forward
- (concat "END +RECEIVE +ORGTBL +" name) nil t)
- (user-error "Cannot find end of insertion region"))
- (beginning-of-line)
- (delete-region beg (point)))
- (insert txt "\n")))
+ (let* ((location-flag nil)
+ (name (regexp-quote name))
+ (begin-re (format "BEGIN +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name))
+ (end-re (format "END +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name)))
+ (while (re-search-forward begin-re nil t)
+ (unless location-flag (setq location-flag t))
+ (let ((beg (line-beginning-position 2)))
+ (unless (re-search-forward end-re nil t)
+ (user-error "Cannot find end of receiver location at %d" beg))
+ (beginning-of-line)
+ (delete-region beg (point))
+ (insert text "\n")))
+ (unless location-flag
+ (user-error "No valid receiver location found in the buffer")))))
;;;###autoload
(defun org-table-to-lisp (&optional txt)
@@ -4654,7 +4663,7 @@ for this table."
(catch 'exit
(unless (org-at-table-p) (user-error "Not at a table"))
;; when non-interactive, we assume align has just happened.
- (when (org-called-interactively-p 'any) (org-table-align))
+ (when (called-interactively-p 'any) (org-table-align))
(let ((dests (orgtbl-gather-send-defs))
(table (org-table-to-lisp
(buffer-substring-no-properties (org-table-begin)
@@ -4670,7 +4679,7 @@ for this table."
(unless (fboundp transform)
(user-error "No such transformation function %s" transform))
(orgtbl-send-replace-tbl name (funcall transform table params)))
- (incf ntbl))
+ (cl-incf ntbl))
(message "Table converted and installed at %d receiver location%s"
ntbl (if (> ntbl 1) "s" ""))
(and (> ntbl 0) ntbl))))
@@ -4806,7 +4815,7 @@ strings, or the current cell) returning a string:
a property list with column numbers and format strings, or
functions, e.g.,
- \(:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
+ (:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt
@@ -4852,10 +4861,21 @@ This may be either a string or a function of two arguments:
((consp e)
(princ "| ") (dolist (c e) (princ c) (princ " |"))
(princ "\n")))))
+ ;; Add back-end specific filters, but not user-defined ones. In
+ ;; particular, make sure to call parse-tree filters on the
+ ;; table.
+ (setq info
+ (let ((org-export-filters-alist nil))
+ (org-export-install-filters
+ (org-combine-plists
+ (org-export-get-environment backend nil params)
+ `(:back-end ,(org-export-get-backend backend))))))
(setq data
- (org-element-map (org-element-parse-buffer) 'table
- #'identity nil t))
- (setq info (org-export-get-environment backend nil params)))
+ (org-export-filter-apply-functions
+ (plist-get info :filter-parse-tree)
+ (org-element-map (org-element-parse-buffer) 'table
+ #'identity nil t)
+ info)))
(when (and backend (symbolp backend) (not (org-export-get-backend backend)))
(user-error "Unknown :backend value"))
(when (or (not backend) (plist-get info :raw)) (require 'ox-org))
@@ -4868,7 +4888,7 @@ This may be either a string or a function of two arguments:
(lambda (row)
(if (>= n skip) t
(org-element-extract-element row)
- (incf n)
+ (cl-incf n)
nil))
nil t))))
;; Handle :skipcols parameter.
@@ -4885,7 +4905,7 @@ This may be either a string or a function of two arguments:
(org-element-contents row)))
(when (memq c skipcols)
(org-element-extract-element cell))
- (incf c))))))))))
+ (cl-incf c))))))))))
;; Since we are going to export using a low-level mechanism,
;; ignore special column and special rows manually.
(let ((special? (org-export-table-has-special-column-p data))
@@ -4898,9 +4918,9 @@ This may be either a string or a function of two arguments:
(push datum ignore))))
(setq info (plist-put info :ignore-list ignore)))
;; We use a low-level mechanism to export DATA so as to skip all
- ;; usual pre-processing and post-processing, i.e., hooks, filters,
- ;; Babel code evaluation, include keywords and macro expansion,
- ;; and filters.
+ ;; usual pre-processing and post-processing, i.e., hooks, Babel
+ ;; code evaluation, include keywords and macro expansion. Only
+ ;; back-end specific filters are retained.
(let ((output (org-export-data-with-backend data custom-backend info)))
;; Remove final newline.
(if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
@@ -5189,7 +5209,7 @@ supported. It is also possible to use the following one:
params)))
(columns (let ((w (plist-get params :columns)))
(cond ((not w) nil)
- ((org-string-match-p "{\\|@columnfractions " w) w)
+ ((string-match-p "{\\|@columnfractions " w) w)
(t (concat "@columnfractions " w))))))
(if (not columns) output
(replace-regexp-in-string
@@ -5255,7 +5275,7 @@ supported. It is also possible to use the following ones:
params)))
;; Put the cursor in a column containing numerical values
-;; of an Org-Mode table,
+;; of an Org table,
;; type C-c " a
;; A new column is added with a bar plot.
;; When the table is refreshed (C-u C-c *),
@@ -5263,35 +5283,38 @@ supported. It is also possible to use the following ones:
(defun orgtbl-ascii-draw (value min max &optional width characters)
"Draw an ascii bar in a table.
-VALUE is a the value to plot, the width of the bar to draw. A
-value equal to MIN will be displayed as empty (zero width bar).
-A value equal to MAX will draw a bar filling all the WIDTH.
-WIDTH is the expected width in characters of the column.
-CHARACTERS is a string that will compose the bar, with shades of
-grey from pure white to pure black. It defaults to a 10
-characters string of regular ascii characters."
- (let* ((characters (or characters " .:;c!lhVHW"))
- (width (or width 12))
- (value (if (numberp value) value (string-to-number value)))
- (value (* (/ (- (+ value 0.0) min) (- max min)) width)))
- (cond
- ((< value 0) "too small")
- ((> value width) "too large")
- (t
- (let ((len (1- (length characters))))
- (concat
- (make-string (floor value) (elt characters len))
- (string (elt characters
- (floor (* (- value (floor value)) len))))))))))
+VALUE is the value to plot, it determines the width of the bar to draw.
+MIN is the value that will be displayed as empty (zero width bar).
+MAX is the value that will draw a bar filling all the WIDTH.
+WIDTH is the span in characters from MIN to MAX.
+CHARACTERS is a string that will compose the bar, with shades of grey
+from pure white to pure black. It defaults to a 10 characters string
+of regular ascii characters."
+ (let* ((width (ceiling (or width 12)))
+ (characters (or characters " .:;c!lhVHW"))
+ (len (1- (length characters)))
+ (value (float (if (numberp value)
+ value (string-to-number value))))
+ (relative (/ (- value min) (- max min)))
+ (steps (round (* relative width len))))
+ (cond ((< steps 0) "too small")
+ ((> steps (* width len)) "too large")
+ (t (let* ((int-division (/ steps len))
+ (remainder (- steps (* int-division len))))
+ (concat (make-string int-division (elt characters len))
+ (string (elt characters remainder))))))))
;;;###autoload
(defun orgtbl-ascii-plot (&optional ask)
- "Draw an ascii bar plot in a column.
-With cursor in a column containing numerical values, this
-function will draw a plot in a new column.
+ "Draw an ASCII bar plot in a column.
+
+With cursor in a column containing numerical values, this function
+will draw a plot in a new column.
+
ASK, if given, is a numeric prefix to override the default 12
-characters width of the plot. ASK may also be the
-\\[universal-argument] prefix, which will prompt for the width."
+characters width of the plot. ASK may also be the `\\[universal-argument]' \
+prefix,
+which will prompt for the width."
(interactive "P")
(let ((col (org-table-current-column))
(min 1e999) ; 1e999 will be converted to infinity
@@ -5430,15 +5453,15 @@ distinguished from a plain table name or ID."
(save-match-data
(let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m))))
(org-table-get-range
- (if (org-string-match-p "\\`\\$[0-9]+\\'" eq)
+ (if (string-match-p "\\`\\$[0-9]+\\'" eq)
(concat "@0" eq)
eq)))))
form t t 1)))
(defmacro org-define-lookup-function (mode)
(let ((mode-str (symbol-name mode))
- (first-p (equal mode 'first))
- (all-p (equal mode 'all)))
+ (first-p (eq mode 'first))
+ (all-p (eq mode 'all)))
(let ((plural-str (if all-p "s" "")))
`(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate)
,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST.
@@ -5451,16 +5474,13 @@ This function is generated by a call to the macro `org-define-lookup-function'."
(sl s-list)
(rl (or r-list s-list))
(ret nil))))
- (if first-p (add-to-list 'lvars '(match-p nil)))
- lvars)
+ (if first-p (cons '(match-p nil) lvars) lvars))
(while ,(if first-p '(and (not match-p) sl) 'sl)
- (progn
- (if (funcall p val (car sl))
- (progn
- ,(if first-p '(setq match-p t))
- (let ((rval (car rl)))
- (setq ret ,(if all-p '(append ret (list rval)) 'rval)))))
- (setq sl (cdr sl) rl (cdr rl))))
+ (when (funcall p val (car sl))
+ ,(when first-p '(setq match-p t))
+ (let ((rval (car rl)))
+ (setq ret ,(if all-p '(append ret (list rval)) 'rval))))
+ (setq sl (cdr sl) rl (cdr rl)))
ret)))))
(org-define-lookup-function first)
diff --git a/lisp/org-timer.el b/lisp/org-timer.el
index c363ff3..2d2ee21 100644
--- a/lisp/org-timer.el
+++ b/lisp/org-timer.el
@@ -1,4 +1,4 @@
-;;; org-timer.el --- Timer code for Org mode
+;;; org-timer.el --- Timer code for Org mode -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
@@ -35,7 +35,7 @@
;;; Code:
-(require 'org)
+(require 'cl-lib)
(require 'org-clock)
(declare-function org-agenda-error "org-agenda" ())
@@ -69,14 +69,14 @@ the value of the timer."
"The default timer when a timer is set, in minutes or hh:mm:ss format.
When 0, the user is prompted for a value."
:group 'org-time
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'string)
(defcustom org-timer-display 'mode-line
- "When a timer is running, org-mode can display it in the mode
-line and/or frame title.
-Allowed values are:
+ "Define where running timer is displayed, if at all.
+When a timer is running, Org can display it in the mode line
+and/or frame title. Allowed values are:
both displays in both mode line and frame title
mode-line displays only in mode line (default)
@@ -141,10 +141,10 @@ the region 0:00:00."
(setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s)))))
(setq org-timer-start-time
(seconds-to-time
- ;; Pass `current-time' result to `org-float-time'
- ;; (instead of calling without arguments) so that only
+ ;; Pass `current-time' result to `float-time' (instead
+ ;; of calling without arguments) so that only
;; `current-time' has to be overriden in tests.
- (- (org-float-time (current-time)) delta))))
+ (- (float-time (current-time)) delta))))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
(message "Timer start time set to %s, current value is %s"
@@ -160,8 +160,8 @@ With prefix arg STOP, stop it entirely."
(stop (org-timer-stop))
((not org-timer-start-time) (error "No timer is running"))
(org-timer-pause-time
- (let ((start-secs (org-float-time org-timer-start-time))
- (pause-secs (org-float-time org-timer-pause-time)))
+ (let ((start-secs (float-time org-timer-start-time))
+ (pause-secs (float-time org-timer-pause-time)))
(if org-timer-countdown-timer
(let ((new-secs (- start-secs pause-secs)))
(setq org-timer-countdown-timer
@@ -170,10 +170,10 @@ With prefix arg STOP, stop it entirely."
(setq org-timer-start-time
(time-add (current-time) (seconds-to-time new-secs))))
(setq org-timer-start-time
- ;; Pass `current-time' result to `org-float-time'
- ;; (instead of calling without arguments) so that only
+ ;; Pass `current-time' result to `float-time' (instead
+ ;; of calling without arguments) so that only
;; `current-time' has to be overriden in tests.
- (seconds-to-time (- (org-float-time (current-time))
+ (seconds-to-time (- (float-time (current-time))
(- pause-secs start-secs)))))
(setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
@@ -204,22 +204,25 @@ With prefix arg STOP, stop it entirely."
(message "Timer stopped"))
;;;###autoload
-(defun org-timer (&optional restart no-insert-p)
+(defun org-timer (&optional restart no-insert)
"Insert a H:MM:SS string from the timer into the buffer.
-The first time this command is used, the timer is started. When used with
-a \\[universal-argument] prefix, force restarting the timer.
-When used with a double prefix argument \\[universal-argument], change all the timer string
-in the region by a fixed amount. This can be used to recalibrate a timer
-that was not started at the correct moment.
+The first time this command is used, the timer is started.
-If NO-INSERT-P is non-nil, return the string instead of inserting
+When used with a `\\[universal-argument]' prefix, force restarting the timer.
+
+When used with a `\\[universal-argument] \\[universal-argument]' \
+prefix, change all the timer strings
+in the region by a fixed amount. This can be used to re-calibrate
+a timer that was not started at the correct moment.
+
+If NO-INSERT is non-nil, return the string instead of inserting
it in the buffer."
(interactive "P")
(if (equal restart '(16))
(org-timer-start restart)
(when (or (equal restart '(4)) (not org-timer-start-time))
(org-timer-start))
- (if no-insert-p
+ (if no-insert
(org-timer-value-string)
(insert (org-timer-value-string)))))
@@ -230,14 +233,14 @@ it in the buffer."
(abs (floor (org-timer-seconds))))))
(defun org-timer-seconds ()
- ;; Pass `current-time' result to `org-float-time' (instead of
- ;; calling without arguments) so that only `current-time' has to be
+ ;; Pass `current-time' result to `float-time' (instead of calling
+ ;; without arguments) so that only `current-time' has to be
;; overriden in tests.
(if org-timer-countdown-timer
- (- (org-float-time org-timer-start-time)
- (org-float-time (or org-timer-pause-time (current-time))))
- (- (org-float-time (or org-timer-pause-time (current-time)))
- (org-float-time org-timer-start-time))))
+ (- (float-time org-timer-start-time)
+ (float-time (or org-timer-pause-time (current-time))))
+ (- (float-time (or org-timer-pause-time (current-time)))
+ (float-time org-timer-start-time))))
;;;###autoload
(defun org-timer-change-times-in-region (beg end delta)
@@ -343,43 +346,43 @@ VALUE can be `on', `off', or `paused'."
(or (memq 'org-timer-mode-line-string frame-title-format)
(setq frame-title-format
(append frame-title-format '(org-timer-mode-line-string)))))
- (cond
- ((equal value 'off)
- (when org-timer-mode-line-timer
- (cancel-timer org-timer-mode-line-timer)
- (setq org-timer-mode-line-timer nil))
- (when (or (eq org-timer-display 'mode-line)
- (eq org-timer-display 'both))
- (setq global-mode-string
- (delq 'org-timer-mode-line-string global-mode-string)))
- (when (or (eq org-timer-display 'frame-title)
- (eq org-timer-display 'both))
- (setq frame-title-format
- (delq 'org-timer-mode-line-string frame-title-format)))
- (force-mode-line-update))
- ((equal value 'paused)
- (when org-timer-mode-line-timer
- (cancel-timer org-timer-mode-line-timer)
- (setq org-timer-mode-line-timer nil)))
- ((equal value 'on)
- (when (or (eq org-timer-display 'mode-line)
- (eq org-timer-display 'both))
- (or global-mode-string (setq global-mode-string '("")))
- (or (memq 'org-timer-mode-line-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(org-timer-mode-line-string)))))
- (when (or (eq org-timer-display 'frame-title)
- (eq org-timer-display 'both))
- (or (memq 'org-timer-mode-line-string frame-title-format)
- (setq frame-title-format
- (append frame-title-format '(org-timer-mode-line-string)))))
- (org-timer-update-mode-line)
- (when org-timer-mode-line-timer
- (cancel-timer org-timer-mode-line-timer)
- (setq org-timer-mode-line-timer nil))
- (when org-timer-display
- (setq org-timer-mode-line-timer
- (run-with-timer 1 1 'org-timer-update-mode-line))))))
+ (cl-case value
+ (off
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil))
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (setq global-mode-string
+ (delq 'org-timer-mode-line-string global-mode-string)))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (setq frame-title-format
+ (delq 'org-timer-mode-line-string frame-title-format)))
+ (force-mode-line-update))
+ (paused
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil)))
+ (on
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-timer-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-timer-mode-line-string)))))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (or (memq 'org-timer-mode-line-string frame-title-format)
+ (setq frame-title-format
+ (append frame-title-format '(org-timer-mode-line-string)))))
+ (org-timer-update-mode-line)
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil))
+ (when org-timer-display
+ (setq org-timer-mode-line-timer
+ (run-with-timer 1 1 'org-timer-update-mode-line))))))
(defun org-timer-update-mode-line ()
"Update the timer time in the mode line."
@@ -434,10 +437,10 @@ using three `C-u' prefix arguments."
(number-to-string org-timer-default-timer)
org-timer-default-timer))
(effort-minutes (ignore-errors (org-get-at-eol 'effort-minutes 1)))
- (minutes (or (and (not (equal opt '(64)))
+ (minutes (or (and (numberp opt) (number-to-string opt))
+ (and (not (equal opt '(64)))
effort-minutes
(number-to-string effort-minutes))
- (and (numberp opt) (number-to-string opt))
(and (consp opt) default-timer)
(and (stringp opt) opt)
(read-from-minibuffer
@@ -447,8 +450,7 @@ using three `C-u' prefix arguments."
(setq minutes (concat minutes ":00")))
(if (not (string-match "[0-9]+" minutes))
(org-timer-show-remaining-time)
- (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes)))
- (hl (org-timer--get-timer-title)))
+ (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes))))
(if (and org-timer-countdown-timer
(not (or (equal opt '(16))
(y-or-n-p "Replace current timer? "))))
diff --git a/lisp/org-version.el b/lisp/org-version.el
index 145290b..12b5274 100644
--- a/lisp/org-version.el
+++ b/lisp/org-version.el
@@ -3,15 +3,15 @@
;;; Code:
;;;###autoload
(defun org-release ()
- "The release version of org-mode.
- Inserted by installing org-mode or when a release is made."
- (let ((org-release "8.3.4"))
+ "The release version of Org.
+Inserted by installing Org mode or when a release is made."
+ (let ((org-release "9.0"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of org-mode.
- Inserted by installing org-mode or when a release is made."
- (let ((org-git-version "8.3.4-dist"))
+Inserted by installing Org or when a release is made."
+ (let ((org-git-version "9.0-dist"))
org-git-version))
;;;###autoload
(defvar org-odt-data-dir "/usr/share/emacs/etc/org"
diff --git a/lisp/org-w3m.el b/lisp/org-w3m.el
index 894dbef..2f40169 100644
--- a/lisp/org-w3m.el
+++ b/lisp/org-w3m.el
@@ -1,4 +1,4 @@
-;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode
+;;; org-w3m.el --- Support from Copy and Paste From w3m -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
@@ -25,9 +25,9 @@
;;; Commentary:
;; This file implements copying HTML content from a w3m buffer and
-;; transforming the text on the fly so that it can be pasted into
-;; an org-mode buffer with hot links. It will also work for regions
-;; in gnus buffers that have been washed with w3m.
+;; transforming the text on the fly so that it can be pasted into an
+;; Org buffer with hot links. It will also work for regions in gnus
+;; buffers that have been washed with w3m.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -35,7 +35,7 @@
;; Richard Riley <rileyrgdev at googlemail dot com>
;;
-;; The idea of transforming the HTML content with org-mode style is
+;; The idea of transforming the HTML content with Org syntax is
;; proposed by Richard, I'm just coding it.
;;
@@ -46,7 +46,7 @@
(defvar w3m-current-url)
(defvar w3m-current-title)
-(add-hook 'org-store-link-functions 'org-w3m-store-link)
+(org-link-set-parameters "w3m" :store #'org-w3m-store-link)
(defun org-w3m-store-link ()
"Store a link to a w3m buffer."
(when (eq major-mode 'w3m-mode)
@@ -60,7 +60,7 @@
"Copy current buffer content or active region with `org-mode' style links.
This will encode `link-title' and `link-location' with
`org-make-link-string', and insert the transformed test into the kill ring,
-so that it can be yanked into an Org-mode buffer with links working correctly."
+so that it can be yanked into an Org buffer with links working correctly."
(interactive)
(let* ((regionp (org-region-active-p))
(transform-start (point-min))
@@ -107,7 +107,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly."
(concat return-content
(buffer-substring (point) transform-end))))
(org-kill-new return-content)
- (message "Transforming links...done, use C-y to insert text into Org-mode file")
+ (message "Transforming links...done, use C-y to insert text into Org file")
(message "Copy with link transformation complete."))))
(defun org-w3m-get-anchor-start ()
diff --git a/lisp/org.el b/lisp/org.el
index af68539..e2cc3ab 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -1,4 +1,4 @@
-;;; org.el --- Outline-based notes management and organizer
+;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*-
;; Carstens outline-mode for keeping track of everything.
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -25,23 +25,24 @@
;;
;;; Commentary:
;;
-;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
+;; Org is a mode for keeping notes, maintaining ToDo lists, and doing
;; project planning with a fast and effective plain-text system.
;;
-;; Org-mode develops organizational tasks around NOTES files that contain
-;; information about projects as plain text. Org-mode is implemented on
-;; top of outline-mode, which makes it possible to keep the content of
-;; large files well structured. Visibility cycling and structure editing
-;; help to work with the tree. Tables are easily created with a built-in
-;; table editor. Org-mode supports ToDo items, deadlines, time stamps,
-;; and scheduling. It dynamically compiles entries into an agenda that
-;; utilizes and smoothly integrates much of the Emacs calendar and diary.
-;; Plain text URL-like links connect to websites, emails, Usenet
-;; messages, BBDB entries, and any files related to the projects. For
-;; printing and sharing of notes, an Org-mode file can be exported as a
-;; structured ASCII file, as HTML, or (todo and agenda items only) as an
-;; iCalendar file. It can also serve as a publishing tool for a set of
-;; linked webpages.
+;; Org mode develops organizational tasks around NOTES files that
+;; contain information about projects as plain text. Org mode is
+;; implemented on top of outline-mode, which makes it possible to keep
+;; the content of large files well structured. Visibility cycling and
+;; structure editing help to work with the tree. Tables are easily
+;; created with a built-in table editor. Org mode supports ToDo
+;; items, deadlines, time stamps, and scheduling. It dynamically
+;; compiles entries into an agenda that utilizes and smoothly
+;; integrates much of the Emacs calendar and diary. Plain text
+;; URL-like links connect to websites, emails, Usenet messages, BBDB
+;; entries, and any files related to the projects. For printing and
+;; sharing of notes, an Org file can be exported as a structured ASCII
+;; file, as HTML, or (todo and agenda items only) as an iCalendar
+;; file. It can also serve as a publishing tool for a set of linked
+;; webpages.
;;
;; Installation and Activation
;; ---------------------------
@@ -51,11 +52,11 @@
;;
;; Documentation
;; -------------
-;; The documentation of Org-mode can be found in the TeXInfo file. The
+;; The documentation of Org mode can be found in the TeXInfo file. The
;; distribution also contains a PDF version of it. At the homepage of
-;; Org-mode, you can read the same text online as HTML. There is also an
+;; Org mode, you can read the same text online as HTML. There is also an
;; excellent reference card made by Philip Rooke. This card can be found
-;; in the etc/ directory of Emacs 22.
+;; in the doc/ directory.
;;
;; A list of recent changes can be found at
;; http://orgmode.org/Changes.html
@@ -63,21 +64,20 @@
;;; Code:
(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
-(defvar org-table-formula-constants-local nil
+(defvar-local org-table-formula-constants-local nil
"Local version of `org-table-formula-constants'.")
-(make-variable-buffer-local 'org-table-formula-constants-local)
;;;; Require other packages
-(eval-when-compile
- (require 'cl)
- (require 'gnus-sum))
+(require 'cl-lib)
+
+(eval-when-compile (require 'gnus-sum))
(require 'calendar)
(require 'find-func)
(require 'format-spec)
-(or (equal this-command 'eval-buffer)
+(or (eq this-command 'eval-buffer)
(condition-case nil
(load (concat (file-name-directory load-file-name)
"org-loaddefs.el")
@@ -110,24 +110,17 @@ sure that we are at the beginning of the line.")
"Matches a headline, putting stars and text into groups.
Stars are put in group 1 and the trimmed body in group 2.")
-;; Emacs 22 calendar compatibility: Make sure the new variables are available
-(unless (boundp 'calendar-view-holidays-initially-flag)
- (org-defvaralias 'calendar-view-holidays-initially-flag
- 'view-calendar-holidays-initially))
-(unless (boundp 'calendar-view-diary-initially-flag)
- (org-defvaralias 'calendar-view-diary-initially-flag
- 'view-diary-entries-initially))
-(unless (boundp 'diary-fancy-buffer)
- (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))
-
+(declare-function calendar-check-holidays "holidays" (date))
(declare-function cdlatex-environment "ext:cdlatex" (environment item))
+(declare-function isearch-no-upper-case-p "isearch" (string regexp-flag))
(declare-function org-add-archive-files "org-archive" (files))
(declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom))
-(declare-function org-agenda-list "org-agenda" (&optional arg start-day span))
+(declare-function org-agenda-list "org-agenda"
+ (&optional arg start-day span with-hour))
(declare-function org-agenda-redo "org-agenda" (&optional all))
-(declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body))
+(declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t)
(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
-(declare-function org-beamer-mode "ox-beamer" ())
+(declare-function org-beamer-mode "ox-beamer" (&optional prefix) t)
(declare-function org-clock-get-last-clock-out-time "org-clock" ())
(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
(declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove))
@@ -143,7 +136,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-element-contents "org-element" (element))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-copy "org-element" (datum))
-(declare-function org-element-interpret-data "org-element" (data &optional parent))
+(declare-function org-element-interpret-data "org-element" (data))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-nested-p "org-element" (elem-a elem-b))
(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
@@ -158,12 +151,13 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
(declare-function org-plot/gnuplot "org-plot" (&optional params))
-(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
(declare-function org-table-align "org-table" ())
(declare-function org-table-begin "org-table" (&optional table-type))
(declare-function org-table-beginning-of-field "org-table" (&optional n))
(declare-function org-table-blank-field "org-table" ())
(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg))
+(declare-function org-table-copy-region "org-table" (beg end &optional cut))
+(declare-function org-table-cut-region "org-table" (beg end))
(declare-function org-table-edit-field "org-table" (arg))
(declare-function org-table-end "org-table" (&optional table-type))
(declare-function org-table-end-of-field "org-table" (&optional n))
@@ -173,6 +167,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-table-maybe-recalculate-line "org-table" ())
(declare-function org-table-next-row "org-table" ())
(declare-function org-table-paste-rectangle "org-table" ())
+(declare-function org-table-recalculate "org-table" (&optional all noalign))
(declare-function org-table-wrap-region "org-table" (arg))
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
(declare-function orgtbl-ascii-plot "org-table" (&optional ask))
@@ -186,10 +181,12 @@ Stars are put in group 1 and the trimmed body in group 2.")
"Get text property PROPERTY at the beginning of line."
(get-text-property (point-at-bol) property))
-(defsubst org-trim (s)
- "Remove whitespace at the beginning and the end of string S."
+(defsubst org-trim (s &optional keep-lead)
+ "Remove whitespace at the beginning and the end of string S.
+When optional argument KEEP-LEAD is non-nil, removing blank lines
+at the beginning of the string does not affect leading indentation."
(replace-regexp-in-string
- "\\`[ \t\n\r]+" ""
+ (if keep-lead "\\`\\([ \t]*\n\\)+" "\\`[ \t\n\r]+") ""
(replace-regexp-in-string "[ \t\n\r]+\\'" "" s)))
;; load languages based on value of `org-babel-load-languages'
@@ -199,22 +196,19 @@ Stars are put in group 1 and the trimmed body in group 2.")
(defun org-babel-do-load-languages (sym value)
"Load the languages defined in `org-babel-load-languages'."
(set-default sym value)
- (mapc (lambda (pair)
- (let ((active (cdr pair)) (lang (symbol-name (car pair))))
- (if active
- (progn
- (require (intern (concat "ob-" lang))))
- (progn
- (funcall 'fmakunbound
- (intern (concat "org-babel-execute:" lang)))
- (funcall 'fmakunbound
- (intern (concat "org-babel-expand-body:" lang)))))))
- org-babel-load-languages))
+ (dolist (pair org-babel-load-languages)
+ (let ((active (cdr pair)) (lang (symbol-name (car pair))))
+ (if active
+ (require (intern (concat "ob-" lang)))
+ (funcall 'fmakunbound
+ (intern (concat "org-babel-execute:" lang)))
+ (funcall 'fmakunbound
+ (intern (concat "org-babel-expand-body:" lang)))))))
(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
;;;###autoload
(defun org-babel-load-file (file &optional compile)
- "Load Emacs Lisp source code blocks in the Org-mode FILE.
+ "Load Emacs Lisp source code blocks in the Org FILE.
This function exports the source code using `org-babel-tangle'
and then loads the resulting file using `load-file'. With prefix
arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
@@ -227,7 +221,7 @@ file to byte-code before it is loaded."
(file-attributes file)))))))
(base-name (file-name-sans-extension file))
(exported-file (concat base-name ".el")))
- ;; tangle if the org-mode file is newer than the elisp file
+ ;; tangle if the Org file is newer than the elisp file
(unless (and (file-exists-p exported-file)
(> (funcall age file) (funcall age exported-file)))
;; Tangle-file traversal returns reversed list of tangled files
@@ -242,7 +236,7 @@ file to byte-code before it is loaded."
exported-file)))
(defcustom org-babel-load-languages '((emacs-lisp . t))
- "Languages which can be evaluated in Org-mode buffers.
+ "Languages which can be evaluated in Org buffers.
This list can be used to load support for any of the languages
below, note that each language will depend on a different set of
system executables and/or Emacs modes. When a language is
@@ -300,6 +294,7 @@ requirements) is loaded."
(const :tag "Shen" shen)
(const :tag "Sql" sql)
(const :tag "Sqlite" sqlite)
+ (const :tag "Stan" stan)
(const :tag "ebnf2ps" ebnf2ps))
:value-type (boolean :tag "Activate" :value t)))
@@ -318,34 +313,37 @@ identifier."
;;;###autoload
(defun org-version (&optional here full message)
- "Show the org-mode version.
+ "Show the Org version.
Interactively, or when MESSAGE is non-nil, show it in echo area.
With prefix argument, or when HERE is non-nil, insert it at point.
In non-interactive uses, a reduced version string is output unless
FULL is given."
(interactive (list current-prefix-arg t (not current-prefix-arg)))
- (let* ((org-dir (ignore-errors (org-find-library-dir "org")))
- (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
- (load-suffixes (list ".el"))
- (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs")))
- (org-trash (or
- (and (fboundp 'org-release) (fboundp 'org-git-version))
- (org-load-noerror-mustsuffix (concat org-dir "org-version"))))
- (load-suffixes save-load-suffixes)
- (org-version (org-release))
- (git-version (org-git-version))
- (version (format "Org-mode version %s (%s @ %s)"
- org-version
- git-version
- (if org-install-dir
- (if (string= org-dir org-install-dir)
- org-install-dir
- (concat "mixed installation! " org-install-dir " and " org-dir))
- "org-loaddefs.el can not be found!")))
- (version1 (if full version org-version)))
- (when here (insert version1))
- (when message (message "%s" version1))
- version1))
+ (let ((org-dir (ignore-errors (org-find-library-dir "org")))
+ (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
+ (load-suffixes (list ".el"))
+ (org-install-dir
+ (ignore-errors (org-find-library-dir "org-loaddefs"))))
+ (unless (and (fboundp 'org-release) (fboundp 'org-git-version))
+ (org-load-noerror-mustsuffix (concat org-dir "org-version")))
+ (let* ((load-suffixes save-load-suffixes)
+ (release (org-release))
+ (git-version (org-git-version))
+ (version (format "Org mode version %s (%s @ %s)"
+ release
+ git-version
+ (if org-install-dir
+ (if (string= org-dir org-install-dir)
+ org-install-dir
+ (concat "mixed installation! "
+ org-install-dir
+ " and "
+ org-dir))
+ "org-loaddefs.el can not be found!")))
+ (version1 (if full version release)))
+ (when here (insert version1))
+ (when message (message "%s" version1))
+ version1)))
(defconst org-version (org-version))
@@ -375,15 +373,17 @@ FULL is given."
(defvar org-deadline-string "DEADLINE:"
"String to mark deadline entries.
-A deadline is this string, followed by a time stamp. Should be a word,
-terminated by a colon. You can insert a schedule keyword and
-a timestamp with \\[org-deadline].")
+\\<org-mode-map>
+A deadline is this string, followed by a time stamp. It must be
+a word, terminated by a colon. You can insert a schedule keyword
+and a timestamp with `\\[org-deadline]'.")
(defvar org-scheduled-string "SCHEDULED:"
"String to mark scheduled TODO entries.
-A schedule is this string, followed by a time stamp. Should be a word,
-terminated by a colon. You can insert a schedule keyword and
-a timestamp with \\[org-schedule].")
+\\<org-mode-map>
+A schedule is this string, followed by a time stamp. It must be
+a word, terminated by a colon. You can insert a schedule keyword
+and a timestamp with `\\[org-schedule]'.")
(defconst org-ds-keyword-length
(+ 2
@@ -524,8 +524,9 @@ not contribute to the agenda listings.")
(defconst org-comment-string "COMMENT"
"Entries starting with this keyword will never be exported.
+\\<org-mode-map>
An entry can be toggled between COMMENT and normal with
-\\[org-toggle-comment].")
+`\\[org-toggle-comment]'.")
;;;; LaTeX Environments and Fragments
@@ -633,7 +634,7 @@ After a match, group 1 contains the repeat expression.")
:group 'calendar)
(defcustom org-mode-hook nil
- "Mode hook for Org-mode, run after the mode was turned on."
+ "Mode hook for Org mode, run after the mode was turned on."
:group 'org
:type 'hook)
@@ -655,10 +656,9 @@ After a match, group 1 contains the repeat expression.")
(defun org-load-modules-maybe (&optional force)
"Load all extensions listed in `org-modules'."
(when (or force (not org-modules-loaded))
- (mapc (lambda (ext)
- (condition-case nil (require ext)
- (error (message "Problems while trying to load feature `%s'" ext))))
- org-modules)
+ (dolist (ext org-modules)
+ (condition-case nil (require ext)
+ (error (message "Problems while trying to load feature `%s'" ext))))
(setq org-modules-loaded t)))
(defun org-set-modules (var value)
@@ -694,6 +694,7 @@ For export specific modules, see also `org-export-backends'."
(const :tag " crypt: Encryption of subtrees" org-crypt)
(const :tag " ctags: Access to Emacs tags with links" org-ctags)
(const :tag " docview: Links to doc-view buffers" org-docview)
+ (const :tag " eww: Store link to url of eww" org-eww)
(const :tag " gnus: Links to GNUS folders/messages" org-gnus)
(const :tag " habit: Track your consistency with habits" org-habit)
(const :tag " id: Global IDs for identifying entries" org-id)
@@ -704,41 +705,40 @@ For export specific modules, see also `org-export-backends'."
(const :tag " mouse: Additional mouse support" org-mouse)
(const :tag " protocol: Intercept calls from emacsclient" org-protocol)
(const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
- (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m)
+ (const :tag " w3m: Special cut/paste from w3m to Org mode." org-w3m)
(const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
- (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark)
+ (const :tag "C bookmark: Org links to bookmarks" org-bookmark)
(const :tag "C bullets: Add overlays to headlines stars" org-bullets)
(const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
(const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
(const :tag "C collector: Collect properties into tables" org-collector)
- (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
- (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill)
- (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol)
+ (const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
+ (const :tag "C drill: Flashcards and spaced repetition for Org mode" org-drill)
+ (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol)
(const :tag "C eshell Support for links to working directories in eshell" org-eshell)
(const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
(const :tag "C eval: Include command output as text" org-eval)
- (const :tag "C eww: Store link to url of eww" org-eww)
- (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry)
+ (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry)
(const :tag "C favtable: Lookup table of favorite references and links" org-favtable)
(const :tag "C git-link: Provide org links to specific file version" org-git-link)
(const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
- (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice)
+ (const :tag "C invoice: Help manage client invoices in Org mode" org-invoice)
(const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
(const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
(const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link)
- (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
- (const :tag "C man: Support for links to manpages in Org-mode" org-man)
+ (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix)
+ (const :tag "C man: Support for links to manpages in Org mode" org-man)
(const :tag "C mew: Links to Mew folders/messages" org-mew)
(const :tag "C mtags: Support for muse-like tags" org-mtags)
(const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
(const :tag "C panel: Simple routines for us with bad memory" org-panel)
- (const :tag "C registry: A registry for Org-mode links" org-registry)
- (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen)
+ (const :tag "C registry: A registry for Org links" org-registry)
+ (const :tag "C screen: Visit screen sessions through Org links" org-screen)
(const :tag "C secretary: Team management with org-mode" org-secretary)
- (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert)
- (const :tag "C toc: Table of contents for Org-mode buffer" org-toc)
- (const :tag "C track: Keep up with Org-mode development" org-track)
+ (const :tag "C sqlinsert: Convert Org tables to SQL insertions" orgtbl-sqlinsert)
+ (const :tag "C toc: Table of contents for Org buffer" org-toc)
+ (const :tag "C track: Keep up with Org mode development" org-track)
(const :tag "C velocity Something like Notational Velocity for Org" org-velocity)
(const :tag "C vm: Links to VM folders/messages" org-vm)
(const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes)
@@ -747,8 +747,8 @@ For export specific modules, see also `org-export-backends'."
(defvar org-export-registered-backends) ; From ox.el.
(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
-(declare-function org-export-backend-name "ox" (backend))
-(defcustom org-export-backends '(ascii html icalendar latex)
+(declare-function org-export-backend-name "ox" (backend) t)
+(defcustom org-export-backends '(ascii html icalendar latex odt)
"List of export back-ends that should be always available.
If a description starts with <C>, the file is not part of Emacs
@@ -766,7 +766,7 @@ value of the variable, after updating it:
(progn
(setq org-export-registered-backends
- (org-remove-if-not
+ (cl-remove-if-not
(lambda (backend)
(let ((name (org-export-backend-name backend)))
(or (memq name val)
@@ -789,8 +789,8 @@ Adding a back-end to this list will also pull the back-end it
depends on, if any."
:group 'org
:group 'org-export
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "25.2"
+ :package-version '(Org . "9.0")
:initialize 'custom-initialize-set
:set (lambda (var val)
(if (not (featurep 'ox)) (set-default var val)
@@ -798,7 +798,7 @@ depends on, if any."
;; a parent of any back-end in the new value) is removed from the
;; list of registered back-ends.
(setq org-export-registered-backends
- (org-remove-if-not
+ (cl-remove-if-not
(lambda (backend)
(let ((name (org-export-backend-name backend)))
(or (memq name val)
@@ -840,12 +840,10 @@ depends on, if any."
(const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler)))
(eval-after-load 'ox
- '(mapc
- (lambda (backend)
- (condition-case nil (require (intern (format "ox-%s" backend)))
- (error (message "Problems while trying to load export back-end `%s'"
- backend))))
- org-export-backends))
+ '(dolist (backend org-export-backends)
+ (condition-case nil (require (intern (format "ox-%s" backend)))
+ (error (message "Problems while trying to load export back-end `%s'"
+ backend)))))
(defcustom org-support-shift-select nil
"Non-nil means make shift-cursor commands select text when possible.
@@ -853,7 +851,7 @@ depends on, if any."
In Emacs 23, when `shift-select-mode' is on, shifted cursor keys
start selecting a region, or enlarge regions started in this way.
-In Org-mode, in special contexts, these same keys are used for
+In Org mode, in special contexts, these same keys are used for
other purposes, important enough to compete with shift selection.
Org tries to balance these needs by supporting `shift-select-mode'
outside these special contexts, under control of this variable.
@@ -868,7 +866,7 @@ cursor keys will then execute Org commands in the following contexts:
Outside these contexts, the commands will throw an error.
When this variable is t and the cursor is not in a special
-context, Org-mode will support shift-selection for making and
+context, Org mode will support shift-selection for making and
enlarging regions. To make this more effective, the bullet
cycling will no longer happen anywhere in an item line, but only
if the cursor is exactly on the bullet.
@@ -885,10 +883,7 @@ can be used to switch TODO sets,
and properties can be edited by hand or in column view.
However, when the cursor is on a timestamp, shift-cursor commands
-will still edit the time stamp - this is just too good to give up.
-
-XEmacs user should have this variable set to nil, because
-`shift-select-mode' is in Emacs 23 or later only."
+will still edit the time stamp - this is just too good to give up."
:group 'org
:type '(choice
(const :tag "Never" nil)
@@ -922,12 +917,12 @@ already archived entries."
:group 'org-archive)
(defgroup org-startup nil
- "Options concerning startup of Org-mode."
+ "Options concerning startup of Org mode."
:tag "Org Startup"
:group 'org)
(defcustom org-startup-folded t
- "Non-nil means entering Org-mode will switch to OVERVIEW.
+ "Non-nil means entering Org mode will switch to OVERVIEW.
This can also be configured on a per-file basis by adding one of
the following lines anywhere in the buffer:
@@ -947,9 +942,18 @@ option, set `org-agenda-inhibit-startup' to nil."
(const :tag "show everything, even drawers" showeverything)))
(defcustom org-startup-truncated t
- "Non-nil means entering Org-mode will set `truncate-lines'.
+ "Non-nil means entering Org mode will set `truncate-lines'.
This is useful since some lines containing links can be very long and
-uninteresting. Also tables look terrible when wrapped."
+uninteresting. Also tables look terrible when wrapped.
+
+The variable `org-startup-truncated' allows to configure
+truncation for Org mode different to the other modes that use the
+variable `truncate-lines' and as a shortcut instead of putting
+the variable `truncate-lines' into the `org-mode-hook'. If one
+wants to configure truncation for Org mode not statically but
+dynamically e. g. in a hook like `ediff-prepare-buffer-hook' then
+the variable `truncate-lines' has to be used because in such a
+case it is too late to set the variable `org-startup-truncated'."
:group 'org-startup
:type 'boolean)
@@ -1042,26 +1046,26 @@ the following lines anywhere in the buffer:
:type 'boolean)
(defcustom org-insert-mode-line-in-empty-file nil
- "Non-nil means insert the first line setting Org-mode in empty files.
+ "Non-nil means insert the first line setting Org mode in empty files.
When the function `org-mode' is called interactively in an empty file, this
-normally means that the file name does not automatically trigger Org-mode.
-To ensure that the file will always be in Org-mode in the future, a
-line enforcing Org-mode will be inserted into the buffer, if this option
+normally means that the file name does not automatically trigger Org mode.
+To ensure that the file will always be in Org mode in the future, a
+line enforcing Org mode will be inserted into the buffer, if this option
has been set."
:group 'org-startup
:type 'boolean)
(defcustom org-replace-disputed-keys nil
"Non-nil means use alternative key bindings for some keys.
-Org-mode uses S-<cursor> keys for changing timestamps and priorities.
+Org mode uses S-<cursor> keys for changing timestamps and priorities.
These keys are also used by other packages like shift-selection-mode'
\(built into Emacs 23), `CUA-mode' or `windmove.el'.
-If you want to use Org-mode together with one of these other modes,
-or more generally if you would like to move some Org-mode commands to
+If you want to use Org mode together with one of these other modes,
+or more generally if you would like to move some Org mode commands to
other keys, set this variable and configure the keys with the variable
`org-disputed-keys'.
-This option is only relevant at load-time of Org-mode, and must be set
+This option is only relevant at load-time of Org mode, and must be set
*before* org.el is loaded. Changing it requires a restart of Emacs to
become effective."
:group 'org-startup
@@ -1069,18 +1073,13 @@ become effective."
(defcustom org-use-extra-keys nil
"Non-nil means use extra key sequence definitions for certain commands.
-This happens automatically if you run XEmacs or if `window-system'
-is nil. This variable lets you do the same manually. You must
-set it before loading org.
-
-Example: on Carbon Emacs 22 running graphically, with an external
-keyboard on a Powerbook, the default way of setting M-left might
-not work for either Alt or ESC. Setting this variable will make
-it work for ESC."
+This happens automatically if `window-system' is nil. This
+variable lets you do the same manually. You must set it before
+loading Org."
:group 'org-startup
:type 'boolean)
-(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
+(defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
(defcustom org-disputed-keys
'(([(shift up)] . [(meta p)])
@@ -1089,59 +1088,49 @@ it work for ESC."
([(shift right)] . [(meta +)])
([(control shift right)] . [(meta shift +)])
([(control shift left)] . [(meta shift -)]))
- "Keys for which Org-mode and other modes compete.
+ "Keys for which Org mode and other modes compete.
This is an alist, cars are the default keys, second element specifies
the alternative to use when `org-replace-disputed-keys' is t.
Keys can be specified in any syntax supported by `define-key'.
-The value of this option takes effect only at Org-mode's startup,
+The value of this option takes effect only at Org mode startup,
therefore you'll have to restart Emacs to apply it after changing."
:group 'org-startup
:type 'alist)
(defun org-key (key)
"Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
-Or return the original if not disputed.
-Also apply the translations defined in `org-xemacs-key-equivalents'."
+Or return the original if not disputed."
(when org-replace-disputed-keys
(let* ((nkey (key-description key))
- (x (org-find-if (lambda (x)
- (equal (key-description (car x)) nkey))
- org-disputed-keys)))
+ (x (cl-find-if (lambda (x) (equal (key-description (car x)) nkey))
+ org-disputed-keys)))
(setq key (if x (cdr x) key))))
- (when (featurep 'xemacs)
- (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key)))
key)
-(defun org-find-if (predicate seq)
- (catch 'exit
- (while seq
- (if (funcall predicate (car seq))
- (throw 'exit (car seq))
- (pop seq)))))
-
(defun org-defkey (keymap key def)
"Define a key, possibly translated, as returned by `org-key'."
(define-key keymap (org-key key) def))
(defcustom org-ellipsis nil
- "The ellipsis to use in the Org-mode outline.
+ "The ellipsis to use in the Org mode outline.
+
When nil, just use the standard three dots.
When a string, use that string instead.
-When a face, use the standard 3 dots, but with the specified face.
-The change affects only Org-mode (which will then use its own display table).
-Changing this requires executing \\[org-mode] in a buffer to become
+
+The change affects only Org mode (which will then use its own display table).
+Changing this requires executing `\\[org-mode]' in a buffer to become
effective."
:group 'org-startup
:type '(choice (const :tag "Default" nil)
- (face :tag "Face" :value org-warning)
- (string :tag "String" :value "...#")))
+ (string :tag "String" :value "...#"))
+ :safe #'string-or-null-p)
(defvar org-display-table nil
"The display table for org-mode, in case `org-ellipsis' is non-nil.")
(defgroup org-keywords nil
- "Keywords in Org-mode."
+ "Keywords in Org mode."
:tag "Org Keywords"
:group 'org)
@@ -1154,7 +1143,7 @@ effective."
:type 'boolean)
(defgroup org-structure nil
- "Options concerning the general structure of Org-mode files."
+ "Options concerning the general structure of Org files."
:tag "Org Structure"
:group 'org)
@@ -1163,8 +1152,9 @@ effective."
:tag "Org Reveal Location"
:group 'org-structure)
-(defcustom org-show-context-detail '((isearch . lineage)
+(defcustom org-show-context-detail '((agenda . local)
(bookmark-jump . lineage)
+ (isearch . lineage)
(default . ancestors))
"Alist between context and visibility span when revealing a location.
@@ -1174,8 +1164,8 @@ around point. How much is shown depends on the initial action,
or context. Valid contexts are
agenda when exposing an entry from the agenda
- org-goto when using the command `org-goto' (\\[org-goto])
- occur-tree when using the command `org-occur' (\\[org-sparse-tree] /)
+ org-goto when using the command `org-goto' (`\\[org-goto]')
+ occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /')
tags-tree when constructing a sparse tree based on tags matches
link-search when exposing search matches associated with a link
mark-goto when exposing the jump goal of a mark
@@ -1210,11 +1200,11 @@ As special cases, a nil or t value means show all contexts in
Some views can make displayed information very compact, but also
make it harder to edit the location of the match. In such
-a case, use the command `org-reveal' (\\[org-reveal]) to show
+a case, use the command `org-reveal' (`\\[org-reveal]') to show
more context."
:group 'org-reveal-location
- :version "25.1"
- :package-version '(Org . "8.3")
+ :version "25.2"
+ :package-version '(Org . "9.0")
:type '(choice
(const :tag "Canonical" t)
(const :tag "Minimal" nil)
@@ -1240,8 +1230,10 @@ more context."
(defcustom org-indirect-buffer-display 'other-window
"How should indirect tree buffers be displayed?
+
This applies to indirect buffers created with the commands
-\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer].
+`org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'.
+
Valid values are:
current-window Display in the current window
other-window Just display in another window.
@@ -1311,7 +1303,7 @@ is not set."
:type 'plist)
(defgroup org-cycle nil
- "Options concerning visibility cycling in Org-mode."
+ "Options concerning visibility cycling in Org mode."
:tag "Org Cycle"
:group 'org-structure)
@@ -1336,7 +1328,7 @@ than its value."
(integer :tag "Maximum level")))
(defcustom org-hide-block-startup nil
- "Non-nil means entering Org-mode will fold all blocks.
+ "Non-nil means entering Org mode will fold all blocks.
This can also be set in on a per-file basis with
#+STARTUP: hideblocks
@@ -1347,12 +1339,17 @@ This can also be set in on a per-file basis with
(defcustom org-cycle-global-at-bob nil
"Cycle globally if cursor is at beginning of buffer and not at a headline.
-This makes it possible to do global cycling without having to use S-TAB or
-\\[universal-argument] TAB. For this special case to work, the first line
-of the buffer must not be a headline -- it may be empty or some other text.
+
+This makes it possible to do global cycling without having to use `S-TAB'
+or `\\[universal-argument] TAB'. For this special case to work, the first \
+line of the buffer
+must not be a headline -- it may be empty or some other text.
+
When used in this way, `org-cycle-hook' is disabled temporarily to make
-sure the cursor stays at the beginning of the buffer. When this option is
-nil, don't do anything special at the beginning of the buffer."
+sure the cursor stays at the beginning of the buffer.
+
+When this option is nil, don't do anything special at the beginning of
+the buffer."
:group 'org-cycle
:type 'boolean)
@@ -1391,7 +1388,7 @@ visibility is cycled."
"Number of empty lines needed to keep an empty line between collapsed trees.
If you leave an empty line between the end of a subtree and the following
headline, this empty line is hidden when the subtree is folded.
-Org-mode will leave (exactly) one empty line visible if the number of
+Org mode will leave (exactly) one empty line visible if the number of
empty lines is equal or larger to the number given in this variable.
So the default 2 means at least 2 empty lines after the end of a subtree
are needed to produce free space between a collapsed subtree and the
@@ -1427,11 +1424,11 @@ argument is a symbol. After a global state change, it can have the values
the values `folded', `children', or `subtree'."
:group 'org-cycle
:type 'hook
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3"))
(defgroup org-edit-structure nil
- "Options concerning structure editing in Org-mode."
+ "Options concerning structure editing in Org mode."
:tag "Org Edit Structure"
:group 'org-structure)
@@ -1514,7 +1511,7 @@ This may also be a cons cell where the behavior for `C-a' and
(const :tag "off" nil)
(const :tag "on: before tags first" t)
(const :tag "reversed: after tags first" reversed)))))
-(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
+(defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
(defcustom org-special-ctrl-k nil
"Non-nil means `C-k' will behave specially in headlines.
@@ -1614,9 +1611,11 @@ default the value to be used for all contexts not explicitly
(defcustom org-insert-heading-respect-content nil
"Non-nil means insert new headings after the current subtree.
+\\<org-mode-map>
When nil, the new heading is created directly after the current line.
-The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn
-this variable on for the duration of the command."
+The commands `\\[org-insert-heading-respect-content]' and \
+`\\[org-insert-todo-heading-respect-content]' turn this variable on
+for the duration of the command."
:group 'org-structure
:type 'boolean)
@@ -1626,11 +1625,7 @@ this variable on for the duration of the command."
The value is an alist, with `heading' and `plain-list-item' as CAR,
and a boolean flag as CDR. The cdr may also be the symbol `auto', in
which case Org will look at the surrounding headings/items and try to
-make an intelligent decision whether to insert a blank line or not.
-
-For plain lists, if `org-list-empty-line-terminates-plain-lists' is set,
-the setting here is ignored and no empty line is inserted to avoid breaking
-the list structure."
+make an intelligent decision whether to insert a blank line or not."
:group 'org-edit-structure
:type '(list
(cons (const heading)
@@ -1668,7 +1663,7 @@ When nil, you can use these keybindings to navigate the buffer:
:type 'boolean)
(defgroup org-sparse-trees nil
- "Options concerning sparse trees in Org-mode."
+ "Options concerning sparse trees in Org mode."
:tag "Org Sparse Trees"
:group 'org-structure)
@@ -1691,6 +1686,16 @@ The highlights created by `org-toggle-latex-fragment' always need
:group 'org-time
:type 'boolean)
+(defcustom org-occur-case-fold-search t
+ "Non-nil means `org-occur' should be case-insensitive.
+If set to `smart' the search will be case-insensitive only if it
+doesn't specify any upper case character."
+ :group 'org-sparse-trees
+ :version "25.2"
+ :type '(choice
+ (const :tag "Case-sensitive" nil)
+ (const :tag "Case-insensitive" t)
+ (const :tag "Case-insensitive for lower case searches only" 'smart)))
(defcustom org-occur-hook '(org-first-headline-recenter)
"Hook that is run after `org-occur' has constructed a sparse tree.
@@ -1700,18 +1705,18 @@ as possible."
:type 'hook)
(defgroup org-imenu-and-speedbar nil
- "Options concerning imenu and speedbar in Org-mode."
+ "Options concerning imenu and speedbar in Org mode."
:tag "Org Imenu and Speedbar"
:group 'org-structure)
(defcustom org-imenu-depth 2
- "The maximum level for Imenu access to Org-mode headlines.
+ "The maximum level for Imenu access to Org headlines.
This also applied for speedbar access."
:group 'org-imenu-and-speedbar
:type 'integer)
(defgroup org-table nil
- "Options concerning tables in Org-mode."
+ "Options concerning tables in Org mode."
:tag "Org Table"
:group 'org)
@@ -1728,12 +1733,12 @@ do the following:
TAB or RET are pressed to move to another field. With optimization this
happens only if changes to a field might have changed the column width.
Optimization requires replacing the functions `self-insert-command',
-`delete-char', and `backward-delete-char' in Org-mode buffers, with a
-slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is
-very good at guessing when a re-align will be necessary, but you can always
-force one with \\[org-ctrl-c-ctrl-c].
+`delete-char', and `backward-delete-char' in Org buffers, with a
+slight (in fact: unnoticeable) speed impact for normal typing. Org is very
+good at guessing when a re-align will be necessary, but you can always
+force one with `\\[org-ctrl-c-ctrl-c]'.
-If you would like to use the optimized version in Org-mode, but the
+If you would like to use the optimized version in Org mode, but the
un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
This variable can be used to turn on and off the table editor during a session,
@@ -1746,8 +1751,7 @@ See also the variable `org-table-auto-blank-field'."
(const :tag "on" t)
(const :tag "on, optimized" optimized)))
-(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs)
- (version<= emacs-version "24.1"))
+(defcustom org-self-insert-cluster-for-undo nil
"Non-nil means cluster self-insert commands for undo when possible.
If this is set, then, like in the Emacs command loop, 20 consecutive
characters will be undone together.
@@ -1763,24 +1767,95 @@ calls `table-recognize-table'."
:type 'boolean)
(defgroup org-link nil
- "Options concerning links in Org-mode."
+ "Options concerning links in Org mode."
:tag "Org Link"
:group 'org)
-(defvar org-link-abbrev-alist-local nil
+(defvar-local org-link-abbrev-alist-local nil
"Buffer-local version of `org-link-abbrev-alist', which see.
The value of this is taken from the #+LINK lines.")
-(make-variable-buffer-local 'org-link-abbrev-alist-local)
+
+(defcustom org-link-parameters
+ '(("doi" :follow org--open-doi-link)
+ ("elisp" :follow org--open-elisp-link)
+ ("file" :complete org-file-complete-link)
+ ("ftp" :follow (lambda (path) (browse-url (concat "ftp:" path))))
+ ("help" :follow org--open-help-link)
+ ("http" :follow (lambda (path) (browse-url (concat "http:" path))))
+ ("https" :follow (lambda (path) (browse-url (concat "https:" path))))
+ ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path))))
+ ("message" :follow (lambda (path) (browse-url (concat "message:" path))))
+ ("news" :follow (lambda (path) (browse-url (concat "news:" path))))
+ ("shell" :follow org--open-shell-link))
+ "An alist of properties that defines all the links in Org mode.
+The key in each association is a string of the link type.
+Subsequent optional elements make up a p-list of link properties.
+
+:follow - A function that takes the link path as an argument.
+
+:export - A function that takes the link path, description and
+export-backend as arguments.
+
+:store - A function responsible for storing the link. See the
+function `org-store-link-functions'.
+
+:complete - A function that inserts a link with completion. The
+function takes one optional prefix arg.
+
+:face - A face for the link, or a function that returns a face.
+The function takes one argument which is the link path. The
+default face is `org-link'.
+
+:mouse-face - The mouse-face. The default is `highlight'.
+
+:display - `full' will not fold the link in descriptive
+display. Default is `org-link'.
+
+:help-echo - A string or function that takes (window object position)
+as arguments and returns a string.
+
+:keymap - A keymap that is active on the link. The default is
+`org-mouse-map'.
+
+:htmlize-link - A function for the htmlize-link. Defaults
+to (list :uri \"type:path\")
+
+:activate-func - A function to run at the end of font-lock
+activation. The function must accept (link-start link-end path bracketp)
+as arguments."
+ :group 'org-link
+ :type '(alist :tag "Link display parameters"
+ :value-type plist))
+
+(defun org-link-get-parameter (type key)
+ "Get TYPE link property for KEY.
+TYPE is a string and KEY is a plist keyword."
+ (plist-get
+ (cdr (assoc type org-link-parameters))
+ key))
+
+(defun org-link-set-parameters (type &rest parameters)
+ "Set link TYPE properties to PARAMETERS.
+ PARAMETERS should be :key val pairs."
+ (let ((data (assoc type org-link-parameters)))
+ (if data (setcdr data (org-combine-plists (cdr data) parameters))
+ (push (cons type parameters) org-link-parameters)
+ (org-make-link-regexps)
+ (org-element-update-syntax))))
+
+(defun org-link-types ()
+ "Return a list of known link types."
+ (mapcar #'car org-link-parameters))
(defcustom org-link-abbrev-alist nil
"Alist of link abbreviations.
The car of each element is a string, to be replaced at the start of a link.
The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated
-links in Org-mode buffers can have an optional tag after a double colon, e.g.
+links in Org buffers can have an optional tag after a double colon, e.g.,
[[linkkey:tag][description]]
-The `linkkey' must be a word word, starting with a letter, followed
+The `linkkey' must be a single word, starting with a letter, followed
by letters, numbers, `-' or `_'.
If REPLACE is a string, the tag will simply be appended to create the link.
@@ -1834,7 +1909,7 @@ adaptive Use relative path for files in the current directory and sub-
(defvaralias 'org-activate-links 'org-highlight-links)
(defcustom org-highlight-links '(bracket angle plain radio tag date footnote)
- "Types of links that should be highlighted in Org-mode files.
+ "Types of links that should be highlighted in Org files.
This is a list of symbols, each one of them leading to the
highlighting of a certain link type.
@@ -1877,7 +1952,7 @@ return the description to use."
:type '(choice (const nil) (function)))
(defgroup org-link-store nil
- "Options concerning storing links in Org-mode."
+ "Options concerning storing links in Org mode."
:tag "Org Store Link"
:group 'org-link)
@@ -1922,32 +1997,36 @@ It should match if the message is from the user him/herself."
(defcustom org-context-in-file-links t
"Non-nil means file links from `org-store-link' contain context.
-A search string will be added to the file name with :: as separator and
-used to find the context when the link is activated by the command
+\\<org-mode-map>
+A search string will be added to the file name with :: as separator
+and used to find the context when the link is activated by the command
`org-open-at-point'. When this option is t, the entire active region
will be placed in the search string of the file link. If set to a
positive integer, only the first n lines of context will be stored.
-Using a prefix arg to the command \\[org-store-link] (`org-store-link')
+Using a prefix arg to the command `org-store-link' (`\\[universal-argument] \
+\\[org-store-link]')
negates this setting for the duration of the command."
:group 'org-link-store
:type '(choice boolean integer))
(defcustom org-keep-stored-link-after-insertion nil
"Non-nil means keep link in list for entire session.
-
+\\<org-mode-map>
The command `org-store-link' adds a link pointing to the current
location to an internal list. These links accumulate during a session.
The command `org-insert-link' can be used to insert links into any
-Org-mode file (offering completion for all stored links). When this
-option is nil, every link which has been inserted once using \\[org-insert-link]
-will be removed from the list, to make completing the unused links
-more efficient."
+Org file (offering completion for all stored links).
+
+When this option is nil, every link which has been inserted once using
+`\\[org-insert-link]' will be removed from the list, to make completing the \
+unused
+links more efficient."
:group 'org-link-store
:type 'boolean)
(defgroup org-link-follow nil
- "Options concerning following links in Org-mode."
+ "Options concerning following links in Org mode."
:tag "Org Follow Link"
:group 'org-link)
@@ -1987,8 +2066,8 @@ In tables, the special behavior of RET has precedence."
(defcustom org-mouse-1-follows-link
(if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
"Non-nil means mouse-1 on a link will follow the link.
-A longer mouse click will still set point. Does not work on XEmacs.
-Needs to be set before org.el is loaded."
+A longer mouse click will still set point. Needs to be set
+before org.el is loaded."
:group 'org-link-follow
:version "24.4"
:package-version '(Org . "8.3")
@@ -2074,7 +2153,7 @@ another window."
"Non-nil means use indirect buffer to display infile links.
Activating internal links (from one location in a file to another location
in the same file) normally just jumps to the location. When the link is
-activated with a \\[universal-argument] prefix (or with mouse-3), the link \
+activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \
is displayed in
another window. When this option is set, the other window actually displays
an indirect buffer clone of the current buffer, to avoid any visibility
@@ -2104,7 +2183,7 @@ Shell links can be dangerous: just think about a link
[[shell:rm -rf ~/*][Google Search]]
-This link would show up in your Org-mode document as \"Google Search\",
+This link would show up in your Org document as \"Google Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
Just change it to `y-or-n-p' if you want to confirm with a
@@ -2130,7 +2209,7 @@ Elisp links can be dangerous: just think about a link
[[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
-This link would show up in your Org-mode document as \"Google Search\",
+This link would show up in your Org document as \"Google Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
Just change it to `y-or-n-p' if you want to confirm with a
@@ -2159,30 +2238,23 @@ See `org-file-apps'.")
(defconst org-file-apps-defaults-macosx
'((remote . emacs)
- (t . "open %s")
(system . "open %s")
("ps.gz" . "gv %s")
("eps.gz" . "gv %s")
("dvi" . "xdvi %s")
- ("fig" . "xfig %s"))
+ ("fig" . "xfig %s")
+ (t . "open %s"))
"Default file applications on a MacOS X system.
The system \"open\" is known as a default, but we use X11 applications
for some files for which the OS does not have a good default.
See `org-file-apps'.")
(defconst org-file-apps-defaults-windowsnt
- (list
- '(remote . emacs)
- (cons t
- (list (if (featurep 'xemacs)
- 'mswindows-shell-execute
- 'w32-shell-execute)
- "open" 'file))
- (cons 'system
- (list (if (featurep 'xemacs)
- 'mswindows-shell-execute
- 'w32-shell-execute)
- "open" 'file)))
+ (list '(remote . emacs)
+ (cons 'system (lambda (file _path)
+ (with-no-warnings (w32-shell-execute "open" file))))
+ (cons t (lambda (file _path)
+ (with-no-warnings (w32-shell-execute "open" file)))))
"Default file applications on a Windows NT system.
The system \"open\" is used for most files.
See `org-file-apps'.")
@@ -2193,11 +2265,15 @@ See `org-file-apps'.")
("\\.x?html?\\'" . default)
("\\.pdf\\'" . default))
"External applications for opening `file:path' items in a document.
-Org-mode uses system defaults for different file types, but
+\\<org-mode-map>\
+
+Org mode uses system defaults for different file types, but
you can use this variable to set the application for a given file
extension. The entries in this list are cons cells where the car identifies
-files and the cdr the corresponding command. Possible values for the
-file identifier are
+files and the cdr the corresponding command.
+
+Possible values for the file identifier are:
+
\"string\" A string as a file identifier can be interpreted in different
ways, depending on its contents:
@@ -2210,8 +2286,8 @@ file identifier are
filename matches the regexp. If you want to
use groups here, use shy groups.
- Example: (\"\\.x?html\\\\='\" . \"firefox %s\")
- (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\")
+ Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\")
+ (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\")
to open *.html and *.xhtml with firefox.
- Regular expression which contains (non-shy) groups:
@@ -2223,10 +2299,11 @@ file identifier are
that does not use any of the group matches, this case is
handled identically to the second one (i.e. match against
file name only).
- In a custom lisp form, you can access the group matches with
+ In a custom function, you can access the group matches with
(match-string n link).
- Example: (\"\\.pdf::\\(\\d+\\)\\\\='\" . \"evince -p %1 %s\")
+ Example: (\"\\\\.pdf::\\\\(\\\\d+\\\\)\\\\\\='\" . \
+\"evince -p %1 %s\")
to open [[file:document.pdf::5]] with evince at page 5.
`directory' Matches a directory
@@ -2238,28 +2315,32 @@ file identifier are
command `emacs' will open most files in Emacs. Beware that this
will also open html files inside Emacs, unless you add
(\"html\" . default) to the list as well.
- t Default for files not matched by any of the other options.
`system' The system command to open files, like `open' on Windows
and Mac OS X, and mailcap under GNU/Linux. This is the command
- that will be selected if you call `C-c C-o' with a double
- \\[universal-argument] \\[universal-argument] prefix.
+ that will be selected if you call `org-open-at-point' with a
+ double prefix argument (`\\[universal-argument] \
+\\[universal-argument] \\[org-open-at-point]').
+ t Default for files not matched by any of the other options.
Possible values for the command are:
+
`emacs' The file will be visited by the current Emacs process.
`default' Use the default application for this file type, which is the
association for t in the list, most likely in the system-specific
- part.
- This can be used to overrule an unwanted setting in the
+ part. This can be used to overrule an unwanted setting in the
system-specific variable.
`system' Use the system command for opening files, like \"open\".
This command is specified by the entry whose car is `system'.
Most likely, the system-specific version of this variable
does define this command, but you can overrule/replace it
here.
+`mailcap' Use command specified in the mailcaps.
string A command to be executed by a shell; %s will be replaced
by the path to the file.
- sexp A Lisp form which will be evaluated. The file path will
- be available in the Lisp variable `file'.
+ function A Lisp function, which will be called with two arguments:
+ the file path and the original link string, without the
+ \"file:\" prefix.
+
For more examples, see the system specific constants
`org-file-apps-defaults-macosx'
`org-file-apps-defaults-windowsnt'
@@ -2279,7 +2360,7 @@ For more examples, see the system specific constants
(const :tag "Use default" default)
(const :tag "Use the system command" system)
(string :tag "Command")
- (sexp :tag "Lisp form")))))
+ (function :tag "Function")))))
(defcustom org-doi-server-url "http://dx.doi.org/"
"The URL of the DOI server."
@@ -2288,7 +2369,7 @@ For more examples, see the system specific constants
:group 'org-link-follow)
(defgroup org-refile nil
- "Options concerning refiling entries in Org-mode."
+ "Options concerning refiling entries in Org mode."
:tag "Org Refile"
:group 'org)
@@ -2377,7 +2458,7 @@ will temporarily be changed to `time'."
(const :tag "Record timestamp with note." note)))
(defcustom org-refile-targets nil
- "Targets for refiling entries with \\[org-refile].
+ "Targets for refiling entries with `\\[org-refile]'.
This is a list of cons cells. Each cell contains:
- a specification of the files to be considered, either a list of files,
or a symbol whose function or variable value will be used to retrieve
@@ -2472,13 +2553,13 @@ When `full-file-path', include the full file path."
(defcustom org-outline-path-complete-in-steps t
"Non-nil means complete the outline path in hierarchical steps.
-When Org-mode uses the refile interface to select an outline path
-\(see variable `org-refile-use-outline-path'), the completion of
-the path can be done in a single go, or it can be done in steps down
-the headline hierarchy. Going in steps is probably the best if you
-do not use a special completion package like `ido' or `icicles'.
-However, when using these packages, going in one step can be very
-fast, while still showing the whole path to the entry."
+When Org uses the refile interface to select an outline path (see
+`org-refile-use-outline-path'), the completion of the path can be
+done in a single go, or it can be done in steps down the headline
+hierarchy. Going in steps is probably the best if you do not use
+a special completion package like `ido' or `icicles'. However,
+when using these packages, going in one step can be very fast,
+while still showing the whole path to the entry."
:group 'org-refile
:type 'boolean)
@@ -2511,12 +2592,12 @@ converted to a headline before refiling."
:type 'boolean)
(defgroup org-todo nil
- "Options concerning TODO items in Org-mode."
+ "Options concerning TODO items in Org mode."
:tag "Org TODO"
:group 'org)
(defgroup org-progress nil
- "Options concerning Progress logging in Org-mode."
+ "Options concerning Progress logging in Org mode."
:tag "Org Progress"
:group 'org-time)
@@ -2534,12 +2615,12 @@ Each sequence starts with a symbol, either `sequence' or `type',
indicating if the keywords should be interpreted as a sequence of
action steps, or as different types of TODO items. The first
keywords are states requiring action - these states will select a headline
-for inclusion into the global TODO list Org-mode produces. If one of
-the \"keywords\" is the vertical bar, \"|\", the remaining keywords
+for inclusion into the global TODO list Org produces. If one of the
+\"keywords\" is the vertical bar, \"|\", the remaining keywords
signify that no further action is necessary. If \"|\" is not found,
the last keyword is treated as the only DONE state of the sequence.
-The command \\[org-todo] cycles an entry through these states, and one
+The command `\\[org-todo]' cycles an entry through these states, and one
additional state where no keyword is present. For details about this
cycling, see the manual.
@@ -2590,9 +2671,8 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
(repeat
(string :tag "Keyword"))))))
-(defvar org-todo-keywords-1 nil
+(defvar-local org-todo-keywords-1 nil
"All TODO and DONE keywords active in a buffer.")
-(make-variable-buffer-local 'org-todo-keywords-1)
(defvar org-todo-keywords-for-agenda nil)
(defvar org-done-keywords-for-agenda nil)
(defvar org-todo-keyword-alist-for-agenda nil)
@@ -2600,25 +2680,20 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
"Alist of all tags from all agenda files.")
(defvar org-tag-groups-alist-for-agenda nil
"Alist of all groups tags from all current agenda files.")
-(defvar org-tag-groups-alist nil)
-(make-variable-buffer-local 'org-tag-groups-alist)
+(defvar-local org-tag-groups-alist nil)
(defvar org-agenda-contributing-files nil)
-(defvar org-not-done-keywords nil)
-(make-variable-buffer-local 'org-not-done-keywords)
-(defvar org-done-keywords nil)
-(make-variable-buffer-local 'org-done-keywords)
-(defvar org-todo-heads nil)
-(make-variable-buffer-local 'org-todo-heads)
-(defvar org-todo-sets nil)
-(make-variable-buffer-local 'org-todo-sets)
-(defvar org-todo-log-states nil)
-(make-variable-buffer-local 'org-todo-log-states)
-(defvar org-todo-kwd-alist nil)
-(make-variable-buffer-local 'org-todo-kwd-alist)
-(defvar org-todo-key-alist nil)
-(make-variable-buffer-local 'org-todo-key-alist)
-(defvar org-todo-key-trigger nil)
-(make-variable-buffer-local 'org-todo-key-trigger)
+(defvar-local org-current-tag-alist nil
+ "Alist of all tag groups in current buffer.
+This variable takes into consideration `org-tag-alist',
+`org-tag-persistent-alist' and TAGS keywords in the buffer.")
+(defvar-local org-not-done-keywords nil)
+(defvar-local org-done-keywords nil)
+(defvar-local org-todo-heads nil)
+(defvar-local org-todo-sets nil)
+(defvar-local org-todo-log-states nil)
+(defvar-local org-todo-kwd-alist nil)
+(defvar-local org-todo-key-alist nil)
+(defvar-local org-todo-key-trigger nil)
(defcustom org-todo-interpretation 'sequence
"Controls how TODO keywords are interpreted.
@@ -2633,7 +2708,7 @@ more information."
(defcustom org-use-fast-todo-selection t
"\\<org-mode-map>\
-Non-nil means use the fast todo selection scheme with \\[org-todo].
+Non-nil means use the fast todo selection scheme with `\\[org-todo]'.
This variable describes if and under what circumstances the cycling
mechanism for TODO keywords will be replaced by a single-key, direct
selection scheme.
@@ -2642,7 +2717,7 @@ When nil, fast selection is never used.
When the symbol `prefix', it will be used when `org-todo' is called
with a prefix argument, i.e. `\\[universal-argument] \\[org-todo]' \
-in an Org-mode buffer, and
+in an Org buffer, and
`\\[universal-argument] t' in an agenda buffer.
When t, fast selection is used by default. In this case, the prefix
@@ -2762,7 +2837,7 @@ to change is while Emacs is running is through the customize interface."
(defcustom org-treat-insert-todo-heading-as-state-change nil
"Non-nil means inserting a TODO heading is treated as state change.
-So when the command \\[org-insert-todo-heading] is used, state change
+So when the command `\\[org-insert-todo-heading]' is used, state change
logging will apply if appropriate. When nil, the new TODO item will
be inserted directly, and no logging will take place."
:group 'org-todo
@@ -2966,7 +3041,7 @@ function `org-log-into-drawer' instead."
(const :tag "LOGBOOK" t)
(string :tag "Other")))
-(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
+(defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
(defun org-log-into-drawer ()
"Name of the log drawer, as a string, or nil.
@@ -3045,7 +3120,7 @@ property to one or more of these keywords."
(defgroup org-priorities nil
- "Priorities in Org-mode."
+ "Priorities in Org mode."
:tag "Org Priorities"
:group 'org-todo)
@@ -3103,7 +3178,7 @@ as an argument and return the numeric priority."
(function)))
(defgroup org-time nil
- "Options concerning time stamps and deadlines in Org-mode."
+ "Options concerning time stamps and deadlines in Org mode."
:tag "Org Time"
:group 'org)
@@ -3244,7 +3319,7 @@ in minutes (even for durations longer than an hour)."
(const t)))))
(defcustom org-time-clocksum-use-fractional nil
- "When non-nil, \\[org-clock-display] uses fractional times.
+ "When non-nil, `\\[org-clock-display]' uses fractional times.
See `org-time-clocksum-format' for more on time clock formats."
:group 'org-time
:group 'org-clock
@@ -3252,7 +3327,7 @@ See `org-time-clocksum-format' for more on time clock formats."
:type 'boolean)
(defcustom org-time-clocksum-use-effort-durations nil
- "When non-nil, \\[org-clock-display] uses effort durations.
+ "When non-nil, `\\[org-clock-display]' uses effort durations.
E.g. by default, one day is considered to be a 8 hours effort,
so a task that has been clocked for 16 hours will be displayed
as during 2 days in the clock display or in the clocktable.
@@ -3328,8 +3403,8 @@ This affects the following situations:
For example, if it is April and you enter \"feb 2\", this will be read
as Feb 2, *next* year. \"May 5\", however, will be this year.
2. The user gives a day, but no month.
- For example, if today is the 15th, and you enter \"3\", Org-mode will
- read this as the third of *next* month. However, if you enter \"17\",
+ For example, if today is the 15th, and you enter \"3\", Org will read
+ this as the third of *next* month. However, if you enter \"17\",
it will be considered as *this* month.
If you set this variable to the symbol `time', then also the following
@@ -3408,22 +3483,9 @@ minibuffer will also be active, and you can simply enter the date as well.
When nil, only the minibuffer will be available."
:group 'org-time
:type 'boolean)
-(org-defvaralias 'org-popup-calendar-for-date-prompt
+(defvaralias 'org-popup-calendar-for-date-prompt
'org-read-date-popup-calendar)
-(make-obsolete-variable
- 'org-read-date-minibuffer-setup-hook
- "Set `org-read-date-minibuffer-local-map' instead." "24.4")
-(defcustom org-read-date-minibuffer-setup-hook nil
- "Hook to be used to set up keys for the date/time interface.
-Add key definitions to `minibuffer-local-map', which will be a
-temporary copy.
-
-WARNING: This option is obsolete, you should use
-`org-read-date-minibuffer-local-map' to set up keys."
- :group 'org-time
- :type 'hook)
-
(defcustom org-extend-today-until 0
"The hour when your day really ends. Must be an integer.
This has influence for the following applications:
@@ -3471,58 +3533,76 @@ moved to the new date."
:type 'boolean)
(defgroup org-tags nil
- "Options concerning tags in Org-mode."
+ "Options concerning tags in Org mode."
:tag "Org Tags"
:group 'org)
(defcustom org-tag-alist nil
- "List of tags allowed in Org-mode files.
-When this list is nil, Org-mode will base TAG input on what is already in the
-buffer.
-The value of this variable is an alist, the car of each entry must be a
-keyword as a string, the cdr may be a character that is used to select
-that tag through the fast-tag-selection interface.
-See the manual for details."
+ "Default tags available in Org files.
+
+The value of this variable is an alist. Associations either:
+
+ (TAG)
+ (TAG . SELECT)
+ (SPECIAL)
+
+where TAG is a tag as a string, SELECT is a character, used to
+select that tag through the fast tag selection interface, and
+SPECIAL is one of the following keywords: `:startgroup',
+`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or
+`:newline'. These keywords are used to define a hierarchy of
+tags. See manual for details.
+
+When this variable is nil, Org mode bases tag input on what is
+already in the buffer. The value can be overridden locally by
+using a TAGS keyword, e.g.,
+
+ #+TAGS: tag1 tag2
+
+See also `org-tag-persistent-alist' to sidestep this behavior."
:group 'org-tags
:type '(repeat
(choice
(cons (string :tag "Tag name")
(character :tag "Access char"))
- (list :tag "Start radio group"
- (const :startgroup)
- (option (string :tag "Group description")))
- (list :tag "Start tag group, non distinct"
- (const :startgrouptag)
- (option (string :tag "Group description")))
- (list :tag "Group tags delimiter"
- (const :grouptags))
- (list :tag "End radio group"
- (const :endgroup)
- (option (string :tag "Group description")))
- (list :tag "End tag group, non distinct"
- (const :endgrouptag)
- (option (string :tag "Group description")))
+ (const :tag "Start radio group" (:startgroup))
+ (const :tag "Start tag group, non distinct" (:startgrouptag))
+ (const :tag "Group tags delimiter" (:grouptags))
+ (const :tag "End radio group" (:endgroup))
+ (const :tag "End tag group, non distinct" (:endgrouptag))
(const :tag "New line" (:newline)))))
(defcustom org-tag-persistent-alist nil
- "List of tags that will always appear in all Org-mode files.
-This is in addition to any in buffer settings or customizations
-of `org-tag-alist'.
-When this list is nil, Org-mode will base TAG input on `org-tag-alist'.
-The value of this variable is an alist, the car of each entry must be a
-keyword as a string, the cdr may be a character that is used to select
-that tag through the fast-tag-selection interface.
-See the manual for details.
-To disable these tags on a per-file basis, insert anywhere in the file:
- #+STARTUP: noptag"
+ "Tags always available in Org files.
+
+The value of this variable is an alist. Associations either:
+
+ (TAG)
+ (TAG . SELECT)
+ (SPECIAL)
+
+where TAG is a tag as a string, SELECT is a character, used to
+select that tag through the fast tag selection interface, and
+SPECIAL is one of the following keywords: `:startgroup',
+`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or
+`:newline'. These keywords are used to define a hierarchy of
+tags. See manual for details.
+
+Unlike to `org-tag-alist', tags defined in this variable do not
+depend on a local TAGS keyword. Instead, to disable these tags
+on a per-file basis, insert anywhere in the file:
+
+ #+STARTUP: noptag"
:group 'org-tags
:type '(repeat
(choice
- (cons (string :tag "Tag name")
- (character :tag "Access char"))
+ (cons (string :tag "Tag name")
+ (character :tag "Access char"))
(const :tag "Start radio group" (:startgroup))
+ (const :tag "Start tag group, non distinct" (:startgrouptag))
(const :tag "Group tags delimiter" (:grouptags))
(const :tag "End radio group" (:endgroup))
+ (const :tag "End tag group, non distinct" (:endgrouptag))
(const :tag "New line" (:newline)))))
(defcustom org-complete-tags-always-offer-all-agenda-tags nil
@@ -3533,9 +3613,7 @@ tags in that file can be created dynamically (there are none).
(add-hook \\='org-capture-mode-hook
(lambda ()
- (set (make-local-variable
- \\='org-complete-tags-always-offer-all-agenda-tags)
- t)))"
+ (setq-local org-complete-tags-always-offer-all-agenda-tags t)))"
:group 'org-tags
:version "24.1"
:type 'boolean)
@@ -3577,7 +3655,7 @@ displaying the tags menu is not even shown, until you press C-c again."
"Non-nil means fast tags selection interface will also offer TODO states.
This is an undocumented feature, you should not rely on it.")
-(defcustom org-tags-column (if (featurep 'xemacs) -76 -77)
+(defcustom org-tags-column -77
"The column to which tags should be indented in a headline.
If this number is positive, it specifies the column. If it is negative,
it means that the tags should be flushright to that column. For example,
@@ -3674,7 +3752,7 @@ is better to limit inheritance to certain tags using the variables
"Hook that is run after the tags in a line have changed.")
(defgroup org-properties nil
- "Options concerning properties in Org-mode."
+ "Options concerning properties in Org mode."
:tag "Org Properties"
:group 'org)
@@ -3769,19 +3847,6 @@ ellipses string, only part of the ellipses string will be shown."
:group 'org-properties
:type 'string)
-(defcustom org-columns-modify-value-for-display-function nil
- "Function that modifies values for display in column view.
-For example, it can be used to cut out a certain part from a time stamp.
-The function must take 2 arguments:
-
-column-title The title of the column (*not* the property name)
-value The value that should be modified.
-
-The function should return the value that should be displayed,
-or nil if the normal value should be used."
- :group 'org-properties
- :type '(choice (const nil) (function)))
-
(defconst org-global-properties-fixed
'(("VISIBILITY_ALL" . "folded children content all")
("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
@@ -3812,18 +3877,17 @@ You can set buffer-local values for the same purpose in the variable
(cons (string :tag "Property")
(string :tag "Value"))))
-(defvar org-file-properties nil
+(defvar-local org-file-properties nil
"List of property/value pairs that can be inherited by any entry.
Valid for the current buffer.
This variable is populated from #+PROPERTY lines.")
-(make-variable-buffer-local 'org-file-properties)
(defgroup org-agenda nil
- "Options concerning agenda views in Org-mode."
+ "Options concerning agenda views in Org mode."
:tag "Org Agenda"
:group 'org)
-(defvar org-category nil
+(defvar-local org-category nil
"Variable used by org files to set a category for agenda display.
Such files should use a file variable to set it, for example
@@ -3835,22 +3899,22 @@ or contain a special line
If the file does not specify a category, then file's base name
is used instead.")
-(make-variable-buffer-local 'org-category)
(put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x))))
(defcustom org-agenda-files nil
"The files to be used for agenda display.
-Entries may be added to this list with \\[org-agenda-file-to-front] and removed with
-\\[org-remove-file]. You can also use customize to edit the list.
-If an entry is a directory, all files in that directory that are matched by
-`org-agenda-file-regexp' will be part of the file list.
+If an entry is a directory, all files in that directory that are matched
+by `org-agenda-file-regexp' will be part of the file list.
If the value of the variable is not a list but a single file name, then
-the list of agenda files is actually stored and maintained in that file, one
-agenda file per line. In this file paths can be given relative to
+the list of agenda files is actually stored and maintained in that file,
+one agenda file per line. In this file paths can be given relative to
`org-directory'. Tilde expansion and environment variable substitution
-are also made."
+are also made.
+
+Entries may be added to this list with `\\[org-agenda-file-to-front]'
+and removed with `\\[org-remove-file]'."
:group 'org-agenda
:type '(choice
(repeat :tag "List of files and directories" file)
@@ -3881,7 +3945,7 @@ scope."
(const :tag "Agenda Archives" agenda-archives)
(repeat :inline t (file))))
-(org-defvaralias 'org-agenda-multi-occur-extra-files
+(defvaralias 'org-agenda-multi-occur-extra-files
'org-agenda-text-search-extra-files)
(defcustom org-agenda-skip-unavailable-files nil
@@ -3901,7 +3965,7 @@ forth between agenda and calendar."
(defcustom org-calendar-insert-diary-entry-key [?i]
"The key to be installed in `calendar-mode-map' for adding diary entries.
This option is irrelevant until `org-agenda-diary-file' has been configured
-to point to an Org-mode file. When that is the case, the command
+to point to an Org file. When that is the case, the command
`org-agenda-diary-entry' will be bound to the key given here, by default
`i'. In the calendar, `i' normally adds entries to `diary-file'. So
if you want to continue doing this, you need to change this to a different
@@ -3931,7 +3995,7 @@ points to a file, `org-agenda-diary-entry' will be used instead."
'org-agenda-diary-entry))))))
(defgroup org-latex nil
- "Options for embedding LaTeX code into Org-mode."
+ "Options for embedding LaTeX code into Org mode."
:tag "Org LaTeX"
:group 'org)
@@ -4003,27 +4067,114 @@ When using LaTeXML set this option to
(const :tag "None" nil)
(string :tag "\nShell command")))
-(defcustom org-latex-create-formula-image-program 'dvipng
- "Program to convert LaTeX fragments with.
-
-dvipng Process the LaTeX fragments to dvi file, then convert
- dvi files to png files using dvipng.
- This will also include processing of non-math environments.
-imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
- to convert pdf files to png files"
+(defcustom org-preview-latex-default-process 'dvipng
+ "The default process to convert LaTeX fragments to image files.
+All available processes and theirs documents can be found in
+`org-preview-latex-process-alist', which see."
:group 'org-latex
- :version "24.1"
- :type '(choice
- (const :tag "dvipng" dvipng)
- (const :tag "imagemagick" imagemagick)))
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :type 'symbol)
+
+(defcustom org-preview-latex-process-alist
+ '((dvipng
+ :programs ("latex" "dvipng" "gs")
+ :description "dvi > png"
+ :message "you need to install the programs: latex, dvipng and ghostscript."
+ :image-input-type "dvi"
+ :image-output-type "png"
+ :image-size-adjust (1.0 . 1.0)
+ :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
+ :image-converter ("dvipng -fg %F -bg %B -D %D -T tight -o %b.png %f"))
+ (dvisvgm
+ :programs ("latex" "dvisvgm" "gs")
+ :description "dvi > svg"
+ :message "you need to install the programs: latex, dvisvgm and ghostscript."
+ :use-xcolor t
+ :image-input-type "dvi"
+ :image-output-type "svg"
+ :image-size-adjust (1.7 . 1.5)
+ :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
+ :image-converter ("dvisvgm %f -n -b min -c %S -o %b.svg"))
+ (imagemagick
+ :programs ("latex" "convert" "gs")
+ :description "pdf > png"
+ :message
+ "you need to install the programs: latex, imagemagick and ghostscript."
+ :use-xcolor t
+ :image-input-type "pdf"
+ :image-output-type "png"
+ :image-size-adjust (1.0 . 1.0)
+ :latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f")
+ :image-converter
+ ("convert -density %D -trim -antialias %f -quality 100 %b.png")))
+ "Definitions of external processes for LaTeX previewing.
+Org mode can use some external commands to generate TeX snippet's images for
+previewing or inserting into HTML files, e.g., \"dvipng\". This variable tells
+`org-create-formula-image' how to call them.
+
+The value is an alist with the pattern (NAME . PROPERTIES). NAME is a symbol.
+PROPERTIES accepts the following attributes:
+
+ :programs list of strings, required programs.
+ :description string, describe the process.
+ :message string, message it when required programs cannot be found.
+ :image-input-type string, input file type of image converter (e.g., \"dvi\").
+ :image-output-type string, output file type of image converter (e.g., \"png\").
+ :use-xcolor boolean, when non-nil, LaTeX \"xcolor\" macro is used to
+ deal with background and foreground color of image.
+ Otherwise, dvipng style background and foregroud color
+ format are generated. You may then refer to them in
+ command options with \"%F\" and \"%B\".
+ :image-size-adjust cons of numbers, the car element is used to adjust LaTeX
+ image size showed in buffer and the cdr element is for
+ HTML file. This option is only useful for process
+ developers, users should use variable
+ `org-format-latex-options' instead.
+ :post-clean list of strings, files matched are to be cleaned up once
+ the image is generated. When nil, the files with \".dvi\",
+ \".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\",
+ \".png\", \".jpg\", \".jpeg\" or \".out\" extension will
+ be cleaned up.
+ :latex-header list of strings, the LaTeX header of the snippet file.
+ When nil, the fallback value is used instead, which is
+ controlled by `org-format-latex-header',
+ `org-latex-default-packages-alist' and
+ `org-latex-packages-alist', which see.
+ :latex-compiler list of LaTeX commands, as strings. Each of them is given
+ to the shell. Place-holders \"%t\", \"%b\" and \"%o\" are
+ replaced with values defined below.
+ :image-converter list of image converter commands strings. Each of them is
+ given to the shell and supports any of the following
+ place-holders defined below.
+
+Place-holders used by `:image-converter' and `:latex-compiler':
+
+ %f input file name.
+ %b base name of input file.
+ %o base directory of input file.
+
+Place-holders only used by `:image-converter':
+
+ %F foreground of image
+ %B background of image
+ %D dpi, which is used to adjust image size by some processing commands.
+ %S the image size scale ratio, which is used to adjust image size by some
+ processing commands."
+ :group 'org-latex
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :type '(alist :tag "LaTeX to image backends"
+ :value-type (plist)))
-(defcustom org-latex-preview-ltxpng-directory "ltxpng/"
+(defcustom org-preview-latex-image-directory "ltximg/"
"Path to store latex preview images.
A relative path here creates many directories relative to the
processed org files paths. An absolute path puts all preview
images at the same place."
:group 'org-latex
- :version "24.3"
+ :version "25.2"
+ :package-version '(Org . "9.0")
:type 'string)
(defun org-format-latex-mathml-available-p ()
@@ -4083,9 +4234,8 @@ header, or they will be appended."
(default-value var)))
(defcustom org-latex-default-packages-alist
- '(("AUTO" "inputenc" t)
- ("T1" "fontenc" t)
- ("" "fixltx2e" nil)
+ '(("AUTO" "inputenc" t ("pdflatex"))
+ ("T1" "fontenc" t ("pdflatex"))
("" "graphicx" t)
("" "grffile" t)
("" "longtable" nil)
@@ -4106,7 +4256,6 @@ The packages in this list are needed by one part or another of
Org mode to function properly:
- inputenc, fontenc: for basic font and character selection
-- fixltx2e: Important patches of LaTeX itself
- graphicx: for including images
- grffile: allow periods and spaces in graphics file names
- longtable: For multipage tables
@@ -4128,18 +4277,21 @@ a string.
A cell is of the format
- (\"options\" \"package\" SNIPPET-FLAG)
+ (\"options\" \"package\" SNIPPET-FLAG COMPILERS)
If SNIPPET-FLAG is non-nil, the package also needs to be included
when compiling LaTeX snippets into images for inclusion into
-non-LaTeX output.
+non-LaTeX output. COMPILERS is a list of compilers that should
+include the package, see `org-latex-compiler'. If the document
+compiler is not in the list, and the list is non-nil, the package
+will not be inserted in the final document.
A string will be inserted as-is in the header of the document."
:group 'org-latex
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(repeat
(choice
@@ -4184,7 +4336,7 @@ Make sure that you only list packages here which:
(string :tag "A line of LaTeX"))))
(defgroup org-appearance nil
- "Settings for Org-mode appearance."
+ "Settings for Org mode appearance."
:tag "Org Appearance"
:group 'org)
@@ -4366,7 +4518,7 @@ After a match, the match groups contain these elements:
;; set this option proved cumbersome. See this message/thread:
;; http://article.gmane.org/gmane.emacs.orgmode/68681
(defvar org-emphasis-regexp-components
- '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n,\"'" "." 1)
+ '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1)
"Components used to build the regular expression for emphasis.
This is a list with five entries. Terminology: In an emphasis string
like \" *strong word* \", we call the initial space PREMATCH, the final
@@ -4384,17 +4536,17 @@ newline The maximum number of newlines allowed in an emphasis exp.
You need to reload Org or to restart Emacs after customizing this.")
(defcustom org-emphasis-alist
- `(("*" bold)
+ '(("*" bold)
("/" italic)
("_" underline)
("=" org-verbatim verbatim)
("~" org-code verbatim)
- ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t))))
+ ("+" (:strike-through t)))
"Alist of characters and faces to emphasize text.
Text starting and ending with a special character will be emphasized,
for example *bold*, _underlined_ and /italic/. This variable sets the
marker characters and the face to be used by font-lock for highlighting
-in Org-mode Emacs buffers.
+in Org buffers.
You need to reload Org or to restart Emacs after customizing this."
:group 'org-appearance
@@ -4409,98 +4561,68 @@ You need to reload Org or to restart Emacs after customizing this."
(plist :tag "Face property list"))
(option (const verbatim)))))
-(defvar org-protecting-blocks
- '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R")
+(defvar org-protecting-blocks '("src" "example" "export")
"Blocks that contain text that is quoted, i.e. not processed as Org syntax.
This is needed for font-lock setup.")
-;;; Miscellaneous options
-
-(defgroup org-completion nil
- "Completion in Org-mode."
- :tag "Org Completion"
- :group 'org)
-
-(defcustom org-completion-use-ido nil
- "Non-nil means use ido completion wherever possible.
-Note that `ido-mode' must be active for this variable to be relevant.
-If you decide to turn this variable on, you might well want to turn off
-`org-outline-path-complete-in-steps'.
-See also `org-completion-use-iswitchb'."
- :group 'org-completion
- :type 'boolean)
-
-(defcustom org-completion-use-iswitchb nil
- "Non-nil means use iswitchb completion wherever possible.
-Note that `iswitchb-mode' must be active for this variable to be relevant.
-If you decide to turn this variable on, you might well want to turn off
-`org-outline-path-complete-in-steps'.
-Note that this variable has only an effect if `org-completion-use-ido' is nil."
- :group 'org-completion
- :type 'boolean)
-
-(defcustom org-completion-fallback-command 'hippie-expand
- "The expansion command called by \\[pcomplete] in normal context.
-Normal means, no org-mode-specific context."
- :group 'org-completion
- :type 'function)
-
;;; Functions and variables from their packages
;; Declared here to avoid compiler warnings
-
-;; XEmacs only
-(defvar outline-mode-menu-heading)
-(defvar outline-mode-menu-show)
-(defvar outline-mode-menu-hide)
-(defvar zmacs-regions) ; XEmacs regions
-
-;; Emacs only
(defvar mark-active)
;; Various packages
-(declare-function calendar-iso-to-absolute "cal-iso" (date))
-(declare-function calendar-forward-day "cal-move" (arg))
-(declare-function calendar-goto-date "cal-move" (date))
-(declare-function calendar-goto-today "cal-move" ())
-(declare-function calendar-iso-from-absolute "cal-iso" (date))
-(defvar calc-embedded-close-formula)
-(defvar calc-embedded-open-formula)
-(declare-function cdlatex-tab "ext:cdlatex" ())
+(declare-function calc-eval "calc" (str &optional separator &rest args))
+(declare-function calendar-forward-day "cal-move" (arg))
+(declare-function calendar-goto-date "cal-move" (date))
+(declare-function calendar-goto-today "cal-move" ())
+(declare-function calendar-iso-from-absolute "cal-iso" (date))
+(declare-function calendar-iso-to-absolute "cal-iso" (date))
(declare-function cdlatex-compute-tables "ext:cdlatex" ())
-(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
-(defvar font-lock-unfontify-region-function)
-(declare-function iswitchb-read-buffer "iswitchb"
- (prompt &optional default require-match start matches-set))
-(defvar iswitchb-temp-buflist)
-(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
-(defvar org-agenda-tags-todo-honor-ignore-options)
-(declare-function org-agenda-skip "org-agenda" ())
-(declare-function
- org-agenda-format-item "org-agenda"
- (extra txt &optional level category tags dotime noprefix remove-re habitp))
-(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
-(declare-function org-agenda-change-all-lines "org-agenda"
+(declare-function cdlatex-tab "ext:cdlatex" ())
+(declare-function dired-get-filename
+ "dired"
+ (&optional localp no-error-if-not-filep))
+(declare-function iswitchb-read-buffer
+ "iswitchb"
+ (prompt &optional
+ default require-match _predicate start matches-set))
+(declare-function org-agenda-change-all-lines
+ "org-agenda"
(newhead hdmarker &optional fixface just-this))
-(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
+(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
+ "org-agenda"
+ (&optional end))
+(declare-function org-agenda-copy-local-variable "org-agenda" (var))
+(declare-function org-agenda-format-item
+ "org-agenda"
+ (extra txt &optional level category tags dotime
+ remove-re habitp))
(declare-function org-agenda-maybe-redo "org-agenda" ())
-(declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda"
+(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
+(declare-function org-agenda-save-markers-for-cut-and-paste
+ "org-agenda"
(beg end))
-(declare-function org-agenda-copy-local-variable "org-agenda" (var))
-(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
- "org-agenda" (&optional end))
-(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
-(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
+(declare-function org-agenda-skip "org-agenda" ())
+(declare-function org-attach-reveal "org-attach" (&optional if-exists))
+(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
+(declare-function org-indent-mode "org-indent" (&optional arg))
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
(declare-function org-inlinetask-goto-end "org-inlinetask" ())
-(declare-function org-indent-mode "org-indent" (&optional arg))
-(declare-function parse-time-string "parse-time" (string))
-(declare-function org-attach-reveal "org-attach" (&optional if-exists))
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
(declare-function orgtbl-send-table "org-table" (&optional maybe))
+(declare-function parse-time-string "parse-time" (string))
+(declare-function speedbar-line-directory "speedbar" (&optional depth))
+
+(defvar align-mode-rules-list)
+(defvar calc-embedded-close-formula)
+(defvar calc-embedded-open-formula)
+(defvar calc-embedded-open-mode)
+(defvar font-lock-unfontify-region-function)
+(defvar iswitchb-temp-buflist)
+(defvar org-agenda-tags-todo-honor-ignore-options)
(defvar remember-data-file)
(defvar texmathp-why)
-(declare-function speedbar-line-directory "speedbar" (&optional depth))
-(declare-function table--at-cell-p "table" (position &optional object at-column))
-(declare-function calc-eval "calc" (str &optional separator &rest args))
;;;###autoload
(defun turn-on-orgtbl ()
@@ -4516,11 +4638,10 @@ If `org-enable-table-editor' is nil, return nil unconditionally."
org-enable-table-editor
(save-excursion
(beginning-of-line)
- (org-looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|")))
+ (looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|")))
(or (not (derived-mode-p 'org-mode))
(let ((e (org-element-lineage (org-element-at-point) '(table) t)))
(and e (or table-type (eq (org-element-property :type e) 'org)))))))
-(defsubst org-table-p () (org-at-table-p))
(defun org-at-table.el-p ()
"Non-nil when point is at a table.el table."
@@ -4529,24 +4650,6 @@ If `org-enable-table-editor' is nil, return nil unconditionally."
(and (eq (org-element-type element) 'table)
(eq (org-element-property :type element) 'table.el)))))
-(defun org-table-recognize-table.el ()
- "If there is a table.el table nearby, recognize it and move into it."
- (when (and org-table-tab-recognizes-table.el (org-at-table.el-p))
- (beginning-of-line)
- (unless (or (looking-at org-table-dataline-regexp)
- (not (looking-at org-table1-hline-regexp)))
- (forward-line)
- (when (looking-at org-table-any-border-regexp)
- (forward-line -2)))
- (if (re-search-forward "|" (org-table-end t) t)
- (progn
- (require 'table)
- (if (table--at-cell-p (point)) t
- (message "recognizing table.el table...")
- (table-recognize-table)
- (message "recognizing table.el table...done")))
- (error "This should not happen"))))
-
(defun org-at-table-hline-p ()
"Non-nil when point is inside a hline in a table.
Assume point is already in a table. If `org-enable-table-editor'
@@ -4558,22 +4661,20 @@ is nil, return nil unconditionally."
(defun org-table-map-tables (function &optional quietly)
"Apply FUNCTION to the start of all tables in the buffer."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward org-table-any-line-regexp nil t)
- (unless quietly
- (message "Mapping tables: %d%%"
- (floor (* 100.0 (point)) (buffer-size))))
- (beginning-of-line 1)
- (when (and (looking-at org-table-line-regexp)
- ;; Exclude tables in src/example/verbatim/clocktable blocks
- (not (org-in-block-p '("src" "example" "verbatim" "clocktable"))))
- (save-excursion (funcall function))
- (or (looking-at org-table-line-regexp)
- (forward-char 1)))
- (re-search-forward org-table-any-border-regexp nil 1))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward org-table-any-line-regexp nil t)
+ (unless quietly
+ (message "Mapping tables: %d%%"
+ (floor (* 100.0 (point)) (buffer-size))))
+ (beginning-of-line 1)
+ (when (and (looking-at org-table-line-regexp)
+ ;; Exclude tables in src/example/verbatim/clocktable blocks
+ (not (org-in-block-p '("src" "example" "verbatim" "clocktable"))))
+ (save-excursion (funcall function))
+ (or (looking-at org-table-line-regexp)
+ (forward-char 1)))
+ (re-search-forward org-table-any-border-regexp nil 1)))
(unless quietly (message "Mapping tables: done")))
(declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end))
@@ -4624,7 +4725,7 @@ If yes, offer to stop it and to save the buffer with the changes."
(add-hook 'kill-emacs-hook 'org-clock-save))
(defgroup org-archive nil
- "Options concerning archiving in Org-mode."
+ "Options concerning archiving in Org mode."
:tag "Org Archive"
:group 'org-structure)
@@ -4639,7 +4740,7 @@ When the filename is omitted, archiving happens in the same file.
%s in the filename will be replaced by the current file
name (without the directory part). Archiving to a different file
is useful to keep archived entries from contributing to the
-Org-mode Agenda.
+Org Agenda.
The archived entries will be filed as subtrees of the specified
headline. When the headline is omitted, the subtrees are simply
@@ -4736,7 +4837,7 @@ Otherwise, these types are allowed:
(const :tag "Only scheduled timestamps" scheduled)
(const :tag "Only deadline timestamps" deadline)
(const :tag "Only closed timestamps" closed))
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:group 'org-sparse-trees)
@@ -4750,9 +4851,10 @@ Otherwise, these types are allowed:
(end (if globalp (point-max) (org-end-of-subtree t))))
(org-hide-archived-subtrees beg end)
(goto-char beg)
- (if (looking-at (concat ".*:" org-archive-tag ":"))
- (message "%s" (substitute-command-keys
- "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
+ (when (looking-at-p (concat ".*:" org-archive-tag ":"))
+ (message "%s" (substitute-command-keys
+ "Subtree is archived and stays closed. Use \
+`\\[org-force-cycle-archived]' to cycle it anyway.")))))))
(defun org-force-cycle-archived ()
"Cycle subtree even if it is archived."
@@ -4788,7 +4890,6 @@ Otherwise, these types are allowed:
;; Declare Column View Code
-(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf))
(declare-function org-columns-get-format-and-top-level "org-colview" ())
(declare-function org-columns-compute "org-colview" (property))
@@ -4801,36 +4902,33 @@ Otherwise, these types are allowed:
;;; Variables for pre-computed regular expressions, all buffer local
-(defvar org-todo-regexp nil
+(defvar-local org-todo-regexp nil
"Matches any of the TODO state keywords.")
-(make-variable-buffer-local 'org-todo-regexp)
-(defvar org-not-done-regexp nil
+(defvar-local org-not-done-regexp nil
"Matches any of the TODO state keywords except the last one.")
-(make-variable-buffer-local 'org-not-done-regexp)
-(defvar org-not-done-heading-regexp nil
+(defvar-local org-not-done-heading-regexp nil
"Matches a TODO headline that is not done.")
-(make-variable-buffer-local 'org-not-done-heading-regexp)
-(defvar org-todo-line-regexp nil
+(defvar-local org-todo-line-regexp nil
"Matches a headline and puts TODO state into group 2 if present.")
-(make-variable-buffer-local 'org-todo-line-regexp)
-(defvar org-complex-heading-regexp nil
+(defvar-local org-complex-heading-regexp nil
"Matches a headline and puts everything into groups:
+
group 1: the stars
group 2: The todo keyword, maybe
group 3: Priority cookie
group 4: True headline
-group 5: Tags")
-(make-variable-buffer-local 'org-complex-heading-regexp)
-(defvar org-complex-heading-regexp-format nil
+group 5: Tags
+
+Since TODO keywords are case-sensitive, `case-fold-search' is
+expected to be bound to nil when matching this regexp.")
+(defvar-local org-complex-heading-regexp-format nil
"Printf format to make regexp to match an exact headline.
This regexp will match the headline of any node which has the
exact headline text that is put into the format, but may have any
TODO state, priority and tags.")
-(make-variable-buffer-local 'org-complex-heading-regexp-format)
-(defvar org-todo-line-tags-regexp nil
+(defvar-local org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present.
Also put tags into group 4 if tags are present.")
-(make-variable-buffer-local 'org-todo-line-tags-regexp)
(defconst org-plain-time-of-day-regexp
(concat
@@ -4971,24 +5069,44 @@ related expressions."
'("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS"
"LINK" "OPTIONS" "PRIORITIES" "PROPERTY"
"SEQ_TODO" "STARTUP" "TODO" "TYP_TODO")))))))
- (org--setup-process-tags
- (cdr (assq 'tags alist)) (cdr (assq 'filetags alist)))
+ ;; Startup options. Get this early since it does change
+ ;; behavior for other options (e.g., tags).
+ (let ((startup (cdr (assq 'startup alist))))
+ (dolist (option startup)
+ (let ((entry (assoc-string option org-startup-options t)))
+ (when entry
+ (let ((var (nth 1 entry))
+ (val (nth 2 entry)))
+ (if (not (nth 3 entry)) (set (make-local-variable var) val)
+ (unless (listp (symbol-value var))
+ (set (make-local-variable var) nil))
+ (add-to-list var val)))))))
+ (setq-local org-file-tags
+ (mapcar #'org-add-prop-inherited
+ (cdr (assq 'filetags alist))))
+ (setq org-current-tag-alist
+ (append org-tag-persistent-alist
+ (let ((tags (cdr (assq 'tags alist))))
+ (if tags (org-tag-string-to-alist tags)
+ org-tag-alist))))
+ (setq org-tag-groups-alist
+ (org-tag-alist-to-groups org-current-tag-alist))
(unless tags-only
;; File properties.
- (org-set-local 'org-file-properties (cdr (assq 'property alist)))
+ (setq-local org-file-properties (cdr (assq 'property alist)))
;; Archive location.
(let ((archive (cdr (assq 'archive alist))))
- (when archive (org-set-local 'org-archive-location archive)))
+ (when archive (setq-local org-archive-location archive)))
;; Category.
(let ((cat (org-string-nw-p (cdr (assq 'category alist)))))
(when cat
- (org-set-local 'org-category (intern cat))
- (org-set-local 'org-file-properties
- (org--update-property-plist
- "CATEGORY" cat org-file-properties))))
+ (setq-local org-category (intern cat))
+ (setq-local org-file-properties
+ (org--update-property-plist
+ "CATEGORY" cat org-file-properties))))
;; Columns.
(let ((column (cdr (assq 'columns alist))))
- (when column (org-set-local 'org-columns-default-format column)))
+ (when column (setq-local org-columns-default-format column)))
;; Constants.
(setq org-table-formula-constants-local (cdr (assq 'constants alist)))
;; Link abbreviations.
@@ -4997,33 +5115,22 @@ related expressions."
;; Priorities.
(let ((priorities (cdr (assq 'priorities alist))))
(when priorities
- (org-set-local 'org-highest-priority (nth 0 priorities))
- (org-set-local 'org-lowest-priority (nth 1 priorities))
- (org-set-local 'org-default-priority (nth 2 priorities))))
+ (setq-local org-highest-priority (nth 0 priorities))
+ (setq-local org-lowest-priority (nth 1 priorities))
+ (setq-local org-default-priority (nth 2 priorities))))
;; Scripts.
(let ((scripts (assq 'scripts alist)))
(when scripts
- (org-set-local 'org-use-sub-superscripts (cdr scripts))))
- ;; Startup options.
- (let ((startup (cdr (assq 'startup alist))))
- (dolist (option startup)
- (let ((entry (assoc-string option org-startup-options t)))
- (when entry
- (let ((var (nth 1 entry))
- (val (nth 2 entry)))
- (if (not (nth 3 entry)) (org-set-local var val)
- (unless (listp (symbol-value var))
- (org-set-local var nil))
- (add-to-list var val)))))))
+ (setq-local org-use-sub-superscripts (cdr scripts))))
;; TODO keywords.
- (org-set-local 'org-todo-kwd-alist nil)
- (org-set-local 'org-todo-key-alist nil)
- (org-set-local 'org-todo-key-trigger nil)
- (org-set-local 'org-todo-keywords-1 nil)
- (org-set-local 'org-done-keywords nil)
- (org-set-local 'org-todo-heads nil)
- (org-set-local 'org-todo-sets nil)
- (org-set-local 'org-todo-log-states nil)
+ (setq-local org-todo-kwd-alist nil)
+ (setq-local org-todo-key-alist nil)
+ (setq-local org-todo-key-trigger nil)
+ (setq-local org-todo-keywords-1 nil)
+ (setq-local org-done-keywords nil)
+ (setq-local org-todo-heads nil)
+ (setq-local org-todo-sets nil)
+ (setq-local org-todo-log-states nil)
(let ((todo-sequences
(or (nreverse (cdr (assq 'todo alist)))
(let ((d (default-value 'org-todo-keywords)))
@@ -5071,9 +5178,9 @@ related expressions."
;; Compute the regular expressions and other local variables.
;; Using `org-outline-regexp-bol' would complicate them much,
;; because of the fixed white space at the end of that string.
- (if (not org-done-keywords)
- (setq org-done-keywords
- (and org-todo-keywords-1 (last org-todo-keywords-1))))
+ (unless org-done-keywords
+ (setq org-done-keywords
+ (and org-todo-keywords-1 (last org-todo-keywords-1))))
(setq org-not-done-keywords
(org-delete-all org-done-keywords
(copy-sequence org-todo-keywords-1))
@@ -5088,7 +5195,7 @@ related expressions."
"\\(?: +" org-todo-regexp "\\)?"
"\\(?: +\\(\\[#.\\]\\)\\)?"
"\\(?: +\\(.*?\\)\\)??"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
+ "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?"
"[ \t]*$")
org-complex-heading-regexp-format
(concat "^\\(\\*+\\)"
@@ -5100,13 +5207,13 @@ related expressions."
"\\(%s\\)"
"\\(?: *\\[[0-9%%/]+\\]\\)*"
"\\)"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
+ "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?"
"[ \t]*$")
org-todo-line-tags-regexp
(concat "^\\(\\*+\\)"
"\\(?: +" org-todo-regexp "\\)?"
"\\(?: +\\(.*?\\)\\)??"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
+ "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?"
"[ \t]*$"))
(org-compute-latex-and-related-regexp)))))
@@ -5158,8 +5265,8 @@ Return value contains the following keys: `archive', `category',
((equal key "LINK")
(when (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value)
(let ((links (assq 'link alist))
- (pair (cons (org-match-string-no-properties 1 value)
- (org-match-string-no-properties 2 value))))
+ (pair (cons (match-string-no-properties 1 value)
+ (match-string-no-properties 2 value))))
(if links (push pair (cdr links))
(push (list 'link pair) alist)))))
((equal key "OPTIONS")
@@ -5176,8 +5283,8 @@ Return value contains the following keys: `archive', `category',
(when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value)
(let* ((property (assq 'property alist))
(value (org--update-property-plist
- (org-match-string-no-properties 1 value)
- (org-match-string-no-properties 2 value)
+ (match-string-no-properties 1 value)
+ (match-string-no-properties 2 value)
(cdr property))))
(if property (setcdr property value)
(push (cons 'property value) alist)))))
@@ -5190,11 +5297,8 @@ Return value contains the following keys: `archive', `category',
((equal key "TAGS")
(let ((tag-cell (assq 'tags alist)))
(if tag-cell
- (setcdr tag-cell
- (append (cdr tag-cell)
- '("\\n")
- (org-split-string value)))
- (push (cons 'tags (org-split-string value)) alist))))
+ (setcdr tag-cell (concat (cdr tag-cell) "\n" value))
+ (push (cons 'tags value) alist))))
((member key '("TODO" "SEQ_TODO" "TYP_TODO"))
(let ((todo (assq 'todo alist))
(value (cons (if (equal key "TYP_TODO") 'type 'sequence)
@@ -5205,7 +5309,7 @@ Return value contains the following keys: `archive', `category',
(unless buffer-read-only ; Do not check in Gnus messages.
(let ((f (and (org-string-nw-p value)
(expand-file-name
- (org-remove-double-quotes value)))))
+ (org-unbracket-string "\"" "\"" value)))))
(when (and f (file-readable-p f) (not (member f files)))
(with-temp-buffer
(setq default-directory (file-name-directory f))
@@ -5218,67 +5322,93 @@ Return value contains the following keys: `archive', `category',
regexp (cons f files) alist)))))))))))))))
alist)
-(defun org--setup-process-tags (tags filetags)
- "Precompute variables used for tags.
-TAGS is a list of tags and tag group symbols, as strings.
-FILETAGS is a list of tags, as strings."
- ;; Process the file tags.
- (org-set-local 'org-file-tags
- (mapcar #'org-add-prop-inherited filetags))
- ;; Provide default tags if no local tags are found.
- (when (and (not tags) org-tag-alist)
- (setq tags
- (mapcar (lambda (tag)
- (case (car tag)
- (:startgroup "{")
- (:endgroup "}")
- (:startgrouptag "[")
- (:endgrouptag "]")
- (:grouptags ":")
- (:newline "\\n")
- (otherwise (concat (car tag)
- (and (characterp (cdr tag))
- (format "(%c)" (cdr tag)))))))
- org-tag-alist)))
- ;; Process the tags.
- (org-set-local 'org-tag-groups-alist nil)
- (org-set-local 'org-tag-alist nil)
- (let (group-flag)
- (while tags
- (let ((e (car tags)))
- (setq tags (cdr tags))
- (cond
- ((equal e "{")
- (push '(:startgroup) org-tag-alist)
- (when (equal (nth 1 tags) ":") (setq group-flag t)))
- ((equal e "}")
- (push '(:endgroup) org-tag-alist)
- (setq group-flag nil))
- ((equal e "[")
- (push '(:startgrouptag) org-tag-alist)
- (when (equal (nth 1 tags) ":") (setq group-flag t)))
- ((equal e "]")
- (push '(:endgrouptag) org-tag-alist)
- (setq group-flag nil))
- ((equal e ":")
- (push '(:grouptags) org-tag-alist)
- (setq group-flag 'append))
- ((equal e "\\n") (push '(:newline) org-tag-alist))
- ((string-match
- (org-re (concat "\\`\\([[:alnum:]_@#%]+"
- "\\|{.+?}\\)" ; regular expression
- "\\(?:(\\(.\\))\\)?\\'")) e)
- (let ((tag (match-string 1 e))
- (key (and (match-beginning 2)
- (string-to-char (match-string 2 e)))))
- (cond ((eq group-flag 'append)
- (setcar org-tag-groups-alist
- (append (car org-tag-groups-alist) (list tag))))
- (group-flag (push (list tag) org-tag-groups-alist)))
- ;; Push all tags in groups, no matter if they already exist.
- (unless (and (not group-flag) (assoc tag org-tag-alist))
- (push (cons tag key) org-tag-alist))))))))
- (setq org-tag-alist (nreverse org-tag-alist)))
+(defun org-tag-string-to-alist (s)
+ "Return tag alist associated to string S.
+S is a value for TAGS keyword or produced with
+`org-tag-alist-to-string'. Return value is an alist suitable for
+`org-tag-alist' or `org-tag-persistent-alist'."
+ (let ((lines (mapcar #'split-string (split-string s "\n" t)))
+ (tag-re (concat "\\`\\([[:alnum:]_@#%]+"
+ "\\|{.+?}\\)" ; regular expression
+ "\\(?:(\\(.\\))\\)?\\'"))
+ alist group-flag)
+ (dolist (tokens lines (cdr (nreverse alist)))
+ (push '(:newline) alist)
+ (while tokens
+ (let ((token (pop tokens)))
+ (pcase token
+ ("{"
+ (push '(:startgroup) alist)
+ (when (equal (nth 1 tokens) ":") (setq group-flag t)))
+ ("}"
+ (push '(:endgroup) alist)
+ (setq group-flag nil))
+ ("["
+ (push '(:startgrouptag) alist)
+ (when (equal (nth 1 tokens) ":") (setq group-flag t)))
+ ("]"
+ (push '(:endgrouptag) alist)
+ (setq group-flag nil))
+ (":"
+ (push '(:grouptags) alist))
+ ((guard (string-match tag-re token))
+ (let ((tag (match-string 1 token))
+ (key (and (match-beginning 2)
+ (string-to-char (match-string 2 token)))))
+ ;; Push all tags in groups, no matter if they already
+ ;; appear somewhere else in the list.
+ (when (or group-flag (not (assoc tag alist)))
+ (push (cons tag key) alist))))))))))
+
+(defun org-tag-alist-to-string (alist &optional skip-key)
+ "Return tag string associated to ALIST.
+
+ALIST is an alist, as defined in `org-tag-alist' or
+`org-tag-persistent-alist', or produced with
+`org-tag-string-to-alist'.
+
+Return value is a string suitable as a value for \"TAGS\"
+keyword.
+
+When optional argument SKIP-KEY is non-nil, skip selection keys
+next to tags."
+ (mapconcat (lambda (token)
+ (pcase token
+ (`(:startgroup) "{")
+ (`(:endgroup) "}")
+ (`(:startgrouptag) "[")
+ (`(:endgrouptag) "]")
+ (`(:grouptags) ":")
+ (`(:newline) "\\n")
+ ((and
+ (guard (not skip-key))
+ `(,(and tag (pred stringp)) . ,(and key (pred characterp))))
+ (format "%s(%c)" tag key))
+ (`(,(and tag (pred stringp)) . ,_) tag)
+ (_ (user-error "Invalid tag token: %S" token))))
+ alist
+ " "))
+
+(defun org-tag-alist-to-groups (alist)
+ "Return group alist from tag ALIST.
+ALIST is an alist, as defined in `org-tag-alist' or
+`org-tag-persistent-alist', or produced with
+`org-tag-string-to-alist'. Return value is an alist following
+the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as
+a string, summarizing TAGS, as a list of strings."
+ (let (groups group-status current-group)
+ (dolist (token alist (nreverse groups))
+ (pcase token
+ (`(,(or :startgroup :startgrouptag)) (setq group-status t))
+ (`(,(or :endgroup :endgrouptag))
+ (when (eq group-status 'append)
+ (push (nreverse current-group) groups))
+ (setq group-status nil))
+ (`(:grouptags) (setq group-status 'append))
+ ((and `(,tag . ,_) (guard group-status))
+ (if (eq group-status 'append) (push tag current-group)
+ (setq current-group (list tag))))
+ (_ nil)))))
(defun org-file-contents (file &optional noerror)
"Return the contents of FILE, as a string."
@@ -5295,12 +5425,10 @@ FILETAGS is a list of tags, as strings."
(defun org-extract-log-state-settings (x)
"Extract the log state setting from a TODO keyword string.
This will extract info from a string like \"WAIT(w@/!)\"."
- (let (kw key log1 log2)
- (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
- (setq kw (match-string 1 x)
- key (and (match-end 2) (match-string 2 x))
- log1 (and (match-end 3) (match-string 3 x))
- log2 (and (match-end 4) (match-string 4 x)))
+ (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
+ (let ((kw (match-string 1 x))
+ (log1 (and (match-end 3) (match-string 3 x)))
+ (log2 (and (match-end 4) (match-string 4 x))))
(and (or log1 log2)
(list kw
(and log1 (if (equal log1 "!") 'time 'note))
@@ -5330,7 +5458,7 @@ Respect keys that are already there."
(pop clist))
(unless clist
(while (rassoc alt used)
- (incf alt)))
+ (cl-incf alt)))
(push (cons (car e) (or (car clist) alt)) new))))
(nreverse new)))
@@ -5343,13 +5471,7 @@ Respect keys that are already there."
(defvar org-finish-function nil
"Function to be called when `C-c C-c' is used.
This is for getting out of special buffers like capture.")
-
-
-;; FIXME: Occasionally check by commenting these, to make sure
-;; no other functions uses these, forgetting to let-bind them.
-(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
(defvar org-last-state)
-(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
;; Defined somewhere in this file, but used before definition.
(defvar org-entities) ;; defined in org-entities.el
@@ -5357,7 +5479,7 @@ This is for getting out of special buffers like capture.")
(defvar org-org-menu)
(defvar org-tbl-menu)
-;;;; Define the Org-mode
+;;;; Define the Org mode
;; We use a before-change function to check if a table might need
;; an update.
@@ -5365,7 +5487,7 @@ This is for getting out of special buffers like capture.")
"Indicates that a table might need an update.
This variable is set by `org-before-change-function'.
`org-table-align' sets it back to nil.")
-(defun org-before-change-function (beg end)
+(defun org-before-change-function (_beg _end)
"Every change indicates that a table might need an update."
(setq org-table-may-need-update t))
(defvar org-mode-map)
@@ -5379,9 +5501,6 @@ This variable is set by `org-before-change-function'.
(defvar buffer-face-mode-face)
(require 'outline)
-(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
- (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22"))
-(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it
;; Other stuff we need.
(require 'time-date)
@@ -5408,15 +5527,15 @@ This variable is set by `org-before-change-function'.
"Outline-based notes management and organizer, alias
\"Carsten's outline-mode for keeping track of everything.\"
-Org-mode develops organizational tasks around a NOTES file which
-contains information about projects as plain text. Org-mode is
-implemented on top of outline-mode, which is ideal to keep the content
+Org mode develops organizational tasks around a NOTES file which
+contains information about projects as plain text. Org mode is
+implemented on top of Outline mode, which is ideal to keep the content
of large files well structured. It supports ToDo items, deadlines and
time stamps, which magically appear in the diary listing of the Emacs
calendar. Tables are easily created with a built-in table editor.
Plain text URL-like links connect to websites, emails (VM), Usenet
messages (Gnus), BBDB entries, and any files related to the project.
-For printing and sharing of notes, an Org-mode file (or a part of it)
+For printing and sharing of notes, an Org file (or a part of it)
can be exported as a structured ASCII or HTML file.
The following commands are available:
@@ -5426,29 +5545,18 @@ The following commands are available:
;; Get rid of Outline menus, they are not needed
;; Need to do this here because define-derived-mode sets up
;; the keymap so late. Still, it is a waste to call this each time
- ;; we switch another buffer into org-mode.
- (if (featurep 'xemacs)
- (when (boundp 'outline-mode-menu-heading)
- ;; Assume this is Greg's port, it uses easymenu
- (easy-menu-remove outline-mode-menu-heading)
- (easy-menu-remove outline-mode-menu-show)
- (easy-menu-remove outline-mode-menu-hide))
- (define-key org-mode-map [menu-bar headings] 'undefined)
- (define-key org-mode-map [menu-bar hide] 'undefined)
- (define-key org-mode-map [menu-bar show] 'undefined))
+ ;; we switch another buffer into Org mode.
+ (define-key org-mode-map [menu-bar headings] 'undefined)
+ (define-key org-mode-map [menu-bar hide] 'undefined)
+ (define-key org-mode-map [menu-bar show] 'undefined)
(org-load-modules-maybe)
- (when (featurep 'xemacs)
- (easy-menu-add org-org-menu)
- (easy-menu-add org-tbl-menu))
(org-install-agenda-files-menu)
- (if org-descriptive-links (add-to-invisibility-spec '(org-link)))
+ (when org-descriptive-links (add-to-invisibility-spec '(org-link)))
(add-to-invisibility-spec '(org-cwidth))
(add-to-invisibility-spec '(org-hide-block . t))
- (when (featurep 'xemacs)
- (org-set-local 'line-move-ignore-invisible t))
- (org-set-local 'outline-regexp org-outline-regexp)
- (org-set-local 'outline-level 'org-outline-level)
+ (setq-local outline-regexp org-outline-regexp)
+ (setq-local outline-level 'org-outline-level)
(setq bidi-paragraph-direction 'left-to-right)
(when (and org-ellipsis
(fboundp 'set-display-table-slot) (boundp 'buffer-display-table)
@@ -5457,10 +5565,8 @@ The following commands are available:
(setq org-display-table (make-display-table)))
(set-display-table-slot
org-display-table 4
- (vconcat (mapcar
- (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis))
- org-ellipsis)))
- (if (stringp org-ellipsis) org-ellipsis "..."))))
+ (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis))
+ (if (stringp org-ellipsis) org-ellipsis "..."))))
(setq buffer-display-table org-display-table))
(org-set-regexps-and-options)
(org-set-font-lock-defaults)
@@ -5468,29 +5574,25 @@ The following commands are available:
;; tag faces set outside customize.... force initialization.
(org-set-tag-faces 'org-tag-faces org-tag-faces))
;; Calc embedded
- (org-set-local 'calc-embedded-open-mode "# ")
+ (setq-local calc-embedded-open-mode "# ")
;; Modify a few syntax entries
(modify-syntax-entry ?@ "w")
(modify-syntax-entry ?\" "\"")
(modify-syntax-entry ?\\ "_")
(modify-syntax-entry ?~ "_")
- (if org-startup-truncated (setq truncate-lines t))
- (when org-startup-indented (require 'org-indent) (org-indent-mode 1))
- (org-set-local 'font-lock-unfontify-region-function
- 'org-unfontify-region)
+ (setq-local font-lock-unfontify-region-function 'org-unfontify-region)
;; Activate before-change-function
- (org-set-local 'org-table-may-need-update t)
- (org-add-hook 'before-change-functions 'org-before-change-function nil
- 'local)
+ (setq-local org-table-may-need-update t)
+ (add-hook 'before-change-functions 'org-before-change-function nil 'local)
;; Check for running clock before killing a buffer
- (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
+ (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
;; Initialize macros templates.
(org-macro-initialize-templates)
;; Initialize radio targets.
(org-update-radio-target-regexp)
;; Indentation.
- (org-set-local 'indent-line-function 'org-indent-line)
- (org-set-local 'indent-region-function 'org-indent-region)
+ (setq-local indent-line-function 'org-indent-line)
+ (setq-local indent-region-function 'org-indent-region)
;; Filling and auto-filling.
(org-setup-filling)
;; Comments.
@@ -5498,15 +5600,15 @@ The following commands are available:
;; Initialize cache.
(org-element-cache-reset)
;; Beginning/end of defun
- (org-set-local 'beginning-of-defun-function 'org-backward-element)
- (org-set-local 'end-of-defun-function
- (lambda ()
- (if (not (org-at-heading-p))
- (org-forward-element)
- (org-forward-element)
- (forward-char -1))))
+ (setq-local beginning-of-defun-function 'org-backward-element)
+ (setq-local end-of-defun-function
+ (lambda ()
+ (if (not (org-at-heading-p))
+ (org-forward-element)
+ (org-forward-element)
+ (forward-char -1))))
;; Next error for sparse trees
- (org-set-local 'next-error-function 'org-occur-next-match)
+ (setq-local next-error-function 'org-occur-next-match)
;; Make sure dependence stuff works reliably, even for users who set it
;; too late :-(
(if org-enforce-todo-dependencies
@@ -5521,72 +5623,60 @@ The following commands are available:
'org-block-todo-from-checkboxes))
;; Align options lines
- (org-set-local
- 'align-mode-rules-list
+ (setq-local
+ align-mode-rules-list
'((org-in-buffer-settings
(regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
(modes . '(org-mode)))))
;; Imenu
- (org-set-local 'imenu-create-index-function
- 'org-imenu-get-tree)
+ (setq-local imenu-create-index-function 'org-imenu-get-tree)
;; Make isearch reveal context
- (if (or (featurep 'xemacs)
- (not (boundp 'outline-isearch-open-invisible-function)))
- ;; Emacs 21 and XEmacs make use of the hook
- (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local)
- ;; Emacs 22 deals with this through a special variable
- (org-set-local 'outline-isearch-open-invisible-function
- (lambda (&rest ignore) (org-show-context 'isearch))))
+ (setq-local outline-isearch-open-invisible-function
+ (lambda (&rest _) (org-show-context 'isearch)))
;; Setup the pcomplete hooks
- (set (make-local-variable 'pcomplete-command-completion-function)
- 'org-pcomplete-initial)
- (set (make-local-variable 'pcomplete-command-name-function)
- 'org-command-at-point)
- (set (make-local-variable 'pcomplete-default-completion-function)
- 'ignore)
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- 'org-parse-arguments)
- (set (make-local-variable 'pcomplete-termination-string) "")
- (when (>= emacs-major-version 23)
- (set (make-local-variable 'buffer-face-mode-face) 'org-default))
-
- ;; If empty file that did not turn on org-mode automatically, make it to.
- (if (and org-insert-mode-line-in-empty-file
- (org-called-interactively-p 'any)
- (= (point-min) (point-max)))
- (insert "# -*- mode: org -*-\n\n"))
+ (setq-local pcomplete-command-completion-function 'org-pcomplete-initial)
+ (setq-local pcomplete-command-name-function 'org-command-at-point)
+ (setq-local pcomplete-default-completion-function 'ignore)
+ (setq-local pcomplete-parse-arguments-function 'org-parse-arguments)
+ (setq-local pcomplete-termination-string "")
+ (setq-local buffer-face-mode-face 'org-default)
+
+ ;; If empty file that did not turn on Org mode automatically, make
+ ;; it to.
+ (when (and org-insert-mode-line-in-empty-file
+ (called-interactively-p 'any)
+ (= (point-min) (point-max)))
+ (insert "# -*- mode: org -*-\n\n"))
(unless org-inhibit-startup
(org-unmodified
- (and org-startup-with-beamer-mode (org-beamer-mode))
+ (when org-startup-with-beamer-mode (org-beamer-mode))
(when org-startup-align-all-tables
- (org-table-map-tables 'org-table-align 'quietly))
- (when org-startup-with-inline-images
- (org-display-inline-images))
- (when org-startup-with-latex-preview
- (org-toggle-latex-fragment))
- (unless org-inhibit-startup-visibility-stuff
- (org-set-startup-visibility))
+ (org-table-map-tables #'org-table-align t))
+ (when org-startup-with-inline-images (org-display-inline-images))
+ (when org-startup-with-latex-preview (org-toggle-latex-fragment))
+ (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
+ (when org-startup-truncated (setq truncate-lines t))
+ (when org-startup-indented (require 'org-indent) (org-indent-mode 1))
(org-refresh-effort-properties)))
- ;; Try to set org-hide correctly
+ ;; Try to set `org-hide' face correctly.
(let ((foreground (org-find-invisible-foreground)))
- (if foreground
- (set-face-foreground 'org-hide foreground))))
+ (when foreground
+ (set-face-foreground 'org-hide foreground))))
;; Update `customize-package-emacs-version-alist'
(add-to-list 'customize-package-emacs-version-alist
'(Org ("6.21b" . "23.1") ("6.33x" . "23.2")
("7.8.11" . "24.1") ("7.9.4" . "24.3")
- ("8.2.6" . "24.4") ("8.3" . "25.1")))
+ ("8.2.6" . "24.4") ("8.2.10" . "24.5")
+ ("9.0" . "25.2")))
(defvar org-mode-transpose-word-syntax-table
(let ((st (make-syntax-table text-mode-syntax-table)))
- (mapc (lambda(c) (modify-syntax-entry
- (string-to-char (car c)) "w p" st))
- org-emphasis-alist)
- st))
+ (dolist (c org-emphasis-alist st)
+ (modify-syntax-entry (string-to-char (car c)) "w p" st))))
(when (fboundp 'abbrev-table-put)
(abbrev-table-put org-mode-abbrev-table
@@ -5601,7 +5691,7 @@ The following commands are available:
(mapcar
(lambda (alist)
(when (boundp alist)
- (cdr (assoc 'background-color (symbol-value alist)))))
+ (cdr (assq 'background-color (symbol-value alist)))))
'(default-frame-alist initial-frame-alist window-system-default-frame-alist))
(list (face-foreground 'org-hide))))))
(car (remove nil candidates))))
@@ -5620,8 +5710,8 @@ the rounding returns a past time."
(apply 'encode-time
(append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
(nthcdr 2 time))))
- (if (and past (< (org-float-time (time-subtract (current-time) res)) 0))
- (seconds-to-time (- (org-float-time res) (* r 60)))
+ (if (and past (< (float-time (time-subtract (current-time) res)) 0))
+ (seconds-to-time (- (float-time res) (* r 60)))
res))))
(defun org-today ()
@@ -5644,9 +5734,6 @@ the rounding returns a past time."
(require 'font-lock)
(defconst org-non-link-chars "]\t\n\r<>")
-(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "file+emacs"
- "file+sys" "news" "shell" "elisp" "doi" "message"
- "help"))
(defvar org-link-types-re nil
"Matches a link that has a url-like prefix like \"http:\"")
(defvar org-link-re-with-space nil
@@ -5713,8 +5800,8 @@ stacked delimiters is N. Escaping delimiters is not possible."
(defun org-make-link-regexps ()
"Update the link regular expressions.
-This should be called after the variable `org-link-types' has changed."
- (let ((types-re (regexp-opt org-link-types t)))
+This should be called after the variable `org-link-parameters' has changed."
+ (let ((types-re (regexp-opt (org-link-types) t)))
(setq org-link-types-re
(concat "\\`" types-re ":")
org-link-re-with-space
@@ -5737,7 +5824,7 @@ This should be called after the variable `org-link-types' has changed."
org-plain-link-re
(concat
"\\<" types-re ":"
- (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)"))
+ "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")
;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
org-bracket-link-regexp
"\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
@@ -5752,7 +5839,7 @@ This should be called after the variable `org-link-types' has changed."
org-bracket-link-analytic-regexp++
(concat
"\\[\\["
- "\\(" (regexp-opt (cons "coderef" org-link-types) t) ":\\)?"
+ "\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?"
"\\([^]]+\\)"
"\\]"
"\\(\\[" "\\([^]]+\\)" "\\]\\)?"
@@ -5772,28 +5859,26 @@ This should be called after the variable `org-link-types' has changed."
(while (and (not rtn) (re-search-forward org-emph-re limit t))
(let* ((border (char-after (match-beginning 3)))
(bre (regexp-quote (char-to-string border))))
- (if (and (not (= border (char-after (match-beginning 4))))
- (not (save-match-data
- (string-match (concat bre ".*" bre)
- (replace-regexp-in-string
- "\n" " "
- (substring (match-string 2) 1 -1))))))
- (progn
- (setq rtn t)
- (setq a (assoc (match-string 3) org-emphasis-alist))
- (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
- 'face
- (nth 1 a))
- (and (nth 2 a)
- (org-remove-flyspell-overlays-in
- (match-beginning 0) (match-end 0)))
- (add-text-properties (match-beginning 2) (match-end 2)
- '(font-lock-multiline t org-emphasis t))
- (when org-hide-emphasis-markers
- (add-text-properties (match-end 4) (match-beginning 5)
- '(invisible org-link))
- (add-text-properties (match-beginning 3) (match-end 3)
- '(invisible org-link))))))
+ (when (and (not (= border (char-after (match-beginning 4))))
+ (not (string-match-p (concat bre ".*" bre)
+ (replace-regexp-in-string
+ "\n" " "
+ (substring (match-string 2) 1 -1)))))
+ (setq rtn t)
+ (setq a (assoc (match-string 3) org-emphasis-alist))
+ (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
+ 'face
+ (nth 1 a))
+ (and (nth 2 a)
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0) (match-end 0)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(font-lock-multiline t org-emphasis t))
+ (when org-hide-emphasis-markers
+ (add-text-properties (match-end 4) (match-beginning 5)
+ '(invisible org-link))
+ (add-text-properties (match-beginning 3) (match-end 3)
+ '(invisible org-link)))))
(goto-char (1+ (match-beginning 0))))
rtn))
@@ -5808,19 +5893,20 @@ If CHAR is not given (for example in an interactive call) it will be
prompted for."
(interactive)
(let ((erc org-emphasis-regexp-components)
- (prompt "")
- (string "") beg end move c s)
+ (string "") beg end move s)
(if (org-region-active-p)
- (setq beg (region-beginning) end (region-end)
+ (setq beg (region-beginning)
+ end (region-end)
string (buffer-substring beg end))
(setq move t))
(unless char
(message "Emphasis marker or tag: [%s]"
- (mapconcat (lambda(e) (car e)) org-emphasis-alist ""))
+ (mapconcat #'car org-emphasis-alist ""))
(setq char (read-char-exclusive)))
- (if (equal char ?\ )
- (setq s "" move nil)
+ (if (equal char ?\s)
+ (setq s ""
+ move nil)
(unless (assoc (char-to-string char) org-emphasis-alist)
(user-error "No such emphasis marker: \"%c\"" char))
(setq s (char-to-string char)))
@@ -5829,7 +5915,7 @@ prompted for."
(assoc (substring string 0 1) org-emphasis-alist))
(setq string (substring string 1 -1)))
(setq string (concat s string s))
- (if beg (delete-region beg end))
+ (when beg (delete-region beg end))
(unless (or (bolp)
(string-match (concat "[" (nth 0 erc) "\n]")
(char-to-string (char-before (point)))))
@@ -5851,29 +5937,69 @@ prompted for."
"Add link properties for plain links."
(when (and (re-search-forward org-plain-link-re limit t)
(not (org-in-src-block-p)))
- (let ((face (get-text-property (max (1- (match-beginning 0)) (point-min))
- 'face))
- (link (org-match-string-no-properties 0)))
+
+ (let* ((face (get-text-property (max (1- (match-beginning 0)) (point-min))
+ 'face))
+ (link (match-string-no-properties 0))
+ (type (match-string-no-properties 1))
+ (path (match-string-no-properties 2))
+ (link-start (match-beginning 0))
+ (link-end (match-end 0))
+ (link-face (org-link-get-parameter type :face))
+ (help-echo (org-link-get-parameter type :help-echo))
+ (htmlize-link (org-link-get-parameter type :htmlize-link))
+ (activate-func (org-link-get-parameter type :activate-func)))
(unless (if (consp face) (memq 'org-tag face) (eq 'org-tag face))
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'face 'org-link
- 'htmlize-link `(:uri ,link)
- 'keymap org-mouse-map))
+ (list
+ 'mouse-face (or (org-link-get-parameter type :mouse-face)
+ 'highlight)
+ 'face (cond
+ ;; A function that returns a face
+ ((functionp link-face)
+ (funcall link-face path))
+ ;; a face
+ ((facep link-face)
+ link-face)
+ ;; An anonymous face
+ ((consp link-face)
+ link-face)
+ ;; default
+ (t
+ 'org-link))
+ 'help-echo (cond
+ ((stringp help-echo)
+ help-echo)
+ ((functionp help-echo)
+ help-echo)
+ (t
+ (concat "LINK: "
+ (save-match-data
+ (org-link-unescape link)))))
+ 'htmlize-link (cond
+ ((functionp htmlize-link)
+ (funcall htmlize-link path))
+ (t
+ `(:uri ,link)))
+ 'keymap (or (org-link-get-parameter type :keymap)
+ org-mouse-map)
+ 'org-link-start (match-beginning 0)))
(org-rear-nonsticky-at (match-end 0))
+ (when activate-func
+ (funcall activate-func link-start link-end path nil))
t))))
(defun org-activate-code (limit)
- (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(display t invisible t intangible t))
- t)))
+ (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(display t invisible t intangible t))
+ t))
(defcustom org-src-fontify-natively t
- "When non-nil, fontify code in code blocks."
+ "When non-nil, fontify code in code blocks.
+See also the `org-block' face."
:type 'boolean
:version "24.4"
:package-version '(Org . "8.3")
@@ -5891,95 +6017,106 @@ by a #."
(defun org-fontify-meta-lines-and-blocks (limit)
(condition-case nil
(org-fontify-meta-lines-and-blocks-1 limit)
- (error (message "org-mode fontification error"))))
+ (error (message "org-mode fontification error in %S at %d"
+ (current-buffer)
+ (line-number-at-pos)))))
(defun org-fontify-meta-lines-and-blocks-1 (limit)
"Fontify #+ lines and blocks."
(let ((case-fold-search t))
- (if (re-search-forward
- "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
- limit t)
- (let ((beg (match-beginning 0))
- (block-start (match-end 0))
- (block-end nil)
- (lang (match-string 7))
- (beg1 (line-beginning-position 2))
- (dc1 (downcase (match-string 2)))
- (dc3 (downcase (match-string 3)))
- end end1 quoting block-type ovl)
- (cond
- ((and (match-end 4) (equal dc3 "+begin"))
- ;; Truly a block
- (setq block-type (downcase (match-string 5))
- quoting (member block-type org-protecting-blocks))
- (when (re-search-forward
- (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
- nil t) ;; on purpose, we look further than LIMIT
- (setq end (min (point-max) (match-end 0))
- end1 (min (point-max) (1- (match-beginning 0))))
- (setq block-end (match-beginning 0))
- (when quoting
- (org-remove-flyspell-overlays-in beg1 end1)
- (remove-text-properties beg end
- '(display t invisible t intangible t)))
- (add-text-properties
- beg end '(font-lock-fontified t font-lock-multiline t))
- (add-text-properties beg beg1 '(face org-meta-line))
- (org-remove-flyspell-overlays-in beg beg1)
- (add-text-properties ; For end_src
- end1 (min (point-max) (1+ end)) '(face org-meta-line))
- (org-remove-flyspell-overlays-in end1 end)
- (cond
- ((and lang (not (string= lang "")) org-src-fontify-natively)
- (org-src-font-lock-fontify-block lang block-start block-end)
- (add-text-properties beg1 block-end '(src-block t)))
- (quoting
- (add-text-properties beg1 (min (point-max) (1+ end1))
- '(face org-block))) ; end of source block
- ((not org-fontify-quote-and-verse-blocks))
- ((string= block-type "quote")
- (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote)))
- ((string= block-type "verse")
- (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse))))
- (add-text-properties beg beg1 '(face org-block-begin-line))
- (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
- '(face org-block-end-line))
- t))
- ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
- (org-remove-flyspell-overlays-in
- (match-beginning 0)
- (if (equal "+title:" dc1) (match-end 2) (match-end 0)))
- (add-text-properties
- beg (match-end 3)
- (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
- '(font-lock-fontified t invisible t)
- '(font-lock-fontified t face org-document-info-keyword)))
- (add-text-properties
- (match-beginning 6) (min (point-max) (1+ (match-end 6)))
- (if (string-equal dc1 "+title:")
- '(font-lock-fontified t face org-document-title)
- '(font-lock-fontified t face org-document-info))))
- ((equal dc1 "+caption:")
- (org-remove-flyspell-overlays-in (match-end 2) (match-end 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(display t invisible t intangible t))
- (add-text-properties (match-beginning 1) (match-end 3)
- '(font-lock-fontified t face org-meta-line))
- (add-text-properties (match-beginning 6) (+ (match-end 6) 1)
- '(font-lock-fontified t face org-block))
- t)
- ((member dc3 '(" " ""))
- (org-remove-flyspell-overlays-in beg (match-end 0))
+ (when (re-search-forward
+ "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
+ limit t)
+ (let ((beg (match-beginning 0))
+ (block-start (match-end 0))
+ (block-end nil)
+ (lang (match-string 7))
+ (beg1 (line-beginning-position 2))
+ (dc1 (downcase (match-string 2)))
+ (dc3 (downcase (match-string 3)))
+ end end1 quoting block-type)
+ (cond
+ ((and (match-end 4) (equal dc3 "+begin"))
+ ;; Truly a block
+ (setq block-type (downcase (match-string 5))
+ quoting (member block-type org-protecting-blocks))
+ (when (re-search-forward
+ (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
+ nil t) ;; on purpose, we look further than LIMIT
+ (setq end (min (point-max) (match-end 0))
+ end1 (min (point-max) (1- (match-beginning 0))))
+ (setq block-end (match-beginning 0))
+ (when quoting
+ (org-remove-flyspell-overlays-in beg1 end1)
+ (remove-text-properties beg end
+ '(display t invisible t intangible t)))
(add-text-properties
- beg (match-end 0)
- '(font-lock-fontified t face font-lock-comment-face)))
- (t ;; just any other in-buffer setting, but not indented
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(display t invisible t intangible t))
- (add-text-properties beg (match-end 0)
- '(font-lock-fontified t face org-meta-line))
- t))))))
+ beg end '(font-lock-fontified t font-lock-multiline t))
+ (add-text-properties beg beg1 '(face org-meta-line))
+ (org-remove-flyspell-overlays-in beg beg1)
+ (add-text-properties ; For end_src
+ end1 (min (point-max) (1+ end)) '(face org-meta-line))
+ (org-remove-flyspell-overlays-in end1 end)
+ (cond
+ ((and lang (not (string= lang "")) org-src-fontify-natively)
+ (org-src-font-lock-fontify-block lang block-start block-end)
+ (add-text-properties beg1 block-end '(src-block t)))
+ (quoting
+ (add-text-properties beg1 (min (point-max) (1+ end1))
+ (list 'face
+ (list :inherit
+ (let ((face-name
+ (intern (format "org-block-%s" lang))))
+ (append (and (facep face-name) (list face-name))
+ '(org-block))))))) ; end of source block
+ ((not org-fontify-quote-and-verse-blocks))
+ ((string= block-type "quote")
+ (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote)))
+ ((string= block-type "verse")
+ (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse))))
+ (add-text-properties beg beg1 '(face org-block-begin-line))
+ (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
+ '(face org-block-end-line))
+ t))
+ ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0)
+ (if (equal "+title:" dc1) (match-end 2) (match-end 0)))
+ (add-text-properties
+ beg (match-end 3)
+ (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
+ '(font-lock-fontified t invisible t)
+ '(font-lock-fontified t face org-document-info-keyword)))
+ (add-text-properties
+ (match-beginning 6) (min (point-max) (1+ (match-end 6)))
+ (if (string-equal dc1 "+title:")
+ '(font-lock-fontified t face org-document-title)
+ '(font-lock-fontified t face org-document-info))))
+ ((string-prefix-p "+caption" dc1)
+ (org-remove-flyspell-overlays-in (match-end 2) (match-end 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(display t invisible t intangible t))
+ ;; Handle short captions.
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \t]*"))
+ (add-text-properties (line-beginning-position) (match-end 1)
+ '(font-lock-fontified t face org-meta-line))
+ (add-text-properties (match-end 0) (line-end-position)
+ '(font-lock-fontified t face org-block))
+ t)
+ ((member dc3 '(" " ""))
+ (org-remove-flyspell-overlays-in beg (match-end 0))
+ (add-text-properties
+ beg (match-end 0)
+ '(font-lock-fontified t face font-lock-comment-face)))
+ (t ;; just any other in-buffer setting, but not indented
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(display t invisible t intangible t))
+ (add-text-properties beg (match-end 0)
+ '(font-lock-fontified t face org-meta-line))
+ t))))))
(defun org-fontify-drawers (limit)
"Fontify drawers."
@@ -6006,16 +6143,15 @@ by a #."
(defun org-activate-angle-links (limit)
"Add text properties for angle links."
- (if (and (re-search-forward org-angle-link-re limit t)
- (not (org-in-src-block-p)))
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map
- 'font-lock-multiline t))
- (org-rear-nonsticky-at (match-end 0))
- t)))
+ (when (and (re-search-forward org-angle-link-re limit t)
+ (not (org-in-src-block-p)))
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map
+ 'font-lock-multiline t))
+ (org-rear-nonsticky-at (match-end 0))
+ t))
(defun org-activate-footnote-links (limit)
"Add text properties for footnotes."
@@ -6042,58 +6178,111 @@ by a #."
(defun org-activate-bracket-links (limit)
"Add text properties for bracketed links."
- (if (and (re-search-forward org-bracket-link-regexp limit t)
- (not (org-in-src-block-p)))
- (let* ((hl (org-match-string-no-properties 1))
- (help (concat "LINK: " (save-match-data (org-link-unescape hl))))
- (ip (org-maybe-intangible
- (list 'invisible 'org-link
- 'keymap org-mouse-map 'mouse-face 'highlight
- 'font-lock-multiline t 'help-echo help
- 'htmlize-link `(:uri ,hl))))
- (vp (list 'keymap org-mouse-map 'mouse-face 'highlight
- 'font-lock-multiline t 'help-echo help
- 'htmlize-link `(:uri ,hl))))
- ;; We need to remove the invisible property here. Table narrowing
- ;; may have made some of this invisible.
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(invisible nil))
- (if (match-end 3)
- (progn
- (add-text-properties (match-beginning 0) (match-beginning 3) ip)
- (org-rear-nonsticky-at (match-beginning 3))
- (add-text-properties (match-beginning 3) (match-end 3) vp)
- (org-rear-nonsticky-at (match-end 3))
- (add-text-properties (match-end 3) (match-end 0) ip)
- (org-rear-nonsticky-at (match-end 0)))
- (add-text-properties (match-beginning 0) (match-beginning 1) ip)
- (org-rear-nonsticky-at (match-beginning 1))
- (add-text-properties (match-beginning 1) (match-end 1) vp)
- (org-rear-nonsticky-at (match-end 1))
- (add-text-properties (match-end 1) (match-end 0) ip)
- (org-rear-nonsticky-at (match-end 0)))
- t)))
+ (when (and (re-search-forward org-bracket-link-regexp limit t)
+ (not (org-in-src-block-p)))
+ (let* ((hl (save-match-data
+ (org-link-expand-abbrev (match-string-no-properties 1))))
+ (type (save-match-data
+ (and (string-match org-plain-link-re hl)
+ (match-string-no-properties 1 hl))))
+ (path (save-match-data
+ (and (string-match org-plain-link-re hl)
+ (match-string-no-properties 2 hl))))
+ (link-start (match-beginning 0))
+ (link-end (match-end 0))
+ (bracketp t)
+ (help-echo (org-link-get-parameter type :help-echo))
+ (help (cond
+ ((stringp help-echo)
+ help-echo)
+ ((functionp help-echo)
+ help-echo)
+ (t
+ (concat "LINK: "
+ (save-match-data
+ (org-link-unescape hl))))))
+ (link-face (org-link-get-parameter type :face))
+ (face (cond
+ ;; A function that returns a face
+ ((functionp link-face)
+ (funcall link-face path))
+ ;; a face
+ ((facep link-face)
+ link-face)
+ ;; An anonymous face
+ ((consp link-face)
+ link-face)
+ ;; default
+ (t
+ 'org-link)))
+ (keymap (or (org-link-get-parameter type :keymap)
+ org-mouse-map))
+ (mouse-face (or (org-link-get-parameter type :mouse-face)
+ 'highlight))
+ (htmlize (org-link-get-parameter type :htmlize-link))
+ (htmlize-link (cond
+ ((functionp htmlize)
+ (funcall htmlize))
+ (t
+ `(:uri ,(format "%s:%s" type path)))))
+ (activate-func (org-link-get-parameter type :activate-func))
+ ;; invisible part
+ (ip (list 'invisible (or
+ (org-link-get-parameter type :display)
+ 'org-link)
+ 'face face
+ 'keymap keymap
+ 'mouse-face mouse-face
+ 'font-lock-multiline t
+ 'help-echo help
+ 'htmlize-link htmlize-link))
+ ;; visible part
+ (vp (list 'keymap keymap
+ 'face face
+ 'mouse-face mouse-face
+ 'font-lock-multiline t
+ 'help-echo help
+ 'htmlize-link htmlize-link)))
+ ;; We need to remove the invisible property here. Table narrowing
+ ;; may have made some of this invisible.
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(invisible nil))
+ (if (match-end 3)
+ (progn
+ (add-text-properties (match-beginning 0) (match-beginning 3) ip)
+ (org-rear-nonsticky-at (match-beginning 3))
+ (add-text-properties (match-beginning 3) (match-end 3) vp)
+ (org-rear-nonsticky-at (match-end 3))
+ (add-text-properties (match-end 3) (match-end 0) ip)
+ (org-rear-nonsticky-at (match-end 0)))
+ (add-text-properties (match-beginning 0) (match-beginning 1) ip)
+ (org-rear-nonsticky-at (match-beginning 1))
+ (add-text-properties (match-beginning 1) (match-end 1) vp)
+ (org-rear-nonsticky-at (match-end 1))
+ (add-text-properties (match-end 1) (match-end 0) ip)
+ (org-rear-nonsticky-at (match-end 0)))
+ (when activate-func
+ (funcall activate-func link-start link-end path bracketp))
+ t)))
(defun org-activate-dates (limit)
"Add text properties for dates."
- (if (and (re-search-forward org-tsr-regexp-both limit t)
- (not (equal (char-before (match-beginning 0)) 91)))
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map))
- (org-rear-nonsticky-at (match-end 0))
- (when org-display-custom-times
- (if (match-end 3)
- (org-display-custom-time (match-beginning 3) (match-end 3)))
- (org-display-custom-time (match-beginning 1) (match-end 1)))
- t)))
+ (when (and (re-search-forward org-tsr-regexp-both limit t)
+ (not (equal (char-before (match-beginning 0)) 91)))
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0))
+ (when org-display-custom-times
+ (if (match-end 3)
+ (org-display-custom-time (match-beginning 3) (match-end 3))
+ (org-display-custom-time (match-beginning 1) (match-end 1))))
+ t))
-(defvar org-target-link-regexp nil
+(defvar-local org-target-link-regexp nil
"Regular expression matching radio targets in plain text.")
-(make-variable-buffer-local 'org-target-link-regexp)
(defconst org-target-regexp (let ((border "[^<>\n\r \t]"))
(format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>"
@@ -6111,16 +6300,15 @@ by a #."
"Add text properties for target matches."
(when org-target-link-regexp
(let ((case-fold-search t))
- (if (re-search-forward org-target-link-regexp limit t)
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
- (add-text-properties (match-beginning 1) (match-end 1)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map
- 'help-echo "Radio target link"
- 'org-linked-text t))
- (org-rear-nonsticky-at (match-end 1))
- t)))))
+ (when (re-search-forward org-target-link-regexp limit t)
+ (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
+ (add-text-properties (match-beginning 1) (match-end 1)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map
+ 'help-echo "Radio target link"
+ 'org-linked-text t))
+ (org-rear-nonsticky-at (match-end 1))
+ t))))
(defun org-update-radio-target-regexp ()
"Find all radio targets in this file and update the regular expression.
@@ -6138,7 +6326,8 @@ Also refresh fontification if needed."
(backward-char)
(let ((obj (org-element-context)))
(when (eq (org-element-type obj) 'radio-target)
- (add-to-list 'rtn (org-element-property :value obj)))))
+ (cl-pushnew (org-element-property :value obj) rtn
+ :test #'equal))))
rtn))))
(setq org-target-link-regexp
(and targets
@@ -6177,7 +6366,7 @@ Also refresh fontification if needed."
'org-cwidth t))
(when s
(setq e (next-single-property-change s 'org-cwidth))
- (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth)))
+ (add-text-properties s e '(invisible org-cwidth))
(goto-char e)
t)))
@@ -6187,8 +6376,8 @@ Also refresh fontification if needed."
(defun org-compute-latex-and-related-regexp ()
"Compute regular expression for LaTeX, entities and sub/superscript.
Result depends on variable `org-highlight-latex-and-related'."
- (org-set-local
- 'org-latex-and-related-regexp
+ (setq-local
+ org-latex-and-related-regexp
(let* ((re-sub
(cond ((not (memq 'script org-highlight-latex-and-related)) nil)
((eq org-use-sub-superscripts '{})
@@ -6214,9 +6403,13 @@ done, nil otherwise."
(when (org-string-nw-p org-latex-and-related-regexp)
(catch 'found
(while (re-search-forward org-latex-and-related-regexp limit t)
- (unless (memq (car-safe (get-text-property (1+ (match-beginning 0))
- 'face))
- '(org-code org-verbatim underline))
+ (unless
+ (cl-some
+ (lambda (f)
+ (memq f '(org-code org-verbatim underline org-special-keyword)))
+ (save-excursion
+ (goto-char (1+ (match-beginning 0)))
+ (face-at-point nil t)))
(let ((offset (if (memq (char-after (1+ (match-beginning 0)))
'(?_ ?^))
1
@@ -6237,7 +6430,7 @@ done, nil otherwise."
(defun org-activate-tags (limit)
(when (re-search-forward
- (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") limit t)
+ "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" limit t)
(org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
(add-text-properties (match-beginning 1) (match-end 1)
(list 'mouse-face 'highlight
@@ -6298,6 +6491,8 @@ There are four matching groups:
(defvar org-font-lock-hook nil
"Functions to be called for special font lock stuff.")
+(defvar org-font-lock-extra-keywords nil) ;Dynamically scoped.
+
(defvar org-font-lock-set-keywords-hook nil
"Functions that can manipulate `org-font-lock-extra-keywords'.
This is called after `org-font-lock-extra-keywords' is defined, but before
@@ -6338,13 +6533,13 @@ needs to be inserted at a specific position in the font-lock sequence.")
'(1 'org-special-keyword t)
'(3 'org-property-value t))
;; Links
- (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
- (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
- (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
- (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
- (if (memq 'radio lk) '(org-activate-target-links (1 'org-link t)))
- (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
- (if (memq 'footnote lk) '(org-activate-footnote-links))
+ (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
+ (when (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
+ (when (memq 'plain lk) '(org-activate-plain-links (0 'org-link)))
+ (when (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link)))
+ (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t)))
+ (when (memq 'date lk) '(org-activate-dates (0 'org-date t)))
+ (when (memq 'footnote lk) '(org-activate-footnote-links))
;; Targets.
(list org-any-target-regexp '(0 'org-target t))
;; Diary sexps.
@@ -6370,27 +6565,24 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; Tags
'(org-font-lock-add-tag-faces)
;; Tags groups
- (if (and org-group-tags org-tag-groups-alist)
- (list (concat org-outline-regexp-bol ".+\\(:"
- (regexp-opt (mapcar 'car org-tag-groups-alist))
- ":\\).*$")
- '(1 'org-tag-group prepend)))
+ (when (and org-group-tags org-tag-groups-alist)
+ (list (concat org-outline-regexp-bol ".+\\(:"
+ (regexp-opt (mapcar 'car org-tag-groups-alist))
+ ":\\).*$")
+ '(1 'org-tag-group prepend)))
;; Special keywords
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
;; Emphasis
- (if em
- (if (featurep 'xemacs)
- '(org-do-emphasis-faces (0 nil append))
- '(org-do-emphasis-faces)))
+ (when em '(org-do-emphasis-faces))
;; Checkboxes
'("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
1 'org-checkbox prepend)
- (if (cdr (assq 'checkbox org-list-automatic-rules))
- '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
- (0 (org-get-checkbox-statistics-face) t)))
+ (when (cdr (assq 'checkbox org-list-automatic-rules))
+ '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
+ (0 (org-get-checkbox-statistics-face) t)))
;; Description list items
'("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
1 'org-list-dt prepend)
@@ -6416,26 +6608,26 @@ needs to be inserted at a specific position in the font-lock sequence.")
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
(run-hooks 'org-font-lock-set-keywords-hook)
;; Now set the full font-lock-keywords
- (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
- (org-set-local 'font-lock-defaults
- '(org-font-lock-keywords t nil nil backward-paragraph))
- (kill-local-variable 'font-lock-keywords) nil))
+ (setq-local org-font-lock-keywords org-font-lock-extra-keywords)
+ (setq-local font-lock-defaults
+ '(org-font-lock-keywords t nil nil backward-paragraph))
+ (kill-local-variable 'font-lock-keywords)
+ nil))
(defun org-toggle-pretty-entities ()
"Toggle the composition display of entities as UTF8 characters."
(interactive)
- (org-set-local 'org-pretty-entities (not org-pretty-entities))
+ (setq-local org-pretty-entities (not org-pretty-entities))
(org-restart-font-lock)
(if org-pretty-entities
(message "Entities are now displayed as UTF8 characters")
(save-restriction
(widen)
- (org-decompose-region (point-min) (point-max))
+ (decompose-region (point-min) (point-max))
(message "Entities are now displayed as plain text"))))
-(defvar org-custom-properties-overlays nil
+(defvar-local org-custom-properties-overlays nil
"List of overlays used for custom properties.")
-(make-variable-buffer-local 'org-custom-properties-overlays)
(defun org-toggle-custom-properties-visibility ()
"Display or hide properties in `org-custom-properties'."
@@ -6475,24 +6667,23 @@ needs to be inserted at a specific position in the font-lock sequence.")
(while (re-search-forward
"\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
limit t)
- (if (and (not (org-at-comment-p))
- (setq ee (org-entity-get (match-string 1)))
- (= (length (nth 6 ee)) 1))
- (let*
- ((end (if (equal (match-string 2) "{}")
+ (when (and (not (org-at-comment-p))
+ (setq ee (org-entity-get (match-string 1)))
+ (= (length (nth 6 ee)) 1))
+ (let* ((end (if (equal (match-string 2) "{}")
(match-end 2)
(match-end 1))))
- (add-text-properties
- (match-beginning 0) end
- (list 'font-lock-fontified t))
- (compose-region (match-beginning 0) end
- (nth 6 ee) nil)
- (backward-char 1)
- (throw 'match t))))
+ (add-text-properties
+ (match-beginning 0) end
+ (list 'font-lock-fontified t))
+ (compose-region (match-beginning 0) end
+ (nth 6 ee) nil)
+ (backward-char 1)
+ (throw 'match t))))
nil))))
(defun org-fontify-like-in-org-mode (s &optional odd-levels)
- "Fontify string S like in Org-mode."
+ "Fontify string S like in Org mode."
(with-temp-buffer
(insert s)
(let ((org-odd-levels-only odd-levels))
@@ -6506,14 +6697,14 @@ needs to be inserted at a specific position in the font-lock sequence.")
(defun org-get-level-face (n)
"Get the right face for match N in font-lock matching of headlines."
(setq org-l (- (match-end 2) (match-beginning 1) 1))
- (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
+ (when org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
(if org-cycle-level-faces
(setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
(setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces)))
(cond
((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
((eq n 2) org-f)
- (t (if org-level-color-stars-only nil org-f))))
+ (t (unless org-level-color-stars-only org-f))))
(defun org-face-from-face-or-color (context inherit face-or-color)
"Create a face list that inherits INHERIT, but sets the foreground color.
@@ -6527,7 +6718,7 @@ When FACE-OR-COLOR is not a string, just return it."
(defun org-get-todo-face (kwd)
"Get the right face for a TODO keyword KWD.
If KWD is a number, get the corresponding match group."
- (if (numberp kwd) (setq kwd (match-string kwd)))
+ (when (numberp kwd) (setq kwd (match-string kwd)))
(or (org-face-from-face-or-color
'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces)))
(and (member kwd org-done-keywords) 'org-done)
@@ -6565,14 +6756,14 @@ If TAG is a number, get the corresponding match group."
'font-lock-fontified t))
(backward-char 1))))
-(defun org-unfontify-region (beg end &optional maybe_loudly)
+(defun org-unfontify-region (beg end &optional _maybe_loudly)
"Remove fontification and activation overlays from links."
(font-lock-default-unfontify-region beg end)
(let* ((buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
deactivate-mark buffer-file-name buffer-file-truename)
- (org-decompose-region beg end)
+ (decompose-region beg end)
(remove-text-properties beg end
'(mouse-face t keymap t org-linked-text t
invisible t intangible t
@@ -6593,59 +6784,56 @@ and subscripts."
(while (< beg end)
(setq next (next-single-property-change beg 'display nil end)
prop (get-text-property beg 'display))
- (if (member prop org-script-display)
- (put-text-property beg next 'display nil))
+ (when (member prop org-script-display)
+ (put-text-property beg next 'display nil))
(setq beg next))))
(defun org-raise-scripts (limit)
"Add raise properties to sub/superscripts."
- (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts)
- (if (re-search-forward
- (if (eq org-use-sub-superscripts t)
- org-match-substring-regexp
- org-match-substring-with-braces-regexp)
- limit t)
- (let* ((pos (point)) table-p comment-p
- (mpos (match-beginning 3))
- (emph-p (get-text-property mpos 'org-emphasis))
- (link-p (get-text-property mpos 'mouse-face))
- (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
- (goto-char (point-at-bol))
- (setq table-p (org-looking-at-p org-table-dataline-regexp)
- comment-p (org-looking-at-p "^[ \t]*#[ +]"))
- (goto-char pos)
- ;; Handle a_b^c
- (if (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
- (if (or comment-p emph-p link-p keyw-p)
- t
- (put-text-property (match-beginning 3) (match-end 0)
- 'display
- (if (equal (char-after (match-beginning 2)) ?^)
- (nth (if table-p 3 1) org-script-display)
- (nth (if table-p 2 0) org-script-display)))
- (add-text-properties (match-beginning 2) (match-end 2)
- (list 'invisible t
- 'org-dwidth t 'org-dwidth-n 1))
- (if (and (eq (char-after (match-beginning 3)) ?{)
- (eq (char-before (match-end 3)) ?}))
- (progn
- (add-text-properties
- (match-beginning 3) (1+ (match-beginning 3))
- (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
- (add-text-properties
- (1- (match-end 3)) (match-end 3)
- (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))))
- t)))))
+ (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts
+ (re-search-forward
+ (if (eq org-use-sub-superscripts t)
+ org-match-substring-regexp
+ org-match-substring-with-braces-regexp)
+ limit t))
+ (let* ((pos (point)) table-p comment-p
+ (mpos (match-beginning 3))
+ (emph-p (get-text-property mpos 'org-emphasis))
+ (link-p (get-text-property mpos 'mouse-face))
+ (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
+ (goto-char (point-at-bol))
+ (setq table-p (looking-at-p org-table-dataline-regexp)
+ comment-p (looking-at-p "^[ \t]*#[ +]"))
+ (goto-char pos)
+ ;; Handle a_b^c
+ (when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
+ (unless (or comment-p emph-p link-p keyw-p)
+ (put-text-property (match-beginning 3) (match-end 0)
+ 'display
+ (if (equal (char-after (match-beginning 2)) ?^)
+ (nth (if table-p 3 1) org-script-display)
+ (nth (if table-p 2 0) org-script-display)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ (list 'invisible t
+ 'org-dwidth t 'org-dwidth-n 1))
+ (if (and (eq (char-after (match-beginning 3)) ?{)
+ (eq (char-before (match-end 3)) ?}))
+ (progn
+ (add-text-properties
+ (match-beginning 3) (1+ (match-beginning 3))
+ (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
+ (add-text-properties
+ (1- (match-end 3)) (match-end 3)
+ (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))))
+ t)))
;;;; Visibility cycling, including org-goto and indirect buffer
;;; Cycling
-(defvar org-cycle-global-status nil)
-(make-variable-buffer-local 'org-cycle-global-status)
+(defvar-local org-cycle-global-status nil)
(put 'org-cycle-global-status 'org-state t)
-(defvar org-cycle-subtree-status nil)
-(make-variable-buffer-local 'org-cycle-subtree-status)
+(defvar-local org-cycle-subtree-status nil)
(put 'org-cycle-subtree-status 'org-state t)
(defvar org-inlinetask-min-level)
@@ -6657,53 +6845,58 @@ and subscripts."
;;;###autoload
(defun org-cycle (&optional arg)
- "TAB-action and visibility cycling for Org-mode.
+ "TAB-action and visibility cycling for Org mode.
-This is the command invoked in Org-mode by the TAB key. Its main purpose
-is outline visibility cycling, but it also invokes other actions
+This is the command invoked in Org mode by the `TAB' key. Its main
+purpose is outline visibility cycling, but it also invokes other actions
in special contexts.
-- When this function is called with a prefix argument, rotate the entire
- buffer through 3 states (global cycling)
+When this function is called with a `\\[universal-argument]' prefix, rotate \
+the entire
+buffer through 3 states (global cycling)
1. OVERVIEW: Show only top-level headlines.
2. CONTENTS: Show all headlines of all levels, but no body text.
3. SHOW ALL: Show everything.
- With a double \\[universal-argument] prefix argument, \
+
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
switch to the startup visibility,
- determined by the variable `org-startup-folded', and by any VISIBILITY
- properties in the buffer.
- With a triple \\[universal-argument] prefix argument, \
-show the entire buffer, including any drawers.
+determined by the variable `org-startup-folded', and by any VISIBILITY
+properties in the buffer.
-- When inside a table, re-align the table and move to the next field.
+With a `\\[universal-argument] \\[universal-argument] \
+\\[universal-argument]' prefix argument, show the entire buffer, including
+any drawers.
-- When point is at the beginning of a headline, rotate the subtree started
- by this line through 3 different states (local cycling)
+When inside a table, re-align the table and move to the next field.
+
+When point is at the beginning of a headline, rotate the subtree started
+by this line through 3 different states (local cycling)
1. FOLDED: Only the main headline is shown.
2. CHILDREN: The main headline and the direct children are shown.
From this state, you can move to one of the children
and zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
- If there is no subtree, switch directly from CHILDREN to FOLDED.
-
-- When point is at the beginning of an empty headline and the variable
- `org-cycle-level-after-item/entry-creation' is set, cycle the level
- of the headline by demoting and promoting it to likely levels. This
- speeds up creation document structure by pressing TAB once or several
- times right after creating a new headline.
-
-- When there is a numeric prefix, go up to a heading with level ARG, do
- a `show-subtree' and return to the previous cursor position. If ARG
- is negative, go up that many levels.
-
-- When point is not at the beginning of a headline, execute the global
- binding for TAB, which is re-indenting the line. See the option
- `org-cycle-emulate-tab' for details.
-
-- Special case: if point is at the beginning of the buffer and there is
- no headline in line 1, this function will act as if called with prefix arg
- (\\[universal-argument] TAB, same as S-TAB) also when called without prefix arg.
- But only if also the variable `org-cycle-global-at-bob' is t."
+If there is no subtree, switch directly from CHILDREN to FOLDED.
+
+When point is at the beginning of an empty headline and the variable
+`org-cycle-level-after-item/entry-creation' is set, cycle the level
+of the headline by demoting and promoting it to likely levels. This
+speeds up creation document structure by pressing `TAB' once or several
+times right after creating a new headline.
+
+When there is a numeric prefix, go up to a heading with level ARG, do
+a `show-subtree' and return to the previous cursor position. If ARG
+is negative, go up that many levels.
+
+When point is not at the beginning of a headline, execute the global
+binding for `TAB', which is re-indenting the line. See the option
+`org-cycle-emulate-tab' for details.
+
+As a special case, if point is at the beginning of the buffer and there is
+no headline in line 1, this function will act as if called with prefix arg
+\(`\\[universal-argument] TAB', same as `S-TAB') also when called without \
+prefix arg, but only
+if the variable `org-cycle-global-at-bob' is t."
(interactive "P")
(org-load-modules-maybe)
(unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
@@ -6732,10 +6925,6 @@ show the entire buffer, including any drawers.
org-cycle-hook))
(pos (point)))
- (if (or bob-special (equal arg '(4)))
- ;; special case: use global cycling
- (setq arg t))
-
(cond
((equal arg '(16))
@@ -6747,6 +6936,11 @@ show the entire buffer, including any drawers.
(outline-show-all)
(org-unlogged-message "Entire buffer visible, including drawers"))
+ ((equal arg '(4)) (org-cycle-internal-global))
+
+ ;; Try hiding block at point.
+ ((org-hide-block-toggle-maybe))
+
;; Try cdlatex TAB completion
((org-try-cdlatex-tab))
@@ -6754,16 +6948,15 @@ show the entire buffer, including any drawers.
((org-at-table-p 'any)
(if (org-at-table.el-p)
(message "%s" (substitute-command-keys "\\<org-mode-map>\
-Use \\[org-edit-special] to edit table.el tables"))
+Use `\\[org-edit-special]' to edit table.el tables"))
(if arg (org-table-edit-field t)
(org-table-justify-field-maybe)
(call-interactively 'org-table-next-field))))
- ((run-hook-with-args-until-success
- 'org-tab-after-check-for-table-hook))
+ ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook))
;; Global cycling: delegate to `org-cycle-internal-global'.
- ((eq arg t) (org-cycle-internal-global))
+ (bob-special (org-cycle-internal-global))
;; Drawers: delegate to `org-flag-drawer'.
((save-excursion
@@ -6886,15 +7079,10 @@ Use \\[org-edit-special] to edit table.el tables"))
(org-list-search-forward (org-item-beginning-re) eos t)))))
;; Determine end invisible part of buffer (EOL)
(beginning-of-line 2)
- ;; XEmacs doesn't have `next-single-char-property-change'
- (if (featurep 'xemacs)
- (while (and (not (eobp)) ;; this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
- (beginning-of-line 2))
- (while (and (not (eobp)) ;; this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
- (goto-char (next-single-char-property-change (point) 'invisible))
- (and (eolp) (beginning-of-line 2))))
+ (while (and (not (eobp)) ;This is like `next-line'.
+ (get-char-property (1- (point)) 'invisible))
+ (goto-char (next-single-char-property-change (point) 'invisible))
+ (and (eolp) (beginning-of-line 2)))
(setq eol (point)))
;; Find out what to do next and set `this-command'
(cond
@@ -6907,7 +7095,7 @@ Use \\[org-edit-special] to edit table.el tables"))
(save-excursion
(goto-char eos)
(outline-next-heading)
- (if (outline-invisible-p) (org-flag-heading nil))))
+ (when (outline-invisible-p) (org-flag-heading nil))))
((and (or (>= eol eos)
(not (string-match "\\S-" (buffer-substring eol eos))))
(or has-children
@@ -6919,7 +7107,7 @@ Use \\[org-edit-special] to edit table.el tables"))
(if (org-at-item-p)
(org-list-set-item-visibility (point-at-bol) struct 'children)
(org-show-entry)
- (org-with-limited-levels (outline-show-children))
+ (org-with-limited-levels (org-show-children))
;; FIXME: This slows down the func way too much.
;; How keep drawers hidden in subtree anyway?
;; (when (memq 'org-cycle-hide-drawers org-cycle-hook)
@@ -6934,14 +7122,14 @@ Use \\[org-edit-special] to edit table.el tables"))
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(end (org-list-get-bottom-point struct)))
- (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
- (org-list-get-all-items (point) struct prevs))
+ (dolist (e (org-list-get-all-items (point) struct prevs))
+ (org-list-set-item-visibility e struct 'folded))
(goto-char (if (< end eos) end eos)))))))
(org-unlogged-message "CHILDREN")
(save-excursion
(goto-char eos)
(outline-next-heading)
- (if (outline-invisible-p) (org-flag-heading nil)))
+ (when (outline-invisible-p) (org-flag-heading nil)))
(setq org-cycle-subtree-status 'children)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'children)))
@@ -6970,7 +7158,7 @@ Use \\[org-edit-special] to edit table.el tables"))
;;;###autoload
(defun org-global-cycle (&optional arg)
"Cycle the global visibility. For details see `org-cycle'.
-With \\[universal-argument] prefix arg, switch to startup visibility.
+With `\\[universal-argument]' prefix ARG, switch to startup visibility.
With a numeric prefix, show all headlines up to that level."
(interactive "P")
(let ((org-cycle-include-plain-lists
@@ -6997,7 +7185,7 @@ With a numeric prefix, show all headlines up to that level."
(eq org-startup-folded nil))
(outline-show-all)))
(unless (eq org-startup-folded 'showeverything)
- (if org-hide-block-startup (org-hide-block-all))
+ (when org-hide-block-startup (org-hide-block-all))
(org-set-visibility-according-to-property 'no-cleanup)
(org-cycle-hide-archived-subtrees 'all)
(org-cycle-hide-drawers 'all)
@@ -7006,33 +7194,32 @@ With a numeric prefix, show all headlines up to that level."
(defun org-set-visibility-according-to-property (&optional no-cleanup)
"Switch subtree visibilities according to :VISIBILITY: property."
(interactive)
- (let (org-show-entry-below)
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t)
- (if (not (org-at-property-p)) (outline-next-heading)
- (let ((state (match-string 3)))
- (save-excursion
- (org-back-to-heading t)
- (outline-hide-subtree)
- (org-reveal)
- (cond
- ((equal state "folded")
- (outline-hide-subtree))
- ((equal state "children")
- (org-show-hidden-entry)
- (outline-show-children))
- ((equal state "content")
- (save-excursion
- (save-restriction
- (org-narrow-to-subtree)
- (org-content))))
- ((member state '("all" "showall"))
- (outline-show-subtree)))))))
- (unless no-cleanup
- (org-cycle-hide-archived-subtrees 'all)
- (org-cycle-hide-drawers 'all)
- (org-cycle-show-empty-lines 'all)))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t)
+ (if (not (org-at-property-p)) (outline-next-heading)
+ (let ((state (match-string 3)))
+ (save-excursion
+ (org-back-to-heading t)
+ (outline-hide-subtree)
+ (org-reveal)
+ (cond
+ ((equal state "folded")
+ (outline-hide-subtree))
+ ((equal state "children")
+ (org-show-hidden-entry)
+ (org-show-children))
+ ((equal state "content")
+ (save-excursion
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-content))))
+ ((member state '("all" "showall"))
+ (outline-show-subtree)))))))
+ (unless no-cleanup
+ (org-cycle-hide-archived-subtrees 'all)
+ (org-cycle-hide-drawers 'all)
+ (org-cycle-show-empty-lines 'all))))
;; This function uses outline-regexp instead of the more fundamental
;; org-outline-regexp so that org-cycle-global works outside of Org
@@ -7048,10 +7235,9 @@ results."
(let ((level
(save-excursion
(goto-char (point-min))
- (if (re-search-forward (concat "^" outline-regexp) nil t)
- (progn
- (goto-char (match-beginning 0))
- (funcall outline-level))))))
+ (when (re-search-forward (concat "^" outline-regexp) nil t)
+ (goto-char (match-beginning 0))
+ (funcall outline-level)))))
(and level (outline-hide-sublevels level)))))
(defun org-content (&optional arg)
@@ -7070,9 +7256,9 @@ With numerical argument N, show content up to level N."
t)
(looking-at org-outline-regexp))
(if (integerp arg)
- (outline-show-children (1- arg))
+ (org-show-children (1- arg))
(outline-show-branches))
- (if (bobp) (throw 'exit nil))))))
+ (when (bobp) (throw 'exit nil))))))
(defun org-optimize-window-after-visibility-change (state)
"Adjust the window after a change in outline visibility.
@@ -7087,13 +7273,11 @@ This function is the default value of the hook `org-cycle-hook'."
(defun org-remove-empty-overlays-at (pos)
"Remove outline overlays that do not contain non-white stuff."
- (mapc
- (lambda (o)
- (and (eq 'outline (overlay-get o 'invisible))
- (not (string-match "\\S-" (buffer-substring (overlay-start o)
- (overlay-end o))))
- (delete-overlay o)))
- (overlays-at pos)))
+ (dolist (o (overlays-at pos))
+ (and (eq 'outline (overlay-get o 'invisible))
+ (not (string-match "\\S-" (buffer-substring (overlay-start o)
+ (overlay-end o))))
+ (delete-overlay o))))
(defun org-clean-visibility-after-subtree-move ()
"Fix visibility issues after moving a subtree."
@@ -7111,7 +7295,7 @@ This function is the default value of the hook `org-cycle-hook'."
(point-at-eol)
(point))))
(level (looking-at "\\*+"))
- (re (if level (concat "^" (regexp-quote (match-string 0)) " "))))
+ (re (when level (concat "^" (regexp-quote (match-string 0)) " "))))
(save-excursion
(save-restriction
(narrow-to-region beg end)
@@ -7119,10 +7303,10 @@ This function is the default value of the hook `org-cycle-hook'."
;; Properly fold already folded siblings
(goto-char (point-min))
(while (re-search-forward re nil t)
- (if (and (not (outline-invisible-p))
- (save-excursion
- (goto-char (point-at-eol)) (outline-invisible-p)))
- (outline-hide-entry))))
+ (when (and (not (outline-invisible-p))
+ (save-excursion
+ (goto-char (point-at-eol)) (outline-invisible-p)))
+ (outline-hide-entry))))
(org-cycle-show-empty-lines 'overview)
(org-cycle-hide-drawers 'overview)))))
@@ -7166,9 +7350,9 @@ are at least `org-cycle-separator-lines' empty lines before the headline."
(goto-char (point-max))
(outline-previous-heading)
(outline-end-of-heading)
- (if (and (looking-at "[ \t\n]+")
- (= (match-end 0) (point-max)))
- (outline-flag-region (point) (match-end 0) nil))))
+ (when (and (looking-at "[ \t\n]+")
+ (= (match-end 0) (point-max)))
+ (outline-flag-region (point) (match-end 0) nil))))
(defun org-show-empty-lines-in-parent ()
"Move to the parent and re-show empty lines before visible headlines."
@@ -7177,16 +7361,14 @@ are at least `org-cycle-separator-lines' empty lines before the headline."
(org-cycle-show-empty-lines context))))
(defun org-files-list ()
- "Return `org-agenda-files' list, plus all open org-mode files.
+ "Return `org-agenda-files' list, plus all open Org files.
This is useful for operations that need to scan all of a user's
open and agenda-wise Org files."
(let ((files (mapcar 'expand-file-name (org-agenda-files))))
(dolist (buf (buffer-list))
(with-current-buffer buf
- (if (and (derived-mode-p 'org-mode) (buffer-file-name))
- (let ((file (expand-file-name (buffer-file-name))))
- (unless (member file files)
- (push file files))))))
+ (when (and (derived-mode-p 'org-mode) (buffer-file-name))
+ (cl-pushnew (expand-file-name (buffer-file-name)) files))))
files))
(defsubst org-entry-beginning-position ()
@@ -7226,23 +7408,24 @@ specifying which drawers should not be hidden."
Otherwise make it visible. When optional argument ELEMENT is
a parsed drawer, as returned by `org-element-at-point', hide or
show that drawer instead."
- (when (save-excursion
- (beginning-of-line)
- (org-looking-at-p org-drawer-regexp))
- (let ((drawer (or element (org-element-at-point))))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (let ((post (org-element-property :post-affiliated drawer)))
- (save-excursion
- (outline-flag-region
- (progn (goto-char post) (line-end-position))
- (progn (goto-char (org-element-property :end drawer))
- (skip-chars-backward " \r\t\n")
- (line-end-position))
- flag))
- ;; When the drawer is hidden away, make sure point lies in
- ;; a visible part of the buffer.
- (when (and flag (> (line-beginning-position) post))
- (goto-char post)))))))
+ (let ((drawer (or element
+ (and (save-excursion
+ (beginning-of-line)
+ (looking-at-p org-drawer-regexp))
+ (org-element-at-point)))))
+ (when (memq (org-element-type drawer) '(drawer property-drawer))
+ (let ((post (org-element-property :post-affiliated drawer)))
+ (save-excursion
+ (outline-flag-region
+ (progn (goto-char post) (line-end-position))
+ (progn (goto-char (org-element-property :end drawer))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position))
+ flag))
+ ;; When the drawer is hidden away, make sure point lies in
+ ;; a visible part of the buffer.
+ (when (and flag (> (line-beginning-position) post))
+ (goto-char post))))))
(defun org-subtree-end-visible-p ()
"Is the end of the current subtree visible?"
@@ -7251,9 +7434,11 @@ show that drawer instead."
(defun org-first-headline-recenter ()
"Move cursor to the first headline and recenter the headline."
- (goto-char (point-min))
- (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
- (set-window-start (selected-window) (point-at-bol))))
+ (let ((window (get-buffer-window)))
+ (when window
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
+ (set-window-start window (line-beginning-position))))))
;;; Saving and restoring visibility
@@ -7264,38 +7449,30 @@ The return value is a list of cons cells, with start and stop
positions for each overlay.
If USE-MARKERS is set, return the positions as markers."
(let (beg end)
- (save-excursion
- (save-restriction
- (widen)
- (delq nil
- (mapcar (lambda (o)
- (when (eq (overlay-get o 'invisible) 'outline)
- (setq beg (overlay-start o)
- end (overlay-end o))
- (and beg end (> end beg)
- (if use-markers
- (cons (copy-marker beg)
- (copy-marker end t))
- (cons beg end)))))
- (overlays-in (point-min) (point-max))))))))
+ (org-with-wide-buffer
+ (delq nil
+ (mapcar (lambda (o)
+ (when (eq (overlay-get o 'invisible) 'outline)
+ (setq beg (overlay-start o)
+ end (overlay-end o))
+ (and beg end (> end beg)
+ (if use-markers
+ (cons (copy-marker beg)
+ (copy-marker end t))
+ (cons beg end)))))
+ (overlays-in (point-min) (point-max)))))))
(defun org-set-outline-overlay-data (data)
"Create visibility overlays for all positions in DATA.
DATA should have been made by `org-outline-overlay-data'."
- (let (o)
- (save-excursion
- (save-restriction
- (widen)
- (outline-show-all)
- (mapc (lambda (c)
- (outline-flag-region (car c) (cdr c) t))
- data)))))
+ (org-with-wide-buffer
+ (outline-show-all)
+ (dolist (c data) (outline-flag-region (car c) (cdr c) t))))
;;; Folding of blocks
-(defvar org-hide-block-overlays nil
+(defvar-local org-hide-block-overlays nil
"Overlays hiding blocks.")
-(make-variable-buffer-local 'org-hide-block-overlays)
(defun org-block-map (function &optional start end)
"Call FUNCTION at the head of all source blocks in the current buffer.
@@ -7323,7 +7500,7 @@ Optional arguments START and END can be used to limit the range."
(defun org-show-block-all ()
"Unfold all blocks in the current buffer."
(interactive)
- (mapc 'delete-overlay org-hide-block-overlays)
+ (mapc #'delete-overlay org-hide-block-overlays)
(setq org-hide-block-overlays nil))
(defun org-hide-block-toggle-maybe ()
@@ -7387,12 +7564,10 @@ a block. Return a non-nil value when toggling is successful."
(when (eq (overlay-get ov 'invisible) 'org-hide-block)
(delete-overlay ov))))))))
-;; org-tab-after-check-for-cycling-hook
-(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
- (lambda () (org-add-hook 'change-major-mode-hook
- 'org-show-block-all 'append 'local)))
+ (lambda () (add-hook 'change-major-mode-hook
+ 'org-show-block-all 'append 'local)))
;;; Org-goto
@@ -7476,23 +7651,23 @@ With a prefix argument, use the alternative interface: e.g., if
(selected-point
(if (eq interface 'outline)
(car (org-get-location (current-buffer) org-goto-help))
- (let ((pa (org-refile-get-location "Goto" nil nil t)))
+ (let ((pa (org-refile-get-location "Goto")))
(org-refile-check-position pa)
(nth 3 pa)))))
(if selected-point
(progn
(org-mark-ring-push org-goto-start-pos)
(goto-char selected-point)
- (if (or (outline-invisible-p) (org-invisible-p2))
- (org-show-context 'org-goto)))
+ (when (or (outline-invisible-p) (org-invisible-p2))
+ (org-show-context 'org-goto)))
(message "Quit"))))
(defvar org-goto-selected-point nil) ; dynamically scoped parameter
(defvar org-goto-exit-command nil) ; dynamically scoped parameter
(defvar org-goto-local-auto-isearch-map) ; defined below
-(defun org-get-location (buf help)
- "Let the user select a location in the Org-mode buffer BUF.
+(defun org-get-location (_buf help)
+ "Let the user select a location in current buffer.
This function uses a recursive edit. It returns the selected position
or nil."
(org-no-popups
@@ -7505,7 +7680,7 @@ or nil."
(save-window-excursion
(delete-other-windows)
(and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
- (org-pop-to-buffer-same-window
+ (pop-to-buffer-same-window
(condition-case nil
(make-indirect-buffer (current-buffer) "*org-goto*")
(error (make-indirect-buffer (current-buffer) "*org-goto*"))))
@@ -7568,11 +7743,11 @@ or nil."
(isearch-mode t)
(isearch-process-search-char (string-to-char keys)))))
-(defun org-goto-ret (&optional arg)
+(defun org-goto-ret (&optional _arg)
"Finish `org-goto' by going to the new location."
(interactive "P")
- (setq org-goto-selected-point (point)
- org-goto-exit-command 'return)
+ (setq org-goto-selected-point (point))
+ (setq org-goto-exit-command 'return)
(throw 'exit nil))
(defun org-goto-left ()
@@ -7611,17 +7786,18 @@ or nil."
(defun org-tree-to-indirect-buffer (&optional arg)
"Create indirect buffer and narrow it to current subtree.
+
With a numerical prefix ARG, go up to this level and then take that tree.
If ARG is negative, go up that many levels.
If `org-indirect-buffer-display' is not `new-frame', the command removes the
indirect buffer previously made with this command, to avoid proliferation of
indirect buffers. However, when you call the command with a \
-\\[universal-argument] prefix, or
-when `org-indirect-buffer-display' is `new-frame', the last buffer
-is kept so that you can work with several indirect buffers at the same time.
-If `org-indirect-buffer-display' is `dedicated-frame', the \
-\\[universal-argument] prefix also
+`\\[universal-argument]' prefix, or
+when `org-indirect-buffer-display' is `new-frame', the last buffer is kept
+so that you can work with several indirect buffers at the same time. If
+`org-indirect-buffer-display' is `dedicated-frame', the \
+`\\[universal-argument]' prefix also
requests that a new frame be made for the new buffer, so that the dedicated
frame is not changed."
(interactive "P")
@@ -7633,18 +7809,18 @@ frame is not changed."
(org-back-to-heading t)
(when (numberp arg)
(setq level (org-outline-level))
- (if (< arg 0) (setq arg (+ level arg)))
+ (when (< arg 0) (setq arg (+ level arg)))
(while (> (setq level (org-outline-level)) arg)
(org-up-heading-safe)))
(setq beg (point)
- heading (org-get-heading))
+ heading (org-get-heading 'no-tags))
(org-end-of-subtree t t)
- (if (org-at-heading-p) (backward-char 1))
+ (when (org-at-heading-p) (backward-char 1))
(setq end (point)))
- (if (and (buffer-live-p org-last-indirect-buffer)
- (not (eq org-indirect-buffer-display 'new-frame))
- (not arg))
- (kill-buffer org-last-indirect-buffer))
+ (when (and (buffer-live-p org-last-indirect-buffer)
+ (not (eq org-indirect-buffer-display 'new-frame))
+ (not arg))
+ (kill-buffer org-last-indirect-buffer))
(setq ibuf (org-get-indirect-buffer cbuf heading)
org-last-indirect-buffer ibuf)
(cond
@@ -7652,7 +7828,7 @@ frame is not changed."
(and arg (eq org-indirect-buffer-display 'dedicated-frame)))
(select-frame (make-frame))
(delete-other-windows)
- (org-pop-to-buffer-same-window ibuf)
+ (pop-to-buffer-same-window ibuf)
(org-set-frame-title heading))
((eq org-indirect-buffer-display 'dedicated-frame)
(raise-frame
@@ -7661,15 +7837,13 @@ frame is not changed."
org-indirect-dedicated-frame)
(setq org-indirect-dedicated-frame (make-frame)))))
(delete-other-windows)
- (org-pop-to-buffer-same-window ibuf)
+ (pop-to-buffer-same-window ibuf)
(org-set-frame-title (concat "Indirect: " heading)))
((eq org-indirect-buffer-display 'current-window)
- (org-pop-to-buffer-same-window ibuf))
+ (pop-to-buffer-same-window ibuf))
((eq org-indirect-buffer-display 'other-window)
(pop-to-buffer ibuf))
(t (error "Invalid value")))
- (if (featurep 'xemacs)
- (save-excursion (org-mode) (turn-on-font-lock)))
(narrow-to-region beg end)
(outline-show-all)
(goto-char pos)
@@ -7692,64 +7866,66 @@ frame is not changed."
(defun org-set-frame-title (title)
"Set the title of the current frame to the string TITLE."
- ;; FIXME: how to name a single frame in XEmacs???
- (unless (featurep 'xemacs)
- (modify-frame-parameters (selected-frame) (list (cons 'name title)))))
+ (modify-frame-parameters (selected-frame) (list (cons 'name title))))
;;;; Structure editing
;;; Inserting headlines
-(defun org-previous-line-empty-p (&optional next)
- "Is the previous line a blank line?
-When NEXT is non-nil, check the next line instead."
+(defun org--line-empty-p (n)
+ "Is the Nth next line empty?
+
+Counts the current line as N = 1 and the previous line as N = 0;
+see `beginning-of-line'."
(save-excursion
(and (not (bobp))
- (or (beginning-of-line (if next 2 0)) t)
+ (or (beginning-of-line n) t)
(save-match-data
(looking-at "[ \t]*$")))))
-(defun org-insert-heading (&optional arg invisible-ok top-level)
+(defun org-previous-line-empty-p ()
+ "Is the previous line a blank line?
+When NEXT is non-nil, check the next line instead."
+ (org--line-empty-p 0))
+
+(defun org-next-line-empty-p ()
+ "Is the previous line a blank line?
+When NEXT is non-nil, check the next line instead."
+ (org--line-empty-p 2))
+
+(defun org-insert-heading (&optional arg invisible-ok top)
"Insert a new heading or an item with the same depth at point.
If point is at the beginning of a heading or a list item, insert
-a new heading or a new item above the current one. If point is
-at the beginning of a normal line, turn the line into a heading.
-
-If point is in the middle of a headline or a list item, split the
-headline or the item and create a new headline/item with the text
-in the current line after point \(see `org-M-RET-may-split-line'
-on how to modify this behavior).
-
-With one universal prefix argument, set the user option
-`org-insert-heading-respect-content' to t for the duration of
-the command. This modifies the behavior described above in this
-ways: on list items and at the beginning of normal lines, force
-the insertion of a heading after the current subtree.
-
-With two universal prefix arguments, insert the heading at the
-end of the grandparent subtree. For example, if point is within
-a 2nd-level heading, then it will insert a 2nd-level heading at
-the end of the 1st-level parent heading.
-
-If point is at the beginning of a headline, insert a sibling
-before the current headline. If point is not at the beginning,
-split the line and create a new headline with the text in the
-current line after point \(see `org-M-RET-may-split-line' on how
-to modify this behavior).
-
-If point is at the beginning of a normal line, turn this line
-into a heading.
+a new heading or a new item above the current one. When at the
+beginning of a regular line of text, turn it into a heading.
+
+If point is in the middle of a line, split it and create a new
+headline/item with the text in the current line after point (see
+`org-M-RET-may-split-line' on how to modify this behavior). As
+a special case, on a headline, splitting can only happen on the
+title itself. E.g., this excludes breaking stars or tags.
+
+With a `\\[universal-argument]' prefix, set \
+`org-insert-heading-respect-content' to
+a non-nil value for the duration of the command. This forces the
+insertion of a heading after the current subtree, independently
+on the location of point.
+
+With a `\\[universal-argument] \\[universal-argument]' prefix, \
+insert the heading at the end of the tree
+above the current heading. For example, if point is within a
+2nd-level heading, then it will insert a 2nd-level heading at
+the end of the 1st-level parent subtree.
When INVISIBLE-OK is set, stop at invisible headlines when going
back. This is important for non-interactive uses of the
command.
-When optional argument TOP-LEVEL is non-nil, insert a level 1
-heading, unconditionally."
+When optional argument TOP is non-nil, insert a level 1 heading,
+unconditionally."
(interactive "P")
- (if (org-called-interactively-p 'any) (org-reveal))
- (let ((itemp (and (not top-level) (org-in-item-p)))
+ (let ((itemp (and (not top) (org-in-item-p)))
(may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
(respect-content (or org-insert-heading-respect-content
(equal arg '(4))))
@@ -7797,13 +7973,13 @@ heading, unconditionally."
(if (org-before-first-heading-p) "*"
(save-excursion
(org-back-to-heading t)
- (if (org-previous-line-empty-p) (setq empty-line-p t))
+ (when (org-previous-line-empty-p) (setq empty-line-p t))
(looking-at org-outline-regexp)
(make-string (1- (length (match-string 0))) ?*))))
(stars
(save-excursion
(condition-case nil
- (if top-level "* "
+ (if top "* "
(org-back-to-heading invisible-ok)
(when (and (not on-heading)
(featurep 'org-inlinetask)
@@ -7822,25 +7998,23 @@ heading, unconditionally."
(org-backward-heading-same-level
1 invisible-ok))
(= (point) (match-beginning 0)))
- (not (org-previous-line-empty-p t)))
+ (not (org-next-line-empty-p)))
(setq empty-line-p (or empty-line-p
(org-previous-line-empty-p))))
(match-string 0))
(error (or fix-level "* ")))))
(blank-a (cdr (assq 'heading org-blank-before-new-entry)))
- (blank (if (eq blank-a 'auto) empty-line-p blank-a))
- pos hide-previous previous-pos)
+ (blank (if (eq blank-a 'auto) empty-line-p blank-a)))
;; If we insert after content, move there and clean up
;; whitespace.
- (when (and respect-content
- (not (org-looking-at-p org-outline-regexp-bol)))
+ (when respect-content
(if (not (org-before-first-heading-p))
(org-end-of-subtree nil t)
(re-search-forward org-outline-regexp-bol)
(beginning-of-line 0))
(skip-chars-backward " \r\t\n")
- (and (not (org-looking-back "^\\*+" (line-beginning-position)))
+ (and (not (looking-back "^\\*+" (line-beginning-position)))
(looking-at "[ \t]+") (replace-match ""))
(unless (eobp) (forward-char 1))
(when (looking-at "^\\*")
@@ -7850,13 +8024,14 @@ heading, unconditionally."
;; If we are splitting, grab the text that should be moved
;; to the new headline.
(when may-split
- (if (org-on-heading-p)
+ (if (org-at-heading-p)
;; This is a heading: split intelligently (keeping
;; tags).
(let ((pos (point)))
(beginning-of-line)
- (unless (looking-at org-complex-heading-regexp)
- (error "This should not happen"))
+ (let ((case-fold-search nil))
+ (unless (looking-at org-complex-heading-regexp)
+ (error "This should not happen")))
(when (and (match-beginning 4)
(> pos (match-beginning 4))
(< pos (match-end 4)))
@@ -7913,20 +8088,23 @@ When NO-TAGS is non-nil, don't include tags.
When NO-TODO is non-nil, don't include TODO keywords."
(save-excursion
(org-back-to-heading t)
- (cond
- ((and no-tags no-todo)
- (looking-at org-complex-heading-regexp)
- (match-string 4))
- (no-tags
- (looking-at (concat org-outline-regexp
- "\\(.*?\\)"
- "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
- (match-string 1))
- (no-todo
- (looking-at org-todo-line-regexp)
- (match-string 3))
- (t (looking-at org-heading-regexp)
- (match-string 2)))))
+ (let ((case-fold-search nil))
+ (cond
+ ((and no-tags no-todo)
+ (looking-at org-complex-heading-regexp)
+ ;; Return value has to be a string, but match group 4 is
+ ;; optional.
+ (or (match-string 4) ""))
+ (no-tags
+ (looking-at (concat org-outline-regexp
+ "\\(.*?\\)"
+ "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
+ (match-string 1))
+ (no-todo
+ (looking-at org-todo-line-regexp)
+ (match-string 3))
+ (t (looking-at org-heading-regexp)
+ (match-string 2))))))
(defvar orgstruct-mode) ; defined below
@@ -7941,24 +8119,24 @@ This is a list with the following elements:
- the tags string, or nil."
(save-excursion
(org-back-to-heading t)
- (if (let (case-fold-search)
- (looking-at
- (if orgstruct-mode
- org-heading-regexp
- org-complex-heading-regexp)))
- (if orgstruct-mode
- (list (length (match-string 1))
- (org-reduced-level (length (match-string 1)))
- nil
- nil
- (match-string 2)
- nil)
- (list (length (match-string 1))
- (org-reduced-level (length (match-string 1)))
- (org-match-string-no-properties 2)
- (and (match-end 3) (aref (match-string 3) 2))
- (org-match-string-no-properties 4)
- (org-match-string-no-properties 5))))))
+ (when (let (case-fold-search)
+ (looking-at
+ (if orgstruct-mode
+ org-heading-regexp
+ org-complex-heading-regexp)))
+ (if orgstruct-mode
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ nil
+ nil
+ (match-string 2)
+ nil)
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ (match-string-no-properties 2)
+ (and (match-end 3) (aref (match-string 3) 2))
+ (match-string-no-properties 4)
+ (match-string-no-properties 5))))))
(defun org-get-entry ()
"Get the entry text, after heading, entire subtree."
@@ -7966,6 +8144,24 @@ This is a list with the following elements:
(org-back-to-heading t)
(buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
+(defun org-edit-headline (&optional heading)
+ "Edit the current headline.
+Set it to HEADING when provided."
+ (interactive)
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (let* ((old (match-string-no-properties 4))
+ (new (save-match-data
+ (org-trim (or heading (read-string "Edit: " old))))))
+ (unless (equal old new)
+ (if old (replace-match new t t nil 4)
+ (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
+ (insert " " new))
+ (org-set-tags nil t)
+ (when (looking-at "[ \t]*$") (replace-match ""))))))))
+
(defun org-insert-heading-after-current ()
"Insert a new heading with same level as current, after current subtree."
(interactive)
@@ -7986,9 +8182,14 @@ This is a list with the following elements:
(defun org-insert-todo-heading (arg &optional force-heading)
"Insert a new heading with the same level and TODO state as current heading.
-If the heading has no TODO state, or if the state is DONE, use the first
-state (TODO by default). Also with one prefix arg, force first state. With
-two prefix args, force inserting at the end of the parent subtree."
+
+If the heading has no TODO state, or if the state is DONE, use
+the first state (TODO by default). Also with one prefix arg,
+force first state. With two prefix args, force inserting at the
+end of the parent subtree.
+
+When called at a plain list item, insert a new item with an
+unchecked check box."
(interactive "P")
(when (or force-heading (not (org-insert-item 'checkbox)))
(org-insert-heading (or (and (equal arg '(16)) '(16))
@@ -7997,18 +8198,17 @@ two prefix args, force inserting at the end of the parent subtree."
(org-back-to-heading)
(outline-previous-heading)
(looking-at org-todo-line-regexp))
- (let*
- ((new-mark-x
- (if (or (equal arg '(4))
- (not (match-beginning 2))
- (member (match-string 2) org-done-keywords))
- (car org-todo-keywords-1)
- (match-string 2)))
- (new-mark
- (or
- (run-hook-with-args-until-success
- 'org-todo-get-default-hook new-mark-x nil)
- new-mark-x)))
+ (let* ((new-mark-x
+ (if (or (equal arg '(4))
+ (not (match-beginning 2))
+ (member (match-string 2) org-done-keywords))
+ (car org-todo-keywords-1)
+ (match-string 2)))
+ (new-mark
+ (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook new-mark-x nil)
+ new-mark-x)))
(beginning-of-line 1)
(and (looking-at org-outline-regexp) (goto-char (match-end 0))
(if org-treat-insert-todo-heading-as-state-change
@@ -8139,13 +8339,6 @@ even level numbers will become the next higher odd number."
((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
(max 1 (+ level (or change 0)))))
-(if (boundp 'define-obsolete-function-alias)
- (if (or (featurep 'xemacs) (< emacs-major-version 23))
- (define-obsolete-function-alias 'org-get-legal-level
- 'org-get-valid-level)
- (define-obsolete-function-alias 'org-get-legal-level
- 'org-get-valid-level "23.1")))
-
(defun org-promote ()
"Promote the current heading higher up the tree."
(org-with-wide-buffer
@@ -8193,32 +8386,32 @@ After top level, it switches back to sibling level."
(cond
;; If first headline in file, promote to top-level.
((= prev-level 0)
- (loop repeat (/ (- cur-level 1) (org-level-increment))
- do (org-do-promote)))
+ (cl-loop repeat (/ (- cur-level 1) (org-level-increment))
+ do (org-do-promote)))
;; If same level as prev, demote one.
((= prev-level cur-level)
(org-do-demote))
;; If parent is top-level, promote to top level if not already.
((= prev-level 1)
- (loop repeat (/ (- cur-level 1) (org-level-increment))
- do (org-do-promote)))
+ (cl-loop repeat (/ (- cur-level 1) (org-level-increment))
+ do (org-do-promote)))
;; If top-level, return to prev-level.
((= cur-level 1)
- (loop repeat (/ (- prev-level 1) (org-level-increment))
- do (org-do-demote)))
+ (cl-loop repeat (/ (- prev-level 1) (org-level-increment))
+ do (org-do-demote)))
;; If less than prev-level, promote one.
((< cur-level prev-level)
(org-do-promote))
;; If deeper than prev-level, promote until higher than
;; prev-level.
((> cur-level prev-level)
- (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
- do (org-do-promote))))
+ (cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
+ do (org-do-promote))))
t))))
(defun org-map-tree (fun)
"Call FUN for every heading underneath the current one."
- (org-back-to-heading)
+ (org-back-to-heading t)
(let ((level (funcall outline-level)))
(save-excursion
(funcall fun)
@@ -8234,9 +8427,9 @@ After top level, it switches back to sibling level."
(save-excursion
(setq end (copy-marker end))
(goto-char beg)
- (if (and (re-search-forward org-outline-regexp-bol nil t)
- (< (point) end))
- (funcall fun))
+ (when (and (re-search-forward org-outline-regexp-bol nil t)
+ (< (point) end))
+ (funcall fun))
(while (and (progn
(outline-next-heading)
(< (point) end))
@@ -8272,7 +8465,7 @@ Assume point is at a heading or an inlinetask beginning."
(point)))
(forward-line)
;; Indent properly planning info and property drawer.
- (when (org-looking-at-p org-planning-line-re)
+ (when (looking-at-p org-planning-line-re)
(org-indent-line)
(forward-line))
(when (looking-at org-property-drawer-re)
@@ -8293,12 +8486,12 @@ Assume point is at a heading or an inlinetask beginning."
(save-excursion
(while (not (eobp))
(cond
- ((org-looking-at-p "[ \t]*$") (forward-line))
- ((and (org-looking-at-p org-footnote-definition-re)
+ ((looking-at-p "[ \t]*$") (forward-line))
+ ((and (looking-at-p org-footnote-definition-re)
(let ((e (org-element-at-point)))
(and (eq (org-element-type e) 'footnote-definition)
(goto-char (org-element-property :end e))))))
- ((org-looking-at-p org-outline-regexp) (forward-line))
+ ((looking-at-p org-outline-regexp) (forward-line))
;; Give up if shifting would move before column 0 or
;; if it would introduce a headline or a footnote
;; definition.
@@ -8306,13 +8499,13 @@ Assume point is at a heading or an inlinetask beginning."
(skip-chars-forward " \t")
(let ((ind (current-column)))
(when (or (< ind diff)
- (and (= ind diff) (org-looking-at-p forbidden-re)))
+ (and (= ind diff) (looking-at-p forbidden-re)))
(throw 'no-shift nil)))
;; Ignore contents of example blocks and source
;; blocks if their indentation is meant to be
;; preserved. Jump to block's closing line.
(beginning-of-line)
- (or (and (org-looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
+ (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
(let ((e (org-element-at-point)))
(and (memq (org-element-type e)
'(example-block src-block))
@@ -8328,16 +8521,16 @@ Assume point is at a heading or an inlinetask beginning."
;; when indentation is meant to be preserved.
(while (not (eobp))
(cond
- ((and (org-looking-at-p org-footnote-definition-re)
+ ((and (looking-at-p org-footnote-definition-re)
(let ((e (org-element-at-point)))
(and (eq (org-element-type e) 'footnote-definition)
(goto-char (org-element-property :end e))))))
- ((org-looking-at-p org-outline-regexp) (forward-line))
- ((org-looking-at-p "[ \t]*$") (forward-line))
+ ((looking-at-p org-outline-regexp) (forward-line))
+ ((looking-at-p "[ \t]*$") (forward-line))
(t
- (org-indent-line-to (+ (org-get-indentation) diff))
+ (indent-line-to (+ (org-get-indentation) diff))
(beginning-of-line)
- (or (and (org-looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
+ (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
(let ((e (org-element-at-point)))
(and (memq (org-element-type e)
'(example-block src-block))
@@ -8350,7 +8543,7 @@ Assume point is at a heading or an inlinetask beginning."
(forward-line)))))))))
(defun org-convert-to-odd-levels ()
- "Convert an org-mode file with all levels allowed to one with odd levels.
+ "Convert an Org file with all levels allowed to one with odd levels.
This will leave level 1 alone, convert level 2 to level 3, level 3 to
level 5 etc."
(interactive)
@@ -8366,7 +8559,7 @@ level 5 etc."
(end-of-line 1))))))
(defun org-convert-to-oddeven-levels ()
- "Convert an org-mode file with only odd levels to one with odd/even levels.
+ "Convert an Org file with only odd levels to one with odd/even levels.
This promotes level 3 to level 2, level 5 to level 3 etc. If the
file contains a section with an even level, conversion would
destroy the structure of the file. An error is signaled in this
@@ -8437,12 +8630,12 @@ case."
(progn (goto-char beg0)
(user-error "Cannot move past superior level or buffer limit")))
(setq cnt (1- cnt)))
- (if (> arg 0)
- ;; Moving forward - still need to move over subtree
- (progn (org-end-of-subtree t t)
- (save-excursion
- (org-back-over-empty-lines)
- (or (bolp) (newline)))))
+ (when (> arg 0)
+ ;; Moving forward - still need to move over subtree
+ (org-end-of-subtree t t)
+ (save-excursion
+ (org-back-over-empty-lines)
+ (or (bolp) (newline))))
(setq ne-ins (org-back-over-empty-lines))
(move-marker ins-point (point))
(setq txt (buffer-substring beg end))
@@ -8473,7 +8666,7 @@ case."
(if folded
(outline-hide-subtree)
(org-show-entry)
- (outline-show-children)
+ (org-show-children)
(org-cycle-hide-drawers 'children))
(org-clean-visibility-after-subtree-move)
;; move back to the initial column we were at
@@ -8505,7 +8698,7 @@ of some markers in the region, even if CUT is non-nil. This is
useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(interactive "p")
(let (beg end folded (beg0 (point)))
- (if (org-called-interactively-p 'any)
+ (if (called-interactively-p 'any)
(org-back-to-heading nil) ; take what looks like a subtree
(org-back-to-heading t)) ; take what is really there
(setq beg (point))
@@ -8610,22 +8803,22 @@ When REMOVE is non-nil, remove the subtree from the clipboard."
(org-odd-levels-only nil)
beg end newend)
;; Remove the forced level indicator
- (if force-level
- (delete-region (point-at-bol) (point)))
+ (when force-level
+ (delete-region (point-at-bol) (point)))
;; Paste
(beginning-of-line (if (bolp) 1 2))
(setq beg (point))
(and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
(insert-before-markers txt)
- (unless (string-match "\n\\'" txt) (insert "\n"))
+ (unless (string-suffix-p "\n" txt) (insert "\n"))
(setq newend (point))
(org-reinstall-markers-in-region beg)
(setq end (point))
(goto-char beg)
(skip-chars-forward " \t\n\r")
(setq beg (point))
- (if (and (outline-invisible-p) visp)
- (save-excursion (outline-show-heading)))
+ (when (and (outline-invisible-p) visp)
+ (save-excursion (outline-show-heading)))
;; Shift if necessary
(unless (= shift 0)
(save-restriction
@@ -8635,14 +8828,14 @@ When REMOVE is non-nil, remove the subtree from the clipboard."
(setq shift (+ delta shift)))
(goto-char (point-min))
(setq newend (point-max))))
- (when (or (org-called-interactively-p 'interactive) for-yank)
+ (when (or (called-interactively-p 'interactive) for-yank)
(message "Clipboard pasted as level %d subtree" new-level))
- (if (and (not for-yank) ; in this case, org-yank will decide about folding
- kill-ring
- (eq org-subtree-clip (current-kill 0))
- org-subtree-clip-folded)
- ;; The tree was folded before it was killed/copied
- (outline-hide-subtree))
+ (when (and (not for-yank) ; in this case, org-yank will decide about folding
+ kill-ring
+ (eq org-subtree-clip (current-kill 0))
+ org-subtree-clip-folded)
+ ;; The tree was folded before it was killed/copied
+ (outline-hide-subtree))
(and for-yank (goto-char newend))
(and remove (setq kill-ring (cdr kill-ring))))))
@@ -8694,15 +8887,14 @@ called immediately, to move the markers with the entries."
"Check if MARKER is between BEG and END.
If yes, remember the marker and the distance to BEG."
(when (and (marker-buffer marker)
- (equal (marker-buffer marker) (current-buffer)))
- (if (and (>= marker beg) (< marker end))
- (push (cons marker (- marker beg)) org-markers-to-move))))
+ (equal (marker-buffer marker) (current-buffer))
+ (>= marker beg) (< marker end))
+ (push (cons marker (- marker beg)) org-markers-to-move)))
(defun org-reinstall-markers-in-region (beg)
"Move all remembered markers to their position relative to BEG."
- (mapc (lambda (x)
- (move-marker (car x) (+ beg (cdr x))))
- org-markers-to-move)
+ (dolist (x org-markers-to-move)
+ (move-marker (car x) (+ beg (cdr x))))
(setq org-markers-to-move nil))
(defun org-narrow-to-subtree ()
@@ -8714,7 +8906,7 @@ If yes, remember the marker and the distance to BEG."
(narrow-to-region
(progn (org-back-to-heading t) (point))
(progn (org-end-of-subtree t t)
- (if (and (org-at-heading-p) (not (eobp))) (backward-char 1))
+ (when (and (org-at-heading-p) (not (eobp))) (backward-char 1))
(point)))))))
(defun org-narrow-to-block ()
@@ -8743,6 +8935,9 @@ stamps in the subtree shifted for each clone produced. If SHIFT
is nil or the empty string, time stamps will be left alone. The
ID property of the original subtree is removed.
+In each clone, all the CLOCK entries will be removed. This
+prevents Org from considering that the clocked times overlap.
+
If the original subtree did contain time stamps with a repeater,
the following will happen:
- the repeater will be removed in each clone
@@ -8778,16 +8973,16 @@ with the original repeater."
shift-n shift-what doshift nmin nmax)
(unless (wholenump n)
(user-error "Invalid number of replications %s" n))
- (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
- (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'"
- shift)))
- (user-error "Invalid shift specification %s" shift))
+ (when (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
+ (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'"
+ shift)))
+ (user-error "Invalid shift specification %s" shift))
(when doshift
(setq shift-n (string-to-number (match-string 1 shift))
shift-what (cdr (assoc (match-string 2 shift)
'(("d" . day) ("w" . week)
("m" . month) ("y" . year))))))
- (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day))
+ (when (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day))
(setq nmin 1 nmax n)
(org-back-to-heading t)
(setq beg (point))
@@ -8802,35 +8997,35 @@ with the original repeater."
(setq end beg)
(setq nmin 0 nmax (1+ nmax) n-no-remove nmax))
(goto-char end)
- (loop for n from nmin to nmax do
- ;; prepare clone
- (with-temp-buffer
- (insert template)
- (org-mode)
- (goto-char (point-min))
- (org-show-subtree)
- (and idprop (if org-clone-delete-id
- (org-entry-delete nil "ID")
- (org-id-get-create t)))
- (unless (= n 0)
- (while (re-search-forward org-clock-re nil t)
- (kill-whole-line))
- (goto-char (point-min))
- (while (re-search-forward drawer-re nil t)
- (org-remove-empty-drawer-at (point))))
- (goto-char (point-min))
- (when doshift
- (while (re-search-forward org-ts-regexp-both nil t)
- (org-timestamp-change (* n shift-n) shift-what))
- (unless (= n n-no-remove)
- (goto-char (point-min))
- (while (re-search-forward org-ts-regexp nil t)
- (save-excursion
- (goto-char (match-beginning 0))
- (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
- (delete-region (match-beginning 1) (match-end 1)))))))
- (setq task (buffer-string)))
- (insert task))
+ (cl-loop for n from nmin to nmax do
+ ;; prepare clone
+ (with-temp-buffer
+ (insert template)
+ (org-mode)
+ (goto-char (point-min))
+ (org-show-subtree)
+ (and idprop (if org-clone-delete-id
+ (org-entry-delete nil "ID")
+ (org-id-get-create t)))
+ (unless (= n 0)
+ (while (re-search-forward org-clock-re nil t)
+ (kill-whole-line))
+ (goto-char (point-min))
+ (while (re-search-forward drawer-re nil t)
+ (org-remove-empty-drawer-at (point))))
+ (goto-char (point-min))
+ (when doshift
+ (while (re-search-forward org-ts-regexp-both nil t)
+ (org-timestamp-change (* n shift-n) shift-what))
+ (unless (= n n-no-remove)
+ (goto-char (point-min))
+ (while (re-search-forward org-ts-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
+ (delete-region (match-beginning 1) (match-end 1)))))))
+ (setq task (buffer-string)))
+ (insert task))
(goto-char beg)))
;;; Outline Sorting
@@ -8927,7 +9122,7 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
(setq end (region-end)
what "region")
(goto-char (region-beginning))
- (if (not (org-at-heading-p)) (outline-next-heading))
+ (unless (org-at-heading-p) (outline-next-heading))
(setq start (point)))
((or (org-at-heading-p)
(ignore-errors (progn (org-back-to-heading) t)))
@@ -8967,9 +9162,9 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
re (concat "^" (regexp-quote stars) " +")
re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]")
txt (buffer-substring beg end))
- (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
- (if (and (not (equal stars "*")) (string-match re2 txt))
- (user-error "Region to sort contains a level above the first entry"))
+ (unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n")))
+ (when (and (not (equal stars "*")) (string-match re2 txt))
+ (user-error "Region to sort contains a level above the first entry"))
(unless sorting-type
(message
@@ -8982,16 +9177,16 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
(unless getkey-func
(and (= (downcase sorting-type) ?f)
(setq getkey-func
- (org-icompleting-read "Sort using function: "
- obarray 'fboundp t nil nil))
+ (completing-read "Sort using function: "
+ obarray 'fboundp t nil nil))
(setq getkey-func (intern getkey-func))))
(and (= (downcase sorting-type) ?r)
(not property)
(setq property
- (org-icompleting-read "Property: "
- (mapcar 'list (org-buffer-property-keys t))
- nil t))))
+ (completing-read "Property: "
+ (mapcar #'list (org-buffer-property-keys t))
+ nil t))))
(when (member sorting-type '(?k ?K)) (org-clock-sum))
(message "Sorting entries...")
@@ -9035,24 +9230,24 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
(if (or (re-search-forward org-ts-regexp end t)
(re-search-forward org-ts-regexp-both end t))
(org-time-string-to-seconds (match-string 0))
- (org-float-time now))))
+ (float-time now))))
((= dcst ?c)
(let ((end (save-excursion (outline-next-heading) (point))))
(if (re-search-forward
(concat "^[ \t]*\\[" org-ts-regexp1 "\\]")
end t)
(org-time-string-to-seconds (match-string 0))
- (org-float-time now))))
+ (float-time now))))
((= dcst ?s)
(let ((end (save-excursion (outline-next-heading) (point))))
(if (re-search-forward org-scheduled-time-regexp end t)
(org-time-string-to-seconds (match-string 1))
- (org-float-time now))))
+ (float-time now))))
((= dcst ?d)
(let ((end (save-excursion (outline-next-heading) (point))))
(if (re-search-forward org-deadline-time-regexp end t)
(org-time-string-to-seconds (match-string 1))
- (org-float-time now))))
+ (float-time now))))
((= dcst ?p)
(if (re-search-forward org-priority-regexp (point-at-eol) t)
(string-to-char (match-string 2))
@@ -9060,15 +9255,15 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
((= dcst ?r)
(or (org-entry-get nil property) ""))
((= dcst ?o)
- (if (looking-at org-complex-heading-regexp)
- (let* ((m (match-string 2))
- (s (if (member m org-done-keywords) '- '+)))
- (- 99 (funcall s (length (member m org-todo-keywords-1)))))))
+ (when (looking-at org-complex-heading-regexp)
+ (let* ((m (match-string 2))
+ (s (if (member m org-done-keywords) '- '+)))
+ (- 99 (funcall s (length (member m org-todo-keywords-1)))))))
((= dcst ?f)
(if getkey-func
(progn
(setq tmp (funcall getkey-func))
- (if (stringp tmp) (setq tmp (funcall case-func tmp)))
+ (when (stringp tmp) (setq tmp (funcall case-func tmp)))
tmp)
(error "Invalid key function `%s'" getkey-func)))
(t (error "Invalid sorting type `%c'" sorting-type))))
@@ -9089,15 +9284,15 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
;;; The orgstruct minor mode
;; Define a minor mode which can be used in other modes in order to
-;; integrate the org-mode structure editing commands.
+;; integrate the Org mode structure editing commands.
-;; This is really a hack, because the org-mode structure commands use
+;; This is really a hack, because the Org mode structure commands use
;; keys which normally belong to the major mode. Here is how it
;; works: The minor mode defines all the keys necessary to operate the
;; structure commands, but wraps the commands into a function which
;; tests if the cursor is currently at a headline or a plain list
;; item. If that is the case, the structure command is used,
-;; temporarily setting many Org-mode variables like regular
+;; temporarily setting many Org mode variables like regular
;; expressions for filling etc. However, when any of those keys is
;; used at a different location, function uses `key-binding' to look
;; up if the key has an associated command in another currently active
@@ -9129,10 +9324,10 @@ orgstruct(++)-mode."
;;;###autoload
(define-minor-mode orgstruct-mode
"Toggle the minor mode `orgstruct-mode'.
-This mode is for using Org-mode structure commands in other
-modes. The following keys behave as if Org-mode were active, if
+This mode is for using Org mode structure commands in other
+modes. The following keys behave as if Org mode were active, if
the cursor is on a headline, or on a plain list item (both as
-defined by Org-mode)."
+defined by Org mode)."
nil " OrgStruct" (make-sparse-keymap)
(funcall (if orgstruct-mode
'add-to-invisibility-spec
@@ -9149,40 +9344,38 @@ defined by Org-mode)."
"Unconditionally turn on `orgstruct-mode'."
(orgstruct-mode 1))
-(defvar org-fb-vars nil)
-(make-variable-buffer-local 'org-fb-vars)
+(defvar-local orgstruct-is-++ nil
+ "Is `orgstruct-mode' in ++ version in the current-buffer?")
+(defvar-local org-fb-vars nil)
(defun orgstruct++-mode (&optional arg)
"Toggle `orgstruct-mode', the enhanced version of it.
In addition to setting orgstruct-mode, this also exports all
-indentation and autofilling variables from org-mode into the
+indentation and autofilling variables from Org mode into the
buffer. It will also recognize item context in multiline items."
(interactive "P")
(setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
(if (< arg 1)
(progn (orgstruct-mode -1)
- (mapc (lambda(v)
- (org-set-local (car v)
- (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v))))
- org-fb-vars))
+ (dolist (v org-fb-vars)
+ (set (make-local-variable (car v))
+ (if (eq (car-safe (cadr v)) 'quote)
+ (cl-cadadr v)
+ (nth 1 v)))))
(orgstruct-mode 1)
(setq org-fb-vars nil)
(unless org-local-vars
(setq org-local-vars (org-get-local-variables)))
(let (var val)
- (mapc
- (lambda (x)
- (when (string-match
- "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)"
- (symbol-name (car x)))
- (setq var (car x) val (nth 1 x))
- (push (list var `(quote ,(eval var))) org-fb-vars)
- (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
- org-local-vars)
- (org-set-local 'orgstruct-is-++ t))))
-
-(defvar orgstruct-is-++ nil
- "Is `orgstruct-mode' in ++ version in the current-buffer?")
-(make-variable-buffer-local 'orgstruct-is-++)
+ (dolist (x org-local-vars)
+ (when (string-match
+ "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\
+\\|fill-prefix\\|indent-\\)"
+ (symbol-name (car x)))
+ (setq var (car x) val (nth 1 x))
+ (push (list var `(quote ,(eval var))) org-fb-vars)
+ (set (make-local-variable var)
+ (if (eq (car-safe val) 'quote) (nth 1 val) val))))
+ (setq-local orgstruct-is-++ t))))
;;;###autoload
(defun turn-on-orgstruct++ ()
@@ -9211,6 +9404,7 @@ buffer. It will also recognize item context in multiline items."
org-ctrl-c-minus
org-ctrl-c-star
org-cycle
+ org-force-cycle-archived
org-forward-heading-same-level
org-insert-heading
org-insert-heading-respect-content
@@ -9230,6 +9424,7 @@ buffer. It will also recognize item context in multiline items."
org-shifttab
org-shifttab
org-shiftup
+ org-show-children
org-show-subtree
org-sort
org-up-element
@@ -9237,8 +9432,7 @@ buffer. It will also recognize item context in multiline items."
outline-next-visible-heading
outline-previous-visible-heading
outline-promote
- outline-up-heading
- outline-show-children))
+ outline-up-heading))
(let ((f (or (car-safe cell) cell))
(disable-when-heading-prefix (cdr-safe cell)))
(when (fboundp f)
@@ -9257,7 +9451,7 @@ buffer. It will also recognize item context in multiline items."
(regexp-quote (cdr rep))
(car rep)
(key-description binding)))))
- (pushnew binding new-bindings :test 'equal)))
+ (cl-pushnew binding new-bindings :test 'equal)))
(dolist (binding new-bindings)
(let ((key (lookup-key orgstruct-mode-map binding)))
(when (or (not key) (numberp key))
@@ -9364,9 +9558,9 @@ definitions."
;; normalize contexts
(mapcar
(lambda(c) (cond ((listp (cadr c))
- (list (car c) (car c) (cadr c)))
+ (list (car c) (car c) (nth 1 c)))
((string= "" (cadr c))
- (list (car c) (car c) (caddr c)))
+ (list (car c) (car c) (nth 2 c)))
(t c)))
contexts))
(a alist) r s)
@@ -9380,7 +9574,7 @@ definitions."
(setq vrules (org-contextualize-validate-key
(car c) contexts)))
(mapc (lambda (vr)
- (when (not (equal (car vr) (cadr vr)))
+ (unless (equal (car vr) (cadr vr))
(setq repl vr)))
vrules)
(if (not repl) (push c r)
@@ -9397,39 +9591,37 @@ definitions."
(delete-dups
(mapcar (lambda (x)
(let ((tpl (car x)))
- (when (not (delq
- nil
- (mapcar (lambda (y)
- (equal y tpl))
- s)))
+ (unless (delq
+ nil
+ (mapcar (lambda (y)
+ (equal y tpl))
+ s))
x)))
(reverse r))))))
(defun org-contextualize-validate-key (key contexts)
"Check CONTEXTS for agenda or capture KEY."
- (let (rr res)
+ (let (res)
(dolist (r contexts)
- (mapc
- (lambda (rr)
- (when
- (and (equal key (car r))
- (if (functionp rr) (funcall rr)
- (or (and (eq (car rr) 'in-file)
- (buffer-file-name)
- (string-match (cdr rr) (buffer-file-name)))
- (and (eq (car rr) 'in-mode)
- (string-match (cdr rr) (symbol-name major-mode)))
- (and (eq (car rr) 'in-buffer)
- (string-match (cdr rr) (buffer-name)))
- (when (and (eq (car rr) 'not-in-file)
- (buffer-file-name))
- (not (string-match (cdr rr) (buffer-file-name))))
- (when (eq (car rr) 'not-in-mode)
- (not (string-match (cdr rr) (symbol-name major-mode))))
- (when (eq (car rr) 'not-in-buffer)
- (not (string-match (cdr rr) (buffer-name)))))))
- (push r res)))
- (car (last r))))
+ (dolist (rr (car (last r)))
+ (when
+ (and (equal key (car r))
+ (if (functionp rr) (funcall rr)
+ (or (and (eq (car rr) 'in-file)
+ (buffer-file-name)
+ (string-match (cdr rr) (buffer-file-name)))
+ (and (eq (car rr) 'in-mode)
+ (string-match (cdr rr) (symbol-name major-mode)))
+ (and (eq (car rr) 'in-buffer)
+ (string-match (cdr rr) (buffer-name)))
+ (when (and (eq (car rr) 'not-in-file)
+ (buffer-file-name))
+ (not (string-match (cdr rr) (buffer-file-name))))
+ (when (eq (car rr) 'not-in-mode)
+ (not (string-match (cdr rr) (symbol-name major-mode))))
+ (when (eq (car rr) 'not-in-buffer)
+ (not (string-match (cdr rr) (buffer-name)))))))
+ (push r res))))
(delete-dups (delq nil res))))
(defun org-context-p (&rest contexts)
@@ -9447,45 +9639,47 @@ Possible values in the list of contexts are `table', `headline', and `item'."
(org-in-item-p)))
(goto-char pos))))
+(defconst org-unique-local-variables
+ '(org-element--cache
+ org-element--cache-objects
+ org-element--cache-sync-keys
+ org-element--cache-sync-requests
+ org-element--cache-sync-timer)
+ "List of local variables that cannot be transferred to another buffer.")
+
(defun org-get-local-variables ()
"Return a list of all local variables in an Org mode buffer."
- (let (varlist)
- (with-current-buffer (get-buffer-create "*Org tmp*")
- (erase-buffer)
- (org-mode)
- (setq varlist (buffer-local-variables)))
- (kill-buffer "*Org tmp*")
- (delq nil
- (mapcar
- (lambda (x)
- (setq x
- (if (symbolp x)
- (list x)
- (list (car x) (cdr x))))
- (if (and (not (get (car x) 'org-state))
- (string-match
- "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
- (symbol-name (car x))))
- x nil))
- varlist))))
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x))))
+ (name (car binding)))
+ (and (not (get name 'org-state))
+ (not (memq name org-unique-local-variables))
+ (string-match-p
+ "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\
+auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
+ (symbol-name name))
+ binding)))
+ (with-temp-buffer
+ (org-mode)
+ (buffer-local-variables)))))
(defun org-clone-local-variables (from-buffer &optional regexp)
"Clone local variables from FROM-BUFFER.
Optional argument REGEXP selects variables to clone."
- (mapc
- (lambda (pair)
- (and (symbolp (car pair))
- (or (null regexp)
- (string-match regexp (symbol-name (car pair))))
- (set (make-local-variable (car pair))
- (cdr pair))))
- (buffer-local-variables from-buffer)))
+ (dolist (pair (buffer-local-variables from-buffer))
+ (let ((name (car pair)))
+ (when (and (symbolp name)
+ (not (memq name org-unique-local-variables))
+ (or (null regexp) (string-match regexp (symbol-name name))))
+ (set (make-local-variable name) (cdr pair))))))
;;;###autoload
(defun org-run-like-in-org-mode (cmd)
- "Run a command, pretending that the current buffer is in Org-mode.
+ "Run a command, pretending that the current buffer is in Org mode.
This will temporarily bind local variables that are typically bound in
-Org-mode to the values they have in Org-mode, and then interactively
+Org mode to the values they have in Org mode, and then interactively
call CMD."
(org-load-modules-maybe)
(unless org-local-vars
@@ -9502,7 +9696,7 @@ call CMD."
(defun org-get-category (&optional pos force-refresh)
"Get the category applying to position POS."
(save-match-data
- (if force-refresh (org-refresh-category-properties))
+ (when force-refresh (org-refresh-category-properties))
(let ((pos (or pos (point))))
(or (get-text-property pos 'org-category)
(progn (org-refresh-category-properties)
@@ -9519,12 +9713,10 @@ the value of the drawer property."
(let ((case-fold-search t)
(inhibit-read-only t))
(org-with-silent-modifications
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t)
- (org-refresh-property tprop (org-match-string-no-properties 1))))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t)
+ (org-refresh-property tprop (match-string-no-properties 1)))))))
(defun org-refresh-property (tprop p)
"Refresh the buffer text property TPROP from the drawer property P.
@@ -9576,7 +9768,7 @@ The refresh happens only for the current tree (not subtree)."
(goto-char (point-min))
(let ((regexp (org-re-property "CATEGORY")))
(while (re-search-forward regexp nil t)
- (let ((value (org-match-string-no-properties 3)))
+ (let ((value (match-string-no-properties 3)))
(when (org-at-property-p)
(put-text-property
(save-excursion (org-back-to-heading t) (point))
@@ -9588,22 +9780,20 @@ The refresh happens only for the current tree (not subtree)."
"Refresh stats text properties in the buffer."
(let (stats)
(org-with-silent-modifications
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward
- (concat org-outline-regexp-bol ".*"
- "\\(?:\\[\\([0-9]+\\)%\\|\\([0-9]+\\)/\\([0-9]+\\)\\]\\)")
- nil t)
- (setq stats (cond ((equal (match-string 3) "0") 0)
- ((match-string 2)
- (/ (* (string-to-number (match-string 2)) 100)
- (string-to-number (match-string 3))))
- (t (string-to-number (match-string 1)))))
- (org-back-to-heading t)
- (put-text-property (point) (progn (org-end-of-subtree t t) (point))
- 'org-stats stats)))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat org-outline-regexp-bol ".*"
+ "\\(?:\\[\\([0-9]+\\)%\\|\\([0-9]+\\)/\\([0-9]+\\)\\]\\)")
+ nil t)
+ (setq stats (cond ((equal (match-string 3) "0") 0)
+ ((match-string 2)
+ (/ (* (string-to-number (match-string 2)) 100)
+ (string-to-number (match-string 3))))
+ (t (string-to-number (match-string 1)))))
+ (org-back-to-heading t)
+ (put-text-property (point) (progn (org-end-of-subtree t t) (point))
+ 'org-stats stats))))))
(defun org-refresh-effort-properties ()
"Refresh effort properties"
@@ -9650,78 +9840,53 @@ The refresh happens only for the current tree (not subtree)."
(defvar org-store-link-plist nil
"Plist with info about the most recently link created with `org-store-link'.")
-(defvar org-link-protocols nil
- "Link protocols added to Org-mode using `org-add-link-type'.")
+(defun org-store-link-functions ()
+ "Return a list of functions that are called to create and store a link.
+The functions defined in the :store property of
+`org-link-parameters'.
-(defvar org-store-link-functions nil
- "List of functions that are called to create and store a link.
Each function will be called in turn until one returns a non-nil
-value. Each function should check if it is responsible for creating
-this link (for example by looking at the major mode).
-If not, it must exit and return nil.
-If yes, it should return a non-nil value after a calling
-`org-store-link-props' with a list of properties and values.
-Special properties are:
+value. Each function should check if it is responsible for
+creating this link (for example by looking at the major mode).
+If not, it must exit and return nil. If yes, it should return
+a non-nil value after calling `org-store-link-props' with a list
+of properties and values. Special properties are:
:type The link prefix, like \"http\". This must be given.
:link The link, like \"http://www.astro.uva.nl/~dominik\".
This is obligatory as well.
:description Optional default description for the second pair
- of brackets in an Org-mode link. The user can still change
- this when inserting this link into an Org-mode buffer.
+ of brackets in an Org mode link. The user can still change
+ this when inserting this link into an Org mode buffer.
In addition to these, any additional properties can be specified
-and then used in capture templates.")
-
-(defun org-add-link-type (type &optional follow export)
- "Add TYPE to the list of `org-link-types'.
-Re-compute all regular expressions depending on `org-link-types'
-
-FOLLOW and EXPORT are two functions.
-
-FOLLOW should take the link path as the single argument and do whatever
-is necessary to follow the link, for example find a file or display
-a mail message.
-
-EXPORT should format the link path for export to one of the export formats.
-It should be a function accepting three arguments:
-
- path the path of the link, the text after the prefix (like \"http:\")
- desc the description of the link, if any
- format the export format, a symbol like `html' or `latex' or `ascii'.
-
-The function may use the FORMAT information to return different values
-depending on the format. The return value will be put literally into
-the exported file. If the return value is nil, this means Org should
-do what it normally does with links which do not have EXPORT defined.
-
-Org mode has a built-in default for exporting links. If you are happy with
-this default, there is no need to define an export function for the link
-type. For a simple example of an export function, see `org-bbdb.el'."
- (add-to-list 'org-link-types type t)
- (org-make-link-regexps)
- (org-element-update-syntax)
- (if (assoc type org-link-protocols)
- (setcdr (assoc type org-link-protocols) (list follow export))
- (push (list type follow export) org-link-protocols)))
+and then used in capture templates."
+ (cl-loop for link in org-link-parameters
+ with store-func
+ do (setq store-func (org-link-get-parameter (car link) :store))
+ if store-func
+ collect store-func))
(defvar org-agenda-buffer-name) ; Defined in org-agenda.el
(defvar org-id-link-to-org-use-id) ; Defined in org-id.el
;;;###autoload
(defun org-store-link (arg)
- "\\<org-mode-map>Store an org-link to the current location.
+ "Store an org-link to the current location.
+\\<org-mode-map>
This link is added to `org-stored-links' and can later be inserted
-into an Org buffer with \\[org-insert-link].
+into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
-For some link types, a prefix ARG is interpreted.
+For some link types, a `\\[universal-argument]' prefix ARG is interpreted.
For links to Usenet articles, ARG negates `org-gnus-prefer-web-links'.
For file links, ARG negates `org-context-in-file-links'.
-A double prefix ARG force skipping storing functions that are not
-part of Org's core.
+A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
+skipping storing functions that are not
+part of Org core.
-A triple prefix ARG force storing a link for each line in the
+A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
+prefix ARG forces storing a link for each line in the
active region."
(interactive "P")
(org-load-modules-maybe)
@@ -9736,118 +9901,111 @@ active region."
(call-interactively 'org-store-link))
(move-beginning-of-line 2)
(set-mark (point)))))
- (org-with-limited-levels
- (setq org-store-link-plist nil)
- (let (link cpltxt desc description search
- txt custom-id agenda-link sfuns sfunsn)
- (cond
+ (setq org-store-link-plist nil)
+ (let (link cpltxt desc description search
+ txt custom-id agenda-link sfuns sfunsn)
+ (cond
- ;; Store a link using an external link type
- ((and (not (equal arg '(16)))
- (setq sfuns
- (delq
- nil (mapcar (lambda (f)
- (let (fs) (if (funcall f) (push f fs))))
- org-store-link-functions))
- sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
- (or (and (cdr sfuns)
- (funcall (intern
- (completing-read
- "Which function for creating the link? "
- sfunsn nil t (car sfunsn)))))
- (funcall (caar sfuns)))
- (setq link (plist-get org-store-link-plist :link)
- desc (or (plist-get org-store-link-plist
- :description)
- link))))
-
- ;; Store a link from a source code buffer.
- ((org-src-edit-buffer-p)
- (cond
- ((save-excursion
- (beginning-of-line)
- (looking-at (concat (format org-coderef-label-format "\\(.*?\\)")
- "[ \t]*$")))
- (setq link (format "(%s)" (org-match-string-no-properties 1))))
- ((org-called-interactively-p 'any)
- (let (label)
- (while (or (not label)
- (org-with-wide-buffer
- (goto-char (point-min))
- (re-search-forward
- (regexp-quote (format org-coderef-label-format label))
- nil t)))
- (when label (message "Label exists already") (sit-for 2))
- (setq label (read-string "Code line label: " label)))
- (end-of-line)
- (setq link (format org-coderef-label-format label))
- (let ((gc (- 79 (length link))))
- (if (< (current-column) gc) (org-move-to-column gc t)
- (insert " ")))
- (insert link)
- (setq link (concat "(" label ")") desc nil)))
- (t (setq link nil))))
-
- ;; We are in the agenda, link to referenced location
- ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
- (let ((m (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-marker))))
- (when m
- (org-with-point-at m
- (setq agenda-link
- (if (org-called-interactively-p 'any)
- (call-interactively 'org-store-link)
- (org-store-link nil)))))))
-
- ((eq major-mode 'calendar-mode)
- (let ((cd (calendar-cursor-to-date)))
- (setq link
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time
- (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
- nil nil nil))))
- (org-store-link-props :type "calendar" :date cd)))
-
- ((eq major-mode 'help-mode)
- (setq link (concat "help:" (save-excursion
- (goto-char (point-min))
- (looking-at "^[^ ]+")
- (match-string 0))))
- (org-store-link-props :type "help"))
-
- ((eq major-mode 'w3-mode)
- (setq cpltxt (if (and (buffer-name)
- (not (string-match "Untitled" (buffer-name))))
- (buffer-name)
- (url-view-url t))
- link (url-view-url t))
- (org-store-link-props :type "w3" :url (url-view-url t)))
-
- ((eq major-mode 'image-mode)
- (setq cpltxt (concat "file:"
- (abbreviate-file-name buffer-file-name))
- link cpltxt)
- (org-store-link-props :type "image" :file buffer-file-name))
-
- ;; In dired, store a link to the file of the current line
- ((derived-mode-p 'dired-mode)
- (let ((file (dired-get-filename nil t)))
- (setq file (if file
- (abbreviate-file-name
- (expand-file-name (dired-get-filename nil t)))
- ;; otherwise, no file so use current directory.
- default-directory))
- (setq cpltxt (concat "file:" file)
- link cpltxt)))
-
- ((setq search (run-hook-with-args-until-success
- 'org-create-file-search-functions))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" search))
- (setq cpltxt (or description link)))
-
- ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ ;; Store a link using an external link type
+ ((and (not (equal arg '(16)))
+ (setq sfuns
+ (delq
+ nil (mapcar (lambda (f)
+ (let (fs) (if (funcall f) (push f fs))))
+ (org-store-link-functions)))
+ sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
+ (or (and (cdr sfuns)
+ (funcall (intern
+ (completing-read
+ "Which function for creating the link? "
+ sfunsn nil t (car sfunsn)))))
+ (funcall (caar sfuns)))
+ (setq link (plist-get org-store-link-plist :link)
+ desc (or (plist-get org-store-link-plist
+ :description)
+ link))))
+
+ ;; Store a link from a source code buffer.
+ ((org-src-edit-buffer-p)
+ (let ((coderef-format (org-src-coderef-format)))
+ (cond ((save-excursion
+ (beginning-of-line)
+ (looking-at (org-src-coderef-regexp coderef-format)))
+ (setq link (format "(%s)" (match-string-no-properties 3))))
+ ((called-interactively-p 'any)
+ (let ((label (read-string "Code line label: ")))
+ (end-of-line)
+ (setq link (format coderef-format label))
+ (let ((gc (- 79 (length link))))
+ (if (< (current-column) gc)
+ (org-move-to-column gc t)
+ (insert " ")))
+ (insert link)
+ (setq link (concat "(" label ")"))
+ (setq desc nil)))
+ (t (setq link nil)))))
+
+ ;; We are in the agenda, link to referenced location
+ ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name))
+ (let ((m (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker))))
+ (when m
+ (org-with-point-at m
+ (setq agenda-link
+ (if (called-interactively-p 'any)
+ (call-interactively 'org-store-link)
+ (org-store-link nil)))))))
+
+ ((eq major-mode 'calendar-mode)
+ (let ((cd (calendar-cursor-to-date)))
+ (setq link
+ (format-time-string
+ (car org-time-stamp-formats)
+ (apply 'encode-time
+ (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
+ nil nil nil))))
+ (org-store-link-props :type "calendar" :date cd)))
+
+ ((eq major-mode 'help-mode)
+ (setq link (concat "help:" (save-excursion
+ (goto-char (point-min))
+ (looking-at "^[^ ]+")
+ (match-string 0))))
+ (org-store-link-props :type "help"))
+
+ ((eq major-mode 'w3-mode)
+ (setq cpltxt (if (and (buffer-name)
+ (not (string-match "Untitled" (buffer-name))))
+ (buffer-name)
+ (url-view-url t))
+ link (url-view-url t))
+ (org-store-link-props :type "w3" :url (url-view-url t)))
+
+ ((eq major-mode 'image-mode)
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name buffer-file-name))
+ link cpltxt)
+ (org-store-link-props :type "image" :file buffer-file-name))
+
+ ;; In dired, store a link to the file of the current line
+ ((derived-mode-p 'dired-mode)
+ (let ((file (dired-get-filename nil t)))
+ (setq file (if file
+ (abbreviate-file-name
+ (expand-file-name (dired-get-filename nil t)))
+ ;; otherwise, no file so use current directory.
+ default-directory))
+ (setq cpltxt (concat "file:" file)
+ link cpltxt)))
+
+ ((setq search (run-hook-with-args-until-success
+ 'org-create-file-search-functions))
+ (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
+ "::" search))
+ (setq cpltxt (or description link)))
+
+ ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (org-with-limited-levels
(setq custom-id (org-entry-get nil "CUSTOM_ID"))
(cond
;; Store a link using the target at point
@@ -9860,7 +10018,7 @@ active region."
link cpltxt))
((and (featurep 'org-id)
(or (eq org-id-link-to-org-use-id t)
- (and (org-called-interactively-p 'any)
+ (and (called-interactively-p 'any)
(or (eq org-id-link-to-org-use-id 'create-if-interactive)
(and (eq org-id-link-to-org-use-id
'create-if-interactive-and-no-custom-id)
@@ -9884,14 +10042,11 @@ active region."
(buffer-file-name (buffer-base-buffer)))))
;; Add a context search string
(when (org-xor org-context-in-file-links arg)
- (let* ((ee (org-element-at-point))
- (et (org-element-type ee))
- (ev (plist-get (cadr ee) :value))
- (ek (plist-get (cadr ee) :key))
- (eok (and (stringp ek) (string-match "name" ek))))
+ (let* ((element (org-element-at-point))
+ (name (org-element-property :name element)))
(setq txt (cond
((org-at-heading-p) nil)
- ((and (eq et 'keyword) eok) ev)
+ (name)
((org-region-active-p)
(buffer-substring (region-beginning) (region-end)))))
(when (or (null txt) (string-match "\\S-" txt))
@@ -9900,74 +10055,79 @@ active region."
(condition-case nil
(org-make-org-heading-search-string txt)
(error "")))
- desc (or (and (eq et 'keyword) eok ev)
+ desc (or name
(nth 4 (ignore-errors (org-heading-components)))
"NONE")))))
- (if (string-match "::\\'" cpltxt)
- (setq cpltxt (substring cpltxt 0 -2)))
- (setq link cpltxt))))
-
- ((buffer-file-name (buffer-base-buffer))
- ;; Just link to this file here.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context string.
- (when (org-xor org-context-in-file-links arg)
- (setq txt (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))
- (buffer-substring (point-at-bol) (point-at-eol))))
- ;; Only use search option if there is some text.
- (when (string-match "\\S-" txt)
- (setq cpltxt
- (concat cpltxt "::" (org-make-org-heading-search-string txt))
- desc "NONE")))
- (setq link cpltxt))
-
- ((org-called-interactively-p 'interactive)
- (user-error "No method for storing a link from this buffer"))
-
- (t (setq link nil)))
-
- ;; We're done setting link and desc, clean up
- (if (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt)
- desc (or desc cpltxt))
- (cond ((equal desc "NONE") (setq desc nil))
- ((and desc (string-match org-bracket-link-analytic-regexp desc))
- (let ((d0 (match-string 3 desc))
- (p0 (match-string 5 desc)))
- (setq desc
- (replace-regexp-in-string
- org-bracket-link-regexp
- (concat (or p0 d0)
- (if (equal (length (match-string 0 desc))
- (length desc)) "*" "")) desc)))))
-
- ;; Return the link
- (if (not (and (or (org-called-interactively-p 'any)
- executing-kbd-macro)
- link))
- (or agenda-link (and link (org-make-link-string link desc)))
- (push (list link desc) org-stored-links)
- (message "Stored: %s" (or desc link))
- (when custom-id
- (setq link (concat "file:" (abbreviate-file-name
- (buffer-file-name)) "::#" custom-id))
- (push (list link desc) org-stored-links))
- (car org-stored-links))))))
+ (when (string-match "::\\'" cpltxt)
+ (setq cpltxt (substring cpltxt 0 -2)))
+ (setq link cpltxt)))))
+
+ ((buffer-file-name (buffer-base-buffer))
+ ;; Just link to this file here.
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ ;; Add a context string.
+ (when (org-xor org-context-in-file-links arg)
+ (setq txt (if (org-region-active-p)
+ (buffer-substring (region-beginning) (region-end))
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ ;; Only use search option if there is some text.
+ (when (string-match "\\S-" txt)
+ (setq cpltxt
+ (concat cpltxt "::" (org-make-org-heading-search-string txt))
+ desc "NONE")))
+ (setq link cpltxt))
+
+ ((called-interactively-p 'interactive)
+ (user-error "No method for storing a link from this buffer"))
+
+ (t (setq link nil)))
+
+ ;; We're done setting link and desc, clean up
+ (when (consp link) (setq cpltxt (car link) link (cdr link)))
+ (setq link (or link cpltxt)
+ desc (or desc cpltxt))
+ (cond ((not desc))
+ ((equal desc "NONE") (setq desc nil))
+ (t (setq desc
+ (replace-regexp-in-string
+ org-bracket-link-analytic-regexp
+ (lambda (m) (or (match-string 5 m) (match-string 3 m)))
+ desc))))
+ ;; Return the link
+ (if (not (and (or (called-interactively-p 'any)
+ executing-kbd-macro)
+ link))
+ (or agenda-link (and link (org-make-link-string link desc)))
+ (push (list link desc) org-stored-links)
+ (message "Stored: %s" (or desc link))
+ (when custom-id
+ (setq link (concat "file:" (abbreviate-file-name
+ (buffer-file-name)) "::#" custom-id))
+ (push (list link desc) org-stored-links))
+ (car org-stored-links)))))
(defun org-store-link-props (&rest plist)
- "Store link properties, extract names and addresses."
- (let (x adr)
- (when (setq x (plist-get plist :from))
- (setq adr (mail-extract-address-components x))
- (setq plist (plist-put plist :fromname (car adr)))
- (setq plist (plist-put plist :fromaddress (nth 1 adr))))
- (when (setq x (plist-get plist :to))
- (setq adr (mail-extract-address-components x))
- (setq plist (plist-put plist :toname (car adr)))
- (setq plist (plist-put plist :toaddress (nth 1 adr)))))
+ "Store link properties, extract names, addresses and dates."
+ (let ((x (plist-get plist :from)))
+ (when x
+ (let ((adr (mail-extract-address-components x)))
+ (setq plist (plist-put plist :fromname (car adr)))
+ (setq plist (plist-put plist :fromaddress (nth 1 adr))))))
+ (let ((x (plist-get plist :to)))
+ (when x
+ (let ((adr (mail-extract-address-components x)))
+ (setq plist (plist-put plist :toname (car adr)))
+ (setq plist (plist-put plist :toaddress (nth 1 adr))))))
+ (let ((x (ignore-errors (date-to-time (plist-get plist :date)))))
+ (when x
+ (setq plist (plist-put plist :date-timestamp
+ (format-time-string
+ (org-time-stamp-format t) x)))
+ (setq plist (plist-put plist :date-timestamp-inactive
+ (format-time-string
+ (org-time-stamp-format t t) x)))))
(let ((from (plist-get plist :from))
(to (plist-get plist :to)))
(when (and from to org-from-is-user-regexp)
@@ -10042,7 +10202,7 @@ according to FMT (default from `org-email-link-description-format')."
;; square brackets). File links however, are
;; encoded since, e.g., spaces are significant.
((or (file-name-absolute-p link)
- (org-string-match-p "\\`\\.\\.?/\\|[][]" link))
+ (string-match-p "\\`\\.\\.?/\\|[][]" link))
(org-link-escape link))
(t link)))
(description
@@ -10061,15 +10221,6 @@ according to FMT (default from `org-email-link-description-format')."
"List of characters that should be escaped in a link when stored to Org.
This is the list that is used for internal purposes.")
-(defconst org-link-escape-chars-browser
- ;;%20 %22
- '(?\s ?\")
- "List of characters to be escaped before handing over to the browser.
-If you consider using this constant then you probably want to use
-the function `org-link-escape-browser' instead. See there why
-this constant is a candidate to be removed once Org drops support
-for Emacs 24.1 and 24.2.")
-
(defun org-link-escape (text &optional table merge)
"Return percent escaped representation of TEXT.
TEXT is a string with the text to escape.
@@ -10092,29 +10243,6 @@ If optional argument MERGE is set, merge TABLE into
(char-to-string c)))
text "")))
-(defun org-link-escape-browser (text)
- "Escape some characters before handing over to the browser.
-This function is a candidate to be removed together with the
-constant `org-link-escape-chars-browser' once Org drops support
-for Emacs 24.1 and 24.2. All calls to this function will have to
-be replaced with `url-encode-url' which is available since Emacs
-24.3.1."
- ;; Example with the Org link
- ;; [[http://lists.gnu.org/archive/cgi-bin/namazu.cgi?idxname=emacs-orgmode&query=%252Bsubject:"Release+8.2"]]
- ;; to open the browser with +subject:"Release 8.2" filled into the
- ;; query field: In this case the variable TEXT contains the
- ;; unescaped [...]=%2Bsubject:"Release+8.2". Then `url-encode-url'
- ;; converts correctly to [...]=%2Bsubject:%22Release+8.2%22 or
- ;; `org-link-escape' with `org-link-escape-chars-browser' converts
- ;; wrongly to [...]=%252Bsubject:%22Release+8.2%22.
- (if (fboundp 'url-encode-url)
- (url-encode-url text)
- (if (org-string-match-p
- (concat "[[:nonascii:]" org-link-escape-chars-browser "]")
- text)
- (org-link-escape text org-link-escape-chars-browser)
- text)))
-
(defun org-link-unescape (str)
"Unhex hexified Unicode parts in string STR.
E.g. `%C3%B6' becomes the german o-Umlaut. This is the
@@ -10145,13 +10273,13 @@ Note: this function also decodes single byte encodings like
((>= val 192) (cons 2 192))
(t (cons 0 0)))
(cons 6 128))))
- (if (>= val 192) (setq eat (car shift-xor)))
+ (when (>= val 192) (setq eat (car shift-xor)))
(setq val (logxor val (cdr shift-xor)))
(setq sum (+ (lsh sum (car shift-xor)) val))
- (if (> eat 0) (setq eat (- eat 1)))
+ (when (> eat 0) (setq eat (- eat 1)))
(cond
((= 0 eat) ;multi byte
- (setq ret (concat ret (org-char-to-string sum)))
+ (setq ret (concat ret (char-to-string sum)))
(setq sum 0))
((not bytes) ; single byte(s)
(setq ret (org-link-unescape-single-byte-sequence hex))))))
@@ -10193,8 +10321,8 @@ The cdr of LINK must be either a link description or nil."
;;;###autoload
(defun org-insert-link-global ()
- "Insert a link like Org-mode does.
-This command can be called in any mode to insert a link in Org-mode syntax."
+ "Insert a link like Org mode does.
+This command can be called in any mode to insert a link in Org syntax."
(interactive)
(org-load-modules-maybe)
(org-run-like-in-org-mode 'org-insert-link))
@@ -10207,7 +10335,7 @@ When `ARG' is a number, insert the last N link(s).
prepend or to append."
(interactive "P")
(let ((org-keep-stored-link-after-insertion (equal arg '(4)))
- (links (copy-seq org-stored-links))
+ (links (copy-sequence org-stored-links))
(pr (or pre "- "))
(po (or post "\n"))
(cnt 1) l)
@@ -10249,73 +10377,73 @@ prepend or to append."
(put-text-property 0 (length l) 'face 'font-lock-comment-face l))
(delq nil (append a b)))))
-(defvar org-link-links-in-this-file nil)
+(defvar org--links-history nil)
(defun org-insert-link (&optional complete-file link-location default-description)
"Insert a link. At the prompt, enter the link.
-Completion can be used to insert any of the link protocol prefixes like
-http or ftp in use.
+Completion can be used to insert any of the link protocol prefixes in use.
The history can be used to select a link previously stored with
`org-store-link'. When the empty string is entered (i.e. if you just
-press RET at the prompt), the link defaults to the most recently
-stored link. As SPC triggers completion in the minibuffer, you need to
-use M-SPC or C-q SPC to force the insertion of a space character.
+press `RET' at the prompt), the link defaults to the most recently
+stored link. As `SPC' triggers completion in the minibuffer, you need to
+use `M-SPC' or `C-q SPC' to force the insertion of a space character.
You will also be prompted for a description, and if one is given, it will
be displayed in the buffer instead of the link.
-If there is already a link at point, this command will allow you to edit link
-and description parts.
+If there is already a link at point, this command will allow you to edit
+link and description parts.
-With a \\[universal-argument] prefix, prompts for a file to link to. The file name can
-be selected using completion. The path to the file will be relative to the
+With a `\\[universal-argument]' prefix, prompts for a file to link to. The \
+file name can be
+selected using completion. The path to the file will be relative to the
current directory if the file is in the current directory or a subdirectory.
Otherwise, the link will be the absolute path as completed in the minibuffer
\(i.e. normally ~/path/to/file). You can configure this behavior using the
option `org-link-file-path-type'.
-With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in
+With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \
+absolute path even if the file is in
the current directory or below.
-With three \\[universal-argument] prefixes, negate the meaning of
-`org-keep-stored-link-after-insertion'.
+A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
+prefix negates `org-keep-stored-link-after-insertion'.
If `org-make-link-description-function' is non-nil, this function will be
called with the link target, and the result will be the default
link description.
-If the LINK-LOCATION parameter is non-nil, this value will be
-used as the link location instead of reading one interactively.
+If the LINK-LOCATION parameter is non-nil, this value will be used as
+the link location instead of reading one interactively.
-If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
-be used as the default description."
+If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used
+as the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(origbuf (current-buffer))
- (region (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))))
+ (region (when (org-region-active-p)
+ (buffer-substring (region-beginning) (region-end))))
(remove (and region (list (region-beginning) (region-end))))
(desc region)
- tmphist ; byte-compile incorrectly complains about this
(link link-location)
(abbrevs org-link-abbrev-alist-local)
- entry file all-prefixes auto-desc)
+ entry all-prefixes auto-desc)
(cond
- (link-location) ; specified by arg, just use it.
+ (link-location) ; specified by arg, just use it.
((org-in-regexp org-bracket-link-regexp 1)
;; We do have a link at point, and we are going to edit it.
(setq remove (list (match-beginning 0) (match-end 0)))
- (setq desc (if (match-end 3) (org-match-string-no-properties 3)))
+ (setq desc (when (match-end 3) (match-string-no-properties 3)))
(setq link (read-string "Link: "
(org-link-unescape
- (org-match-string-no-properties 1)))))
+ (match-string-no-properties 1)))))
((or (org-in-regexp org-angle-link-re)
(org-in-regexp org-plain-link-re))
;; Convert to bracket link
(setq remove (list (match-beginning 0) (match-end 0))
link (read-string "Link: "
- (org-remove-angle-brackets (match-string 0)))))
+ (org-unbracket-string "<" ">" (match-string 0)))))
((member complete-file '((4) (16)))
;; Completing read for file names.
(setq link (org-file-complete-link complete-file)))
@@ -10338,50 +10466,49 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(unless (pos-visible-in-window-p (point-max))
(org-fit-window-to-buffer))
(and (window-live-p cw) (select-window cw)))
- ;; Fake a link history, containing the stored links.
- (setq tmphist (append (mapcar 'car org-stored-links)
- org-insert-link-history))
(setq all-prefixes (append (mapcar 'car abbrevs)
(mapcar 'car org-link-abbrev-alist)
- org-link-types))
+ (org-link-types)))
(unwind-protect
- (progn
+ ;; Fake a link history, containing the stored links.
+ (let ((org--links-history
+ (append (mapcar #'car org-stored-links)
+ org-insert-link-history)))
(setq link
(org-completing-read
"Link: "
(append
- (mapcar (lambda (x) (concat x ":"))
- all-prefixes)
- (mapcar 'car org-stored-links))
+ (mapcar (lambda (x) (concat x ":")) all-prefixes)
+ (mapcar #'car org-stored-links))
nil nil nil
- 'tmphist
+ 'org--links-history
(caar org-stored-links)))
- (if (not (string-match "\\S-" link))
- (user-error "No link selected"))
- (mapc (lambda(l)
- (when (equal link (cadr l)) (setq link (car l) auto-desc t)))
- org-stored-links)
- (if (or (member link all-prefixes)
- (and (equal ":" (substring link -1))
- (member (substring link 0 -1) all-prefixes)
- (setq link (substring link 0 -1))))
- (setq link (with-current-buffer origbuf
- (org-link-try-special-completion link)))))
+ (unless (org-string-nw-p link) (user-error "No link selected"))
+ (dolist (l org-stored-links)
+ (when (equal link (cadr l))
+ (setq link (car l))
+ (setq auto-desc t)))
+ (when (or (member link all-prefixes)
+ (and (equal ":" (substring link -1))
+ (member (substring link 0 -1) all-prefixes)
+ (setq link (substring link 0 -1))))
+ (setq link (with-current-buffer origbuf
+ (org-link-try-special-completion link)))))
(set-window-configuration wcf)
(kill-buffer "*Org Links*"))
(setq entry (assoc link org-stored-links))
(or entry (push link org-insert-link-history))
(setq desc (or desc (nth 1 entry)))))
- (if (funcall (if (equal complete-file '(64)) 'not 'identity)
- (not org-keep-stored-link-after-insertion))
- (setq org-stored-links (delq (assoc link org-stored-links)
- org-stored-links)))
+ (when (funcall (if (equal complete-file '(64)) 'not 'identity)
+ (not org-keep-stored-link-after-insertion))
+ (setq org-stored-links (delq (assoc link org-stored-links)
+ org-stored-links)))
- (if (and (string-match org-plain-link-re link)
- (not (string-match org-ts-regexp link)))
- ;; URL-like link, normalize the use of angular brackets.
- (setq link (org-remove-angle-brackets link)))
+ (when (and (string-match org-plain-link-re link)
+ (not (string-match org-ts-regexp link)))
+ ;; URL-like link, normalize the use of angular brackets.
+ (setq link (org-unbracket-string "<" ">" link)))
;; Check if we are linking to the current file with a search
;; option If yes, simplify the link by using only the search
@@ -10392,9 +10519,9 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(case-fold-search nil)
(search (match-string 2 link)))
(save-match-data
- (if (equal (file-truename buffer-file-name) (file-truename path))
- ;; We are linking to this same file, with a search option
- (setq link search)))))
+ (when (equal (file-truename buffer-file-name) (file-truename path))
+ ;; We are linking to this same file, with a search option
+ (setq link search)))))
;; Check if we can/should use a relative path. If yes, simplify the link
(when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
@@ -10422,8 +10549,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(match-end 0)))
(setq path (abbreviate-file-name (expand-file-name path)))))))
(setq link (concat type path))
- (if (equal desc origpath)
- (setq desc path))))
+ (when (equal desc origpath)
+ (setq desc path))))
(if org-make-link-description-function
(setq desc
@@ -10438,21 +10565,21 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(read-string "Description: " desc)))))
(unless (string-match "\\S-" desc) (setq desc nil))
- (if remove (apply 'delete-region remove))
+ (when remove (apply 'delete-region remove))
(insert (org-make-link-string link desc))
;; Redisplay so as the new link has proper invisible characters.
(sit-for 0)))
(defun org-link-try-special-completion (type)
"If there is completion support for link type TYPE, offer it."
- (let ((fun (intern (concat "org-" type "-complete-link"))))
+ (let ((fun (org-link-get-parameter type :complete)))
(if (functionp fun)
(funcall fun)
(read-string "Link (no completion support): " (concat type ":")))))
(defun org-file-complete-link (&optional arg)
"Create a file link using completion."
- (let ((file (org-iread-file-name "File: "))
+ (let ((file (read-file-name "File: "))
(pwd (file-name-as-directory (expand-file-name ".")))
(pwd1 (file-name-as-directory (abbreviate-file-name
(expand-file-name ".")))))
@@ -10469,19 +10596,6 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(match-string 1 (expand-file-name file))))
(t (concat "file:" file)))))
-(defun org-iread-file-name (&rest args)
- "Read-file-name using `ido-mode' speedup if available.
-ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'.
-See `read-file-name' for a description of parameters."
- (org-without-partial-completion
- (if (and org-completion-use-ido
- (fboundp 'ido-read-file-name)
- (org-bound-and-true-p ido-mode)
- (listp (nth 1 args)))
- (let ((ido-enter-matching-directory nil))
- (apply #'ido-read-file-name args))
- (apply #'read-file-name args))))
-
(defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character."
(let ((enable-recursive-minibuffers t)
@@ -10489,42 +10603,9 @@ See `read-file-name' for a description of parameters."
(copy-keymap minibuffer-local-completion-map)))
(org-defkey minibuffer-local-completion-map " " 'self-insert-command)
(org-defkey minibuffer-local-completion-map "?" 'self-insert-command)
- (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive)
- (apply 'org-icompleting-read args)))
-
-(defun org-completing-read-no-i (&rest args)
- (let (org-completion-use-ido org-completion-use-iswitchb)
- (apply 'org-completing-read args)))
-
-(defun org-iswitchb-completing-read (prompt choices &rest args)
- "Use iswitch as a completing-read replacement to choose from choices.
-PROMPT is a string to prompt with. CHOICES is a list of strings to choose
-from."
- (let* ((iswitchb-use-virtual-buffers nil)
- (iswitchb-make-buflist-hook
- (lambda ()
- (setq iswitchb-temp-buflist choices))))
- (iswitchb-read-buffer prompt)))
-
-(defun org-icompleting-read (&rest args)
- "Completing-read using `ido-mode' or `iswitchb' speedups if available.
-Should be called like `completing-read'."
- (org-without-partial-completion
- (if (not (listp (nth 1 args)))
- ;; Ido only supports lists as the COLLECTION argument. Use
- ;; default completion function when second argument is not
- ;; a list.
- (apply #'completing-read args)
- (let ((ido-enter-matching-directory nil))
- (apply (cond ((and org-completion-use-ido
- (fboundp 'ido-completing-read)
- (org-bound-and-true-p ido-mode))
- #'ido-completing-read)
- ((and org-completion-use-iswitchb
- (org-bound-and-true-p iswitchb-mode))
- #'org-iswitchb-completing-read)
- (t #'completing-read))
- args)))))
+ (org-defkey minibuffer-local-completion-map (kbd "C-c !")
+ 'org-time-stamp-inactive)
+ (apply #'completing-read args)))
;;; Opening/following a link
@@ -10544,8 +10625,8 @@ handle this as a special case.
When the function does handle the link, it must return a non-nil value.
If it decides that it is not responsible for this link, it must return
-nil to indicate that that Org-mode can continue with other options
-like exact and fuzzy text search.")
+nil to indicate that that Org can continue with other options like
+exact and fuzzy text search.")
(defun org-next-link (&optional search-backward)
"Move forward to the next link.
@@ -10557,7 +10638,7 @@ If the link is in hidden text, expose it."
(setq org-link-search-failed nil)
(let* ((pos (point))
(ct (org-context))
- (a (assoc :link ct))
+ (a (assq :link ct))
(srch-fun (if search-backward 're-search-backward 're-search-forward)))
(cond (a (goto-char (nth (if search-backward 1 2) a)))
((looking-at org-any-link-re)
@@ -10566,7 +10647,7 @@ If the link is in hidden text, expose it."
(if (funcall srch-fun org-any-link-re nil t)
(progn
(goto-char (match-beginning 0))
- (if (outline-invisible-p) (org-show-context)))
+ (when (outline-invisible-p) (org-show-context)))
(goto-char pos)
(setq org-link-search-failed t)
(message "No further link found"))))
@@ -10601,7 +10682,7 @@ This is still an experimental function, your mileage may vary."
;; A typical message link. Planner has the id after the final slash,
;; we separate it with a hash mark
(setq path (concat (match-string 1 path) "#"
- (org-remove-angle-brackets (match-string 2 path))))))
+ (org-unbracket-string "<" ">" (match-string 2 path))))))
(cons type path))
(defun org-find-file-at-mouse (ev)
@@ -10615,8 +10696,8 @@ This is still an experimental function, your mileage may vary."
See the docstring of `org-open-file' for details."
(interactive "e")
(mouse-set-point ev)
- (if (eq major-mode 'org-agenda-mode)
- (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
+ (when (eq major-mode 'org-agenda-mode)
+ (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
(org-open-at-point))
(defvar org-window-config-before-follow-link nil
@@ -10625,15 +10706,22 @@ This is saved in case the need arises to restore it.")
;;;###autoload
(defun org-open-at-point-global ()
- "Follow a link like Org-mode does.
-This command can be called in any mode to follow a link that has
-Org-mode syntax."
+ "Follow a link or time-stamp like Org mode does.
+This command can be called in any mode to follow an external link
+or a time-stamp that has Org mode syntax. Its behavior is
+undefined when called on internal links (e.g., fuzzy links).
+Raise an error when there is nothing to follow. "
(interactive)
- (org-run-like-in-org-mode 'org-open-at-point))
+ (cond ((org-in-regexp org-any-link-re)
+ (org-open-link-from-string (match-string-no-properties 0)))
+ ((or (org-in-regexp org-ts-regexp-both nil t)
+ (org-in-regexp org-tsr-regexp-both nil t))
+ (org-follow-timestamp-link))
+ (t (user-error "No link found"))))
;;;###autoload
(defun org-open-link-from-string (s &optional arg reference-buffer)
- "Open a link in the string S, as if it was in Org-mode."
+ "Open a link in the string S, as if it was in Org mode."
(interactive "sLink: \nP")
(let ((reference-buffer (or reference-buffer (current-buffer))))
(with-temp-buffer
@@ -10654,8 +10742,61 @@ Functions in this hook must return t if they identify and follow
a link at point. If they don't find anything interesting at point,
they must return nil.")
-(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
-(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el
+(defvar org-link-search-inhibit-query nil)
+(defvar clean-buffer-list-kill-buffer-names) ;Defined in midnight.el
+(defun org--open-doi-link (path)
+ "Open a \"doi\" type link.
+PATH is a the path to search for, as a string."
+ (browse-url (url-encode-url (concat org-doi-server-url path))))
+
+(defun org--open-elisp-link (path)
+ "Open a \"elisp\" type link.
+PATH is the sexp to evaluate, as a string."
+ (let ((cmd path))
+ (if (or (and (org-string-nw-p
+ org-confirm-elisp-link-not-regexp)
+ (string-match-p org-confirm-elisp-link-not-regexp cmd))
+ (not org-confirm-elisp-link-function)
+ (funcall org-confirm-elisp-link-function
+ (format "Execute \"%s\" as elisp? "
+ (org-add-props cmd nil 'face 'org-warning))))
+ (message "%s => %s" cmd
+ (if (eq (string-to-char cmd) ?\()
+ (eval (read cmd))
+ (call-interactively (read cmd))))
+ (user-error "Abort"))))
+
+(defun org--open-help-link (path)
+ "Open a \"help\" type link.
+PATH is a symbol name, as a string."
+ (pcase (intern path)
+ ((and (pred fboundp) variable) (describe-function variable))
+ ((and (pred boundp) function) (describe-variable function))
+ (name (user-error "Unknown function or variable: %s" name))))
+
+(defun org--open-shell-link (path)
+ "Open a \"shell\" type link.
+PATH is the command to execute, as a string."
+ (let ((buf (generate-new-buffer "*Org Shell Output*"))
+ (cmd path))
+ (if (or (and (org-string-nw-p
+ org-confirm-shell-link-not-regexp)
+ (string-match
+ org-confirm-shell-link-not-regexp cmd))
+ (not org-confirm-shell-link-function)
+ (funcall org-confirm-shell-link-function
+ (format "Execute \"%s\" in shell? "
+ (org-add-props cmd nil
+ 'face 'org-warning))))
+ (progn
+ (message "Executing %s" cmd)
+ (shell-command cmd buf)
+ (when (featurep 'midnight)
+ (setq clean-buffer-list-kill-buffer-names
+ (cons (buffer-name buf)
+ clean-buffer-list-kill-buffer-names))))
+ (user-error "Abort"))))
+
(defun org-open-at-point (&optional arg reference-buffer)
"Open link, timestamp, footnote or tags at point.
@@ -10706,19 +10847,17 @@ link in a property drawer line."
;; Exception: open timestamps and links in properties
;; drawers, keywords and comments.
((memq type '(comment comment-block keyword node-property))
- (cond ((org-in-regexp org-any-link-re)
- (org-open-link-from-string (match-string-no-properties 0)))
- ((or (org-at-timestamp-p t) (org-at-date-range-p t))
- (org-follow-timestamp-link))
- (t (user-error "No link found"))))
+ (call-interactively #'org-open-at-point-global))
;; On a headline or an inlinetask, but not on a timestamp,
;; a link, a footnote reference or on tags.
((and (memq type '(headline inlinetask))
;; Not on tags.
- (progn (save-excursion (beginning-of-line)
- (looking-at org-complex-heading-regexp))
- (or (not (match-beginning 5))
- (< (point) (match-beginning 5)))))
+ (let ((case-fold-search nil))
+ (save-excursion
+ (beginning-of-line)
+ (looking-at org-complex-heading-regexp))
+ (or (not (match-beginning 5))
+ (< (point) (match-beginning 5)))))
(let* ((data (org-offer-links-in-entry (current-buffer) (point) arg))
(links (car data))
(links-end (cdr data)))
@@ -10736,30 +10875,30 @@ link in a property drawer line."
(>= (point) (org-element-property :begin value))
(<= (point) (org-element-property :end value)))
(org-follow-timestamp-link))
- ;; Do nothing on white spaces after an object, unless point
- ;; is right after it.
- ((> (point)
- (save-excursion
- (goto-char (org-element-property :end context))
- (skip-chars-backward " \t")
- (point)))
+ ;; Do nothing on white spaces after an object.
+ ((>= (point)
+ (save-excursion
+ (goto-char (org-element-property :end context))
+ (skip-chars-backward " \t")
+ (point)))
(user-error "No link found"))
((eq type 'timestamp) (org-follow-timestamp-link))
;; On tags within a headline or an inlinetask.
((and (memq type '(headline inlinetask))
- (progn (save-excursion (beginning-of-line)
- (looking-at org-complex-heading-regexp))
- (and (match-beginning 5)
- (>= (point) (match-beginning 5)))))
+ (let ((case-fold-search nil))
+ (save-excursion (beginning-of-line)
+ (looking-at org-complex-heading-regexp))
+ (and (match-beginning 5)
+ (>= (point) (match-beginning 5)))))
(org-tags-view arg (substring (match-string 5) 0 -1)))
((eq type 'link)
;; When link is located within the description of another
;; link (e.g., an inline image), always open the parent
;; link.
- (let*((link (let ((up (org-element-property :parent context)))
- (if (eq (org-element-type up) 'link) up context)))
- (type (org-element-property :type link))
- (path (org-link-unescape (org-element-property :path link))))
+ (let* ((link (let ((up (org-element-property :parent context)))
+ (if (eq (org-element-type up) 'link) up context)))
+ (type (org-element-property :type link))
+ (path (org-link-unescape (org-element-property :path link))))
;; Switch back to REFERENCE-BUFFER needed when called in
;; a temporary buffer through `org-open-link-from-string'.
(with-current-buffer (or reference-buffer (current-buffer))
@@ -10767,21 +10906,19 @@ link in a property drawer line."
((equal type "file")
(if (string-match "[*?{]" (file-name-nondirectory path))
(dired path)
- ;; Look into `org-link-protocols' in order to find
+ ;; Look into `org-link-parameters' in order to find
;; a DEDICATED-FUNCTION to open file. The function
;; will be applied on raw link instead of parsed
;; link due to the limitation in `org-add-link-type'
;; ("open" function called with a single argument).
;; If no such function is found, fallback to
;; `org-open-file'.
- ;;
- ;; Note : "file+emacs" and "file+sys" types are
- ;; hard-coded in order to escape the previous
- ;; limitation.
(let* ((option (org-element-property :search-option link))
(app (org-element-property :application link))
(dedicated-function
- (nth 1 (assoc app org-link-protocols))))
+ (org-link-get-parameter
+ (if app (concat type "+" app) type)
+ :follow)))
(if dedicated-function
(funcall dedicated-function
(concat path
@@ -10792,62 +10929,12 @@ link in a property drawer line."
((equal app "emacs") 'emacs)
((equal app "sys") 'system))
(cond ((not option) nil)
- ((org-string-match-p "\\`[0-9]+\\'" option)
+ ((string-match-p "\\`[0-9]+\\'" option)
(list (string-to-number option)))
(t (list nil
(org-link-unescape option)))))))))
- ((assoc type org-link-protocols)
- (funcall (nth 1 (assoc type org-link-protocols)) path))
- ((equal type "help")
- (let ((f-or-v (intern path)))
- (cond ((fboundp f-or-v) (describe-function f-or-v))
- ((boundp f-or-v) (describe-variable f-or-v))
- (t (error "Not a known function or variable")))))
- ((member type '("http" "https" "ftp" "mailto" "news"))
- (browse-url (org-link-escape-browser (concat type ":" path))))
- ((equal type "doi")
- (browse-url
- (org-link-escape-browser (concat org-doi-server-url path))))
- ((equal type "message") (browse-url (concat type ":" path)))
- ((equal type "shell")
- (let ((buf (generate-new-buffer "*Org Shell Output*"))
- (cmd path))
- (if (or (and (org-string-nw-p
- org-confirm-shell-link-not-regexp)
- (string-match
- org-confirm-shell-link-not-regexp cmd))
- (not org-confirm-shell-link-function)
- (funcall org-confirm-shell-link-function
- (format "Execute \"%s\" in shell? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (progn
- (message "Executing %s" cmd)
- (shell-command cmd buf)
- (when (featurep 'midnight)
- (setq clean-buffer-list-kill-buffer-names
- (cons (buffer-name buf)
- clean-buffer-list-kill-buffer-names))))
- (user-error "Abort"))))
- ((equal type "elisp")
- (let ((cmd path))
- (if (or (and (org-string-nw-p
- org-confirm-elisp-link-not-regexp)
- (org-string-match-p
- org-confirm-elisp-link-not-regexp cmd))
- (not org-confirm-elisp-link-function)
- (funcall org-confirm-elisp-link-function
- (format "Execute \"%s\" as elisp? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (message "%s => %s" cmd
- (if (eq (string-to-char cmd) ?\()
- (eval (read cmd))
- (call-interactively (read cmd))))
- (user-error "Abort"))))
- ((equal type "id")
- (require 'org-id)
- (funcall (nth 1 (assoc "id" org-link-protocols)) path))
+ ((functionp (org-link-get-parameter type :follow))
+ (funcall (org-link-get-parameter type :follow) path))
((member type '("coderef" "custom-id" "fuzzy" "radio"))
(unless (run-hook-with-args-until-success
'org-open-link-functions path)
@@ -10897,57 +10984,54 @@ If NTH is an integer, return the NTH link found.
If ZERO is a string, check also this string for a link, and if
there is one, return it."
(with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (let ((cnt ?0)
- (in-emacs (if (integerp nth) nil nth))
- have-zero end links link c)
- (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
- (push (match-string 0 zero) links)
- (setq cnt (1- cnt) have-zero t))
- (save-excursion
- (org-back-to-heading t)
- (setq end (save-excursion (outline-next-heading) (point)))
- (while (re-search-forward org-any-link-re end t)
- (push (match-string 0) links))
- (setq links (org-uniquify (reverse links))))
- (cond
- ((null links)
- (message "No links"))
- ((equal (length links) 1)
- (setq link (car links)))
- ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
- (setq link (nth (if have-zero nth (1- nth)) links)))
- (t ; we have to select a link
- (save-excursion
- (save-window-excursion
- (delete-other-windows)
- (with-output-to-temp-buffer "*Select Link*"
- (mapc (lambda (l)
- (if (not (string-match org-bracket-link-regexp l))
- (princ (format "[%c] %s\n" (incf cnt)
- (org-remove-angle-brackets l)))
- (if (match-end 3)
- (princ (format "[%c] %s (%s)\n" (incf cnt)
- (match-string 3 l) (match-string 1 l)))
- (princ (format "[%c] %s\n" (incf cnt)
- (match-string 1 l))))))
- links))
- (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
- (message "Select link to open, RET to open all:")
- (setq c (read-char-exclusive))
- (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
- (when (equal c ?q) (user-error "Abort"))
- (if (equal c ?\C-m)
- (setq link links)
- (setq nth (- c ?0))
- (if have-zero (setq nth (1+ nth)))
- (unless (and (integerp nth) (>= (length links) nth))
- (user-error "Invalid link selection"))
- (setq link (nth (1- nth) links)))))
- (cons link end))))))
+ (org-with-wide-buffer
+ (goto-char marker)
+ (let ((cnt ?0)
+ have-zero end links link c)
+ (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
+ (push (match-string 0 zero) links)
+ (setq cnt (1- cnt) have-zero t))
+ (save-excursion
+ (org-back-to-heading t)
+ (setq end (save-excursion (outline-next-heading) (point)))
+ (while (re-search-forward org-any-link-re end t)
+ (push (match-string 0) links))
+ (setq links (org-uniquify (reverse links))))
+ (cond
+ ((null links)
+ (message "No links"))
+ ((equal (length links) 1)
+ (setq link (car links)))
+ ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
+ (setq link (nth (if have-zero nth (1- nth)) links)))
+ (t ; we have to select a link
+ (save-excursion
+ (save-window-excursion
+ (delete-other-windows)
+ (with-output-to-temp-buffer "*Select Link*"
+ (dolist (l links)
+ (cond
+ ((not (string-match org-bracket-link-regexp l))
+ (princ (format "[%c] %s\n" (cl-incf cnt)
+ (org-unbracket-string "<" ">" l))))
+ ((match-end 3)
+ (princ (format "[%c] %s (%s)\n" (cl-incf cnt)
+ (match-string 3 l) (match-string 1 l))))
+ (t (princ (format "[%c] %s\n" (cl-incf cnt)
+ (match-string 1 l)))))))
+ (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
+ (message "Select link to open, RET to open all:")
+ (setq c (read-char-exclusive))
+ (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
+ (when (equal c ?q) (user-error "Abort"))
+ (if (equal c ?\C-m)
+ (setq link links)
+ (setq nth (- c ?0))
+ (when have-zero (setq nth (1+ nth)))
+ (unless (and (integerp nth) (>= (length links) nth))
+ (user-error "Invalid link selection"))
+ (setq link (nth (1- nth) links)))))
+ (cons link end)))))
;; TODO: These functions are deprecated since `org-open-at-point'
;; hard-codes behaviour for "file+emacs" and "file+sys" types.
@@ -10980,8 +11064,8 @@ which see.
A function in this hook may also use `setq' to set the variable
`description' to provide a suggestion for the descriptive text to
-be used for this link when it gets inserted into an Org-mode
-buffer with \\[org-insert-link].")
+be used for this link when it gets inserted into an Org buffer
+with \\[org-insert-link].")
(defvar org-execute-file-search-functions nil
"List of functions to execute a file search triggered by a link.
@@ -11046,7 +11130,7 @@ visibility around point, thus ignoring `org-show-context-detail'
variable.
Search is case-insensitive and ignores white spaces. Return type
-of matched result, with is either `dedicated' or `fuzzy'."
+of matched result, which is either `dedicated' or `fuzzy'."
(unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
(let* ((case-fold-search t)
(origin (point))
@@ -11095,10 +11179,7 @@ of matched result, with is either `dedicated' or `fuzzy'."
(match-string 1 s)))
;; Fuzzy links.
(t
- (let* ((starred (eq (string-to-char normalized) ?*))
- (headline-search (and (derived-mode-p 'org-mode)
- (or org-link-search-must-match-exact-headline
- starred))))
+ (let ((starred (eq (string-to-char normalized) ?*)))
(cond
;; Look for targets, only if not in a headline search.
((and (not starred)
@@ -11151,7 +11232,7 @@ of matched result, with is either `dedicated' or `fuzzy'."
sep)))
(if starred (substring title 1) title))
sep "?"
- (org-re "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?")
+ "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?"
"[ \t]*$")))
(goto-char (point-min))
(re-search-forward re nil t)))
@@ -11209,7 +11290,7 @@ of matched result, with is either `dedicated' or `fuzzy'."
(cond
((not org-display-internal-link-with-indirect-buffer)
buffer)
- ((string-match "(Clone)$" (buffer-name buffer))
+ ((string-suffix-p "(Clone)" (buffer-name buffer))
(message "Buffer is already a clone, not making another one")
;; we also do not modify visibility in this case
buffer)
@@ -11233,8 +11314,8 @@ to read."
(goto-char (point-min))
(when (re-search-forward "match[a-z]+" nil t)
(setq beg (match-end 0))
- (if (re-search-forward "^[ \t]*[0-9]+" nil t)
- (setq end (1- (match-beginning 0)))))
+ (when (re-search-forward "^[ \t]*[0-9]+" nil t)
+ (setq end (1- (match-beginning 0)))))
(and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
(goto-char (point-min))
(select-window cwin))))
@@ -11242,13 +11323,13 @@ to read."
;;; The mark ring for links jumps
(defvar org-mark-ring nil
- "Mark ring for positions before jumps in Org-mode.")
+ "Mark ring for positions before jumps in Org mode.")
(defvar org-mark-ring-last-goto nil
"Last position in the mark ring used to go back.")
;; Fill and close the ring
(setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
-(loop for i from 1 to org-mark-ring-length do
- (push (make-marker) org-mark-ring))
+(dotimes (_ org-mark-ring-length)
+ (push (make-marker) org-mark-ring))
(setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
org-mark-ring)
@@ -11262,15 +11343,15 @@ to read."
(or buffer (current-buffer)))
(message "%s"
(substitute-command-keys
- "Position saved to mark ring, go back with \\[org-mark-ring-goto].")))
+ "Position saved to mark ring, go back with \
+`\\[org-mark-ring-goto]'.")))
(defun org-mark-ring-goto (&optional n)
"Jump to the previous position in the mark ring.
With prefix arg N, jump back that many stored positions. When
called several times in succession, walk through the entire ring.
-Org-mode commands jumping to a different position in the current file,
-or to another Org-mode file, automatically push the old position
-onto the ring."
+Org mode commands jumping to a different position in the current file,
+or to another Org file, automatically push the old position onto the ring."
(interactive "p")
(let (p m)
(if (eq last-command this-command)
@@ -11278,25 +11359,19 @@ onto the ring."
(setq p org-mark-ring))
(setq org-mark-ring-last-goto p)
(setq m (car p))
- (org-pop-to-buffer-same-window (marker-buffer m))
+ (pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
- (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
+ (when (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
-(defun org-remove-angle-brackets (s)
- (if (equal (substring s 0 1) "<") (setq s (substring s 1)))
- (if (equal (substring s -1) ">") (setq s (substring s 0 -1)))
- s)
(defun org-add-angle-brackets (s)
- (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s)))
- (if (equal (substring s -1) ">") nil (setq s (concat s ">")))
- s)
-(defun org-remove-double-quotes (s)
- (if (equal (substring s 0 1) "\"") (setq s (substring s 1)))
- (if (equal (substring s -1) "\"") (setq s (substring s 0 -1)))
+ (unless (equal (substring s 0 1) "<") (setq s (concat "<" s)))
+ (unless (equal (substring s -1) ">") (setq s (concat s ">")))
s)
;;; Following specific links
+(defvar org-agenda-buffer-tmp-name)
+(defvar org-agenda-start-on-weekday)
(defun org-follow-timestamp-link ()
"Open an agenda view for the time-stamp date/range at point."
(cond
@@ -11351,43 +11426,40 @@ If the file does not exist, an error is thrown."
buffer-file-name
(substitute-in-file-name (expand-file-name path))))
(file-apps (append org-file-apps (org-default-apps)))
- (apps (org-remove-if
+ (apps (cl-remove-if
'org-file-apps-entry-match-against-dlink-p file-apps))
- (apps-dlink (org-remove-if-not
+ (apps-dlink (cl-remove-if-not
'org-file-apps-entry-match-against-dlink-p file-apps))
(remp (and (assq 'remote apps) (org-file-remote-p file)))
- (dirp (if remp nil (file-directory-p file)))
+ (dirp (unless remp (file-directory-p file)))
(file (if (and dirp org-open-directory-means-index-dot-org)
(concat (file-name-as-directory file) "index.org")
file))
(a-m-a-p (assq 'auto-mode apps))
(dfile (downcase file))
- ;; reconstruct the original file: link from the PATH, LINE and SEARCH args
- (link (cond ((and (eq line nil)
- (eq search nil))
- file)
- (line
- (concat file "::" (number-to-string line)))
- (search
- (concat file "::" search))))
+ ;; Reconstruct the original link from the PATH, LINE and
+ ;; SEARCH args.
+ (link (cond (line (concat file "::" (number-to-string line)))
+ (search (concat file "::" search))
+ (t file)))
(dlink (downcase link))
(old-buffer (current-buffer))
(old-pos (point))
(old-mode major-mode)
- ext cmd link-match-data)
- (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile)
- (setq ext (match-string 1 dfile))
- (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile)
- (setq ext (match-string 1 dfile))))
+ (ext
+ (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile)
+ (match-string 1 dfile)))
+ cmd link-match-data)
(cond
((member in-emacs '((16) system))
- (setq cmd (cdr (assoc 'system apps))))
+ (setq cmd (cdr (assq 'system apps))))
(in-emacs (setq cmd 'emacs))
(t
- (setq cmd (or (and remp (cdr (assoc 'remote apps)))
- (and dirp (cdr (assoc 'directory apps)))
- ; first, try matching against apps-dlink
- ; if we get a match here, store the match data for later
+ (setq cmd (or (and remp (cdr (assq 'remote apps)))
+ (and dirp (cdr (assq 'directory apps)))
+ ;; First, try matching against apps-dlink if we
+ ;; get a match here, store the match data for
+ ;; later.
(let ((match (assoc-default dlink apps-dlink
'string-match)))
(if match
@@ -11400,9 +11472,9 @@ If the file does not exist, an error is thrown."
(assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
'string-match)
(cdr (assoc ext apps))
- (cdr (assoc t apps))))))
+ (cdr (assq t apps))))))
(when (eq cmd 'system)
- (setq cmd (cdr (assoc 'system apps))))
+ (setq cmd (cdr (assq 'system apps))))
(when (eq cmd 'default)
(setq cmd (cdr (assoc t apps))))
(when (eq cmd 'mailcap)
@@ -11413,21 +11485,20 @@ If the file does not exist, an error is thrown."
(if (stringp command)
(setq cmd command)
(setq cmd 'emacs))))
- (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
- (not (file-exists-p file))
- (not org-open-non-existing-files))
- (user-error "No such file: %s" file))
+ (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
+ (not (file-exists-p file))
+ (not org-open-non-existing-files))
+ (user-error "No such file: %s" file))
(cond
((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
;; Remove quotes around the file name - we'll use shell-quote-argument.
(while (string-match "['\"]%s['\"]" cmd)
(setq cmd (replace-match "%s" t t cmd)))
- (while (string-match "%s" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument
- (convert-standard-filename file)))
- t t cmd)))
+ (setq cmd (replace-regexp-in-string
+ "%s"
+ (shell-quote-argument (convert-standard-filename file))
+ cmd
+ nil t))
;; Replace "%1", "%2" etc. in command with group matches from regex
(save-match-data
@@ -11449,19 +11520,33 @@ If the file does not exist, an error is thrown."
(eq cmd 'emacs))
(funcall (cdr (assq 'file org-link-frame-setup)) file)
(widen)
- (if line (progn (org-goto-line line)
- (if (derived-mode-p 'org-mode)
- (org-reveal)))
- (if search (org-link-search search))))
+ (cond (line (org-goto-line line)
+ (when (derived-mode-p 'org-mode) (org-reveal)))
+ (search (org-link-search search))))
+ ((functionp cmd)
+ (save-match-data
+ (set-match-data link-match-data)
+ (condition-case nil
+ (funcall cmd file link)
+ ;; FIXME: Remove this check when most default installations
+ ;; of Emacs have at least Org 9.0.
+ ((debug wrong-number-of-arguments wrong-type-argument
+ invalid-function)
+ (user-error "Please see Org News for version 9.0 about \
+`org-file-apps'--Lisp error: %S" cmd)))))
((consp cmd)
- (let ((file (convert-standard-filename file)))
- (save-match-data
- (set-match-data link-match-data)
- (eval cmd))))
+ ;; FIXME: Remove this check when most default installations of
+ ;; Emacs have at least Org 9.0.
+ ;; Heads-up instead of silently fall back to
+ ;; `org-link-frame-setup' for an old usage of `org-file-apps'
+ ;; with sexp instead of a function for `cmd'.
+ (user-error "Please see Org News for version 9.0 about \
+`org-file-apps'--Error: Deprecated usage of %S" cmd))
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
- (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode)
- (or (not (equal old-buffer (current-buffer)))
- (not (equal old-pos (point))))
+ (and (derived-mode-p 'org-mode)
+ (eq old-mode 'org-mode)
+ (or (not (eq old-buffer (current-buffer)))
+ (not (eq old-pos (point))))
(org-mark-ring-push old-pos old-buffer))))
(defun org-file-apps-entry-match-against-dlink-p (entry)
@@ -11502,16 +11587,15 @@ be opened in Emacs."
(append
(delq nil
(mapcar (lambda (x)
- (if (not (stringp (car x)))
- nil
+ (unless (not (stringp (car x)))
(if (string-match "\\W" (car x))
x
(cons (concat "\\." (car x) "\\'") (cdr x)))))
list))
- (if add-auto-mode
- (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
+ (when add-auto-mode
+ (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
-(defvar ange-ftp-name-format) ; to silence the XEmacs compiler.
+(defvar ange-ftp-name-format)
(defun org-file-remote-p (file)
"Test whether FILE specifies a location on a remote system.
Return non-nil if the location is indeed remote.
@@ -11544,8 +11628,8 @@ on the system \"/user@host:\"."
((not (listp org-reverse-note-order)) nil)
(t (catch 'exit
(dolist (entry org-reverse-note-order)
- (if (string-match (car entry) buffer-file-name)
- (throw 'exit (cdr entry))))))))
+ (when (string-match (car entry) buffer-file-name)
+ (throw 'exit (cdr entry))))))))
(defvar org-refile-target-table nil
"The list of refile targets, created by `org-refile'.")
@@ -11570,7 +11654,7 @@ on the system \"/user@host:\"."
(defun org-refile-cache-clear ()
"Clear the refile cache and disable all the markers."
- (mapc (lambda (m) (move-marker m nil)) org-refile-markers)
+ (dolist (m org-refile-markers) (move-marker m nil))
(setq org-refile-markers nil)
(setq org-refile-cache nil)
(message "Refile cache has been cleared"))
@@ -11605,17 +11689,23 @@ on the system \"/user@host:\"."
org-refile-cache))))
(and set (org-refile-cache-check-set set) set)))))
-(defun org-refile-get-targets (&optional default-buffer excluded-entries)
+(defvar org-outline-path-cache nil
+ "Alist between buffer positions and outline paths.
+It value is an alist (POSITION . PATH) where POSITION is the
+buffer position at the beginning of an entry and PATH is a list
+of strings describing the outline path for that entry, in reverse
+order.")
+
+(defun org-refile-get-targets (&optional default-buffer)
"Produce a table with refile targets."
(let ((case-fold-search nil)
;; otherwise org confuses "TODO" as a kw and "Todo" as a word
(entries (or org-refile-targets '((nil . (:level . 1)))))
- targets tgs txt re files desc descre fast-path-p level pos0)
+ targets tgs files desc descre)
(message "Getting targets...")
(with-current-buffer (or default-buffer (current-buffer))
(dolist (entry entries)
(setq files (car entry) desc (cdr entry))
- (setq fast-path-p nil)
(cond
((null files) (setq files (list (current-buffer))))
((eq files 'org-agenda-files)
@@ -11624,7 +11714,7 @@ on the system \"/user@host:\"."
(setq files (funcall files)))
((and (symbolp files) (boundp files))
(setq files (symbol-value files))))
- (if (stringp files) (setq files (list files)))
+ (when (stringp files) (setq files (list files)))
(cond
((eq (car desc) :tag)
(setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
@@ -11639,7 +11729,6 @@ on the system \"/user@host:\"."
(cdr desc)))
"\\}[ \t]")))
((eq (car desc) :maxlevel)
- (setq fast-path-p t)
(setq descre (concat "^\\*\\{1," (number-to-string
(if org-odd-levels-only
(1- (* 2 (cdr desc)))
@@ -11647,58 +11736,51 @@ on the system \"/user@host:\"."
"\\}[ \t]")))
(t (error "Bad refiling target description %s" desc)))
(dolist (f files)
- (with-current-buffer
- (if (bufferp f) f (org-get-agenda-file-buffer f))
+ (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
(or
(setq tgs (org-refile-cache-get (buffer-file-name) descre))
(progn
- (if (bufferp f) (setq f (buffer-file-name
- (buffer-base-buffer f))))
+ (when (bufferp f)
+ (setq f (buffer-file-name (buffer-base-buffer f))))
(setq f (and f (expand-file-name f)))
- (if (eq org-refile-use-outline-path 'file)
- (push (list (file-name-nondirectory f) f nil nil) tgs))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward descre nil t)
- (goto-char (setq pos0 (point-at-bol)))
- (catch 'next
- (when org-refile-target-verify-function
- (save-match-data
- (or (funcall org-refile-target-verify-function)
- (throw 'next t))))
- (when (and (looking-at org-complex-heading-regexp)
- (not (member (match-string 4) excluded-entries))
- (match-string 4))
- (setq level (org-reduced-level
- (- (match-end 1) (match-beginning 1)))
- txt (org-link-display-format (match-string 4))
- txt (replace-regexp-in-string "\\( *[[0-9]+/?[0-9]*%?]\\)+$" "" txt)
- re (format org-complex-heading-regexp-format
- (regexp-quote (match-string 4))))
- (when org-refile-use-outline-path
- (setq txt (mapconcat
- 'org-protect-slash
- (append
- (if (eq org-refile-use-outline-path
- 'file)
- (list (file-name-nondirectory
- (buffer-file-name
- (buffer-base-buffer))))
- (if (eq org-refile-use-outline-path
- 'full-file-path)
- (list (buffer-file-name
- (buffer-base-buffer)))))
- (org-get-outline-path fast-path-p
- level txt)
- (list txt))
- "/")))
- (push (list txt f re (org-refile-marker (point)))
- tgs)))
- (when (= (point) pos0)
- ;; verification function has not moved point
- (goto-char (point-at-eol))))))))
+ (when (eq org-refile-use-outline-path 'file)
+ (push (list (file-name-nondirectory f) f nil nil) tgs))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (setq org-outline-path-cache nil)
+ (while (re-search-forward descre nil t)
+ (beginning-of-line)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
+ (let ((begin (point))
+ (heading (match-string-no-properties 4)))
+ (unless (or (and
+ org-refile-target-verify-function
+ (not
+ (funcall org-refile-target-verify-function)))
+ (not heading))
+ (let ((re (format org-complex-heading-regexp-format
+ (regexp-quote heading)))
+ (target
+ (if (not org-refile-use-outline-path) heading
+ (mapconcat
+ #'org-protect-slash
+ (append
+ (pcase org-refile-use-outline-path
+ (`file (list (file-name-nondirectory
+ (buffer-file-name
+ (buffer-base-buffer)))))
+ (`full-file-path
+ (list (buffer-file-name
+ (buffer-base-buffer))))
+ (_ nil))
+ (org-get-outline-path t t))
+ "/"))))
+ (push (list target f re (org-refile-marker (point)))
+ tgs)))
+ (when (= (point) begin)
+ ;; Verification function has not moved point.
+ (end-of-line)))))))
(when org-refile-use-cache
(org-refile-cache-put tgs (buffer-file-name) descre))
(setq targets (append tgs targets))))))
@@ -11706,40 +11788,61 @@ on the system \"/user@host:\"."
(nreverse targets)))
(defun org-protect-slash (s)
- (while (string-match "/" s)
- (setq s (replace-match "\\" t t s)))
- s)
-
-(defvar org-olpa (make-vector 20 nil))
-
-(defun org-get-outline-path (&optional fastp level heading)
- "Return the outline path to the current entry, as a list.
-
-The parameters FASTP, LEVEL, and HEADING are for use by a scanner
-routine which makes outline path derivations for an entire file,
-avoiding backtracing. Refile target collection makes use of that."
- (if fastp
- (progn
- (if (> level 19)
- (error "Outline path failure, more than 19 levels"))
- (loop for i from level upto 19 do
- (aset org-olpa i nil))
- (prog1
- (delq nil (append org-olpa nil))
- (aset org-olpa level heading)))
- (let (rtn case-fold-search)
- (save-excursion
- (save-restriction
- (widen)
- (while (org-up-heading-safe)
- (when (looking-at org-complex-heading-regexp)
- (push (org-trim
- (replace-regexp-in-string
- ;; Remove statistical/checkboxes cookies
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (org-match-string-no-properties 4)))
- rtn)))
- rtn)))))
+ (replace-regexp-in-string "/" "\\/" s nil t))
+
+(defun org--get-outline-path-1 (&optional use-cache)
+ "Return outline path to current headline.
+
+Outline path is a list of strings, in reverse order. When
+optional argument USE-CACHE is non-nil, make use of a cache. See
+`org-get-outline-path' for details.
+
+Assume buffer is widened and point is on a headline."
+ (or (and use-cache (cdr (assq (point) org-outline-path-cache)))
+ (let ((p (point))
+ (heading (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp)
+ (if (not (match-end 4)) ""
+ ;; Remove statistics cookies.
+ (org-trim
+ (org-link-display-format
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (match-string-no-properties 4))))))))
+ (if (org-up-heading-safe)
+ (let ((path (cons heading (org--get-outline-path-1 use-cache))))
+ (when use-cache
+ (push (cons p path) org-outline-path-cache))
+ path)
+ ;; This is a new root node. Since we assume we are moving
+ ;; forward, we can drop previous cache so as to limit number
+ ;; of associations there.
+ (let ((path (list heading)))
+ (when use-cache (setq org-outline-path-cache (list (cons p path))))
+ path)))))
+
+(defun org-get-outline-path (&optional with-self use-cache)
+ "Return the outline path to the current entry.
+
+An outline path is a list of ancestors for current headline, as
+a list of strings. Statistics cookies are removed and links are
+replaced with their description, if any, or their path otherwise.
+
+When optional argument WITH-SELF is non-nil, the path also
+includes the current headline.
+
+When optional argument USE-CACHE is non-nil, cache outline paths
+between calls to this function so as to avoid backtracking. This
+argument is useful when planning to find more than one outline
+path in the same document. In that case, there are two
+conditions to satisfy:
+ - `org-outline-path-cache' is set to nil before starting the
+ process;
+ - outline paths are computed by increasing buffer positions."
+ (org-with-wide-buffer
+ (and (or (and with-self (org-back-to-heading t))
+ (org-up-heading-safe))
+ (reverse (org--get-outline-path-1 use-cache)))))
(defun org-format-outline-path (path &optional width prefix separator)
"Format the outline path PATH for display.
@@ -11758,11 +11861,11 @@ the default is \"/\"."
prefix (and prefix path separator)
(mapconcat
(lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
- (loop for head in path
- for n from 0
- collect (org-add-props
- head nil 'face
- (nth (% n org-n-level-faces) org-level-faces)))
+ (cl-loop for head in path
+ for n from 0
+ collect (org-add-props
+ head nil 'face
+ (nth (% n org-n-level-faces) org-level-faces)))
separator))))
(when (> (length fpath) width)
(if (< width 7)
@@ -11785,10 +11888,10 @@ If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
(bfn (buffer-file-name (buffer-base-buffer)))
(path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
res)
- (if current (setq path (append path
- (save-excursion
- (org-back-to-heading t)
- (if (looking-at org-complex-heading-regexp)
+ (when current (setq path (append path
+ (save-excursion
+ (org-back-to-heading t)
+ (when (looking-at org-complex-heading-regexp)
(list (match-string 4)))))))
(setq res
(org-format-outline-path
@@ -11820,6 +11923,7 @@ the *old* location.")
(defun org-refile (&optional arg default-buffer rfloc msg)
"Move the entry or entries at point to another heading.
+
The list of target headings is compiled using the information in
`org-refile-targets', which see.
@@ -11831,10 +11935,12 @@ If there is an active region, all entries in that region will be
refiled. However, the region must fulfill the requirement that
the first heading sets the top-level of the moved text.
-With prefix arg ARG, the command will only visit the target
-location and not actually move anything.
+With a `\\[universal-argument]' ARG, the command will only visit the target \
+location
+and not actually move anything.
-With a double prefix arg \\[universal-argument] \\[universal-argument], go to the location where the last
+With a prefix `\\[universal-argument] \\[universal-argument]', go to the \
+location where the last
refiling operation has put the subtree.
With a numeric prefix argument of `2', refile to the running clock.
@@ -11849,11 +11955,11 @@ RFLOC can be a refile location obtained in a different way.
MSG is a string to replace \"Refile\" in the default prompt with
another verb. E.g. `org-copy' sets this parameter to \"Copy\".
-See also `org-refile-use-outline-path' and `org-completion-use-ido'.
+See also `org-refile-use-outline-path'.
If you are using target caching (see `org-refile-use-cache'), you
have to clear the target cache in order to find new targets.
-This can be done with a 0 prefix (`C-0 C-c C-w') or a triple
+This can be done with a `0' prefix (`C-0 C-c C-w') or a triple
prefix argument (`C-u C-u C-u C-c C-w')."
(interactive "P")
(if (member arg '(0 (64)))
@@ -11861,13 +11967,11 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(let* ((actionmsg (cond (msg msg)
((equal arg 3) "Refile (and keep)")
(t "Refile")))
- (cbuf (current-buffer))
(regionp (org-region-active-p))
(region-start (and regionp (region-beginning)))
(region-end (and regionp (region-end)))
- (filename (buffer-file-name (buffer-base-buffer cbuf)))
(org-refile-keep (if (equal arg 3) t org-refile-keep))
- pos it nbuf file re level reversed)
+ pos it nbuf file level reversed)
(setq last-command nil)
(when regionp
(goto-char region-start)
@@ -11892,43 +11996,43 @@ prefix argument (`C-u C-u C-u C-c C-w')."
""
(marker-position org-clock-hd-marker)))
(setq arg nil)))
- (setq it (or rfloc
- (let (heading-text)
- (save-excursion
- (unless (and arg (listp arg))
- (org-back-to-heading t)
- (setq heading-text
- (replace-regexp-in-string
- org-bracket-link-regexp
- "\\3"
- (nth 4 (org-heading-components)))))
- (org-refile-get-location
- (cond ((and arg (listp arg)) "Goto")
- (regionp (concat actionmsg " region to"))
- (t (concat actionmsg " subtree \""
- heading-text "\" to")))
- default-buffer
- (and (not (equal '(4) arg))
- org-refile-allow-creating-parent-nodes)
- arg))))))
+ (setq it
+ (or rfloc
+ (let (heading-text)
+ (save-excursion
+ (unless (and arg (listp arg))
+ (org-back-to-heading t)
+ (setq heading-text
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ "\\3"
+ (or (nth 4 (org-heading-components))
+ ""))))
+ (org-refile-get-location
+ (cond ((and arg (listp arg)) "Goto")
+ (regionp (concat actionmsg " region to"))
+ (t (concat actionmsg " subtree \""
+ heading-text "\" to")))
+ default-buffer
+ (and (not (equal '(4) arg))
+ org-refile-allow-creating-parent-nodes)))))))
(setq file (nth 1 it)
- re (nth 2 it)
pos (nth 3 it))
- (if (and (not arg)
- pos
- (equal (buffer-file-name) file)
- (if regionp
- (and (>= pos region-start)
- (<= pos region-end))
- (and (>= pos (point))
- (< pos (save-excursion
- (org-end-of-subtree t t))))))
- (error "Cannot refile to position inside the tree or region"))
+ (when (and (not arg)
+ pos
+ (equal (buffer-file-name) file)
+ (if regionp
+ (and (>= pos region-start)
+ (<= pos region-end))
+ (and (>= pos (point))
+ (< pos (save-excursion
+ (org-end-of-subtree t t))))))
+ (error "Cannot refile to position inside the tree or region"))
(setq nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
(if (and arg (not (equal arg 3)))
(progn
- (org-pop-to-buffer-same-window nbuf)
+ (pop-to-buffer-same-window nbuf)
(goto-char pos)
(org-show-context 'org-goto))
(if regionp
@@ -11939,50 +12043,48 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(with-current-buffer (setq nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
(setq reversed (org-notes-order-reversed-p))
- (save-excursion
- (save-restriction
- (widen)
- (if pos
- (progn
- (goto-char pos)
- (looking-at org-outline-regexp)
- (setq level (org-get-valid-level (funcall outline-level) 1))
- (goto-char
- (if reversed
- (or (outline-next-heading) (point-max))
- (or (save-excursion (org-get-next-sibling))
- (org-end-of-subtree t t)
- (point-max)))))
- (setq level 1)
- (if (not reversed)
- (goto-char (point-max))
- (goto-char (point-min))
- (or (outline-next-heading) (goto-char (point-max)))))
- (if (not (bolp)) (newline))
- (org-paste-subtree level nil nil t)
- (when org-log-refile
- (org-add-log-setup 'refile nil nil 'findpos org-log-refile)
- (unless (eq org-log-refile 'note)
- (save-excursion (org-add-log-note))))
- (and org-auto-align-tags
- (let ((org-loop-over-headlines-in-active-region nil))
- (org-set-tags nil t)))
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-refile)))
- (when bookmark-name
- (with-demoted-errors
- (bookmark-set bookmark-name))))
- ;; If we are refiling for capture, make sure that the
- ;; last-capture pointers point here
- (when (org-bound-and-true-p org-refile-for-capture)
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-capture-marker)))
- (when bookmark-name
- (with-demoted-errors
- (bookmark-set bookmark-name))))
- (move-marker org-capture-last-stored-marker (point)))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
- (run-hooks 'org-after-refile-insert-hook))))
+ (org-with-wide-buffer
+ (if pos
+ (progn
+ (goto-char pos)
+ (looking-at org-outline-regexp)
+ (setq level (org-get-valid-level (funcall outline-level) 1))
+ (goto-char
+ (if reversed
+ (or (outline-next-heading) (point-max))
+ (or (save-excursion (org-get-next-sibling))
+ (org-end-of-subtree t t)
+ (point-max)))))
+ (setq level 1)
+ (if (not reversed)
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (or (outline-next-heading) (goto-char (point-max)))))
+ (unless (bolp) (newline))
+ (org-paste-subtree level nil nil t)
+ (when org-log-refile
+ (org-add-log-setup 'refile nil nil org-log-refile)
+ (unless (eq org-log-refile 'note)
+ (save-excursion (org-add-log-note))))
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-set-tags nil t)))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-refile)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
+ ;; If we are refiling for capture, make sure that the
+ ;; last-capture pointers point here
+ (when (bound-and-true-p org-capture-is-refiling)
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture-marker)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
+ (move-marker org-capture-last-stored-marker (point)))
+ (when (fboundp 'deactivate-mark) (deactivate-mark))
+ (run-hooks 'org-after-refile-insert-hook)))
(unless org-refile-keep
(if regionp
(delete-region (point) (+ (point) (- region-end region-start)))
@@ -12011,35 +12113,22 @@ Also check `org-refile-target-table'."
(list (replace-regexp-in-string "/$" "" refloc)
(replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
-(defun org-refile-get-location (&optional prompt default-buffer new-nodes
- no-exclude)
+(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
"Prompt the user for a refile location, using PROMPT.
PROMPT should not be suffixed with a colon and a space, because
this function appends the default value from
-`org-refile-history' automatically, if that is not empty.
-When NO-EXCLUDE is set, do not exclude headlines in the current subtree,
-this is used for the GOTO interface."
+`org-refile-history' automatically, if that is not empty."
(let ((org-refile-targets org-refile-targets)
- (org-refile-use-outline-path org-refile-use-outline-path)
- excluded-entries)
- (when (and (derived-mode-p 'org-mode)
- (not org-refile-use-cache)
- (not no-exclude))
- (org-map-tree
- (lambda()
- (setq excluded-entries
- (append excluded-entries (list (org-get-heading t t)))))))
- (setq org-refile-target-table
- (org-refile-get-targets default-buffer excluded-entries)))
+ (org-refile-use-outline-path org-refile-use-outline-path))
+ (setq org-refile-target-table (org-refile-get-targets default-buffer)))
(unless org-refile-target-table
(user-error "No refile targets"))
(let* ((cbuf (current-buffer))
- (partial-completion-mode nil)
(cfn (buffer-file-name (buffer-base-buffer cbuf)))
(cfunc (if (and org-refile-use-outline-path
org-outline-path-complete-in-steps)
- 'org-olpath-completing-read
- 'org-icompleting-read))
+ #'org-olpath-completing-read
+ #'completing-read))
(extra (if org-refile-use-outline-path "/" ""))
(cbnex (concat (buffer-name) extra))
(filename (and cfn (expand-file-name cfn)))
@@ -12074,8 +12163,8 @@ this is used for the GOTO interface."
(cons (car pa) (if (assoc (car org-refile-history) tbl)
org-refile-history
(cdr org-refile-history))))
- (if (equal (car org-refile-history) (nth 1 org-refile-history))
- (pop org-refile-history)))
+ (when (equal (car org-refile-history) (nth 1 org-refile-history))
+ (pop org-refile-history)))
pa)
(if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
(progn
@@ -12105,13 +12194,11 @@ this is used for the GOTO interface."
(or (find-buffer-visiting file)
(find-file-noselect file))))
(with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (beginning-of-line 1)
- (unless (org-looking-at-p re)
- (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))))
+ (org-with-wide-buffer
+ (goto-char pos)
+ (beginning-of-line 1)
+ (unless (looking-at-p re)
+ (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
(defun org-refile-new-child (parent-target child)
"Use refile target PARENT-TARGET to add new CHILD below it."
@@ -12122,29 +12209,25 @@ this is used for the GOTO interface."
level)
(with-current-buffer (or (find-buffer-visiting file)
(find-file-noselect file))
- (save-excursion
- (save-restriction
- (widen)
- (if pos
- (goto-char pos)
- (goto-char (point-max))
- (if (not (bolp)) (newline)))
- (when (looking-at org-outline-regexp)
- (setq level (funcall outline-level))
- (org-end-of-subtree t t))
- (org-back-over-empty-lines)
- (insert "\n" (make-string
- (if pos (org-get-valid-level level 1) 1) ?*)
- " " child "\n")
- (beginning-of-line 0)
- (list (concat (car parent-target) "/" child) file "" (point)))))))
+ (org-with-wide-buffer
+ (if pos
+ (goto-char pos)
+ (goto-char (point-max))
+ (unless (bolp) (newline)))
+ (when (looking-at org-outline-regexp)
+ (setq level (funcall outline-level))
+ (org-end-of-subtree t t))
+ (org-back-over-empty-lines)
+ (insert "\n" (make-string
+ (if pos (org-get-valid-level level 1) 1) ?*)
+ " " child "\n")
+ (beginning-of-line 0)
+ (list (concat (car parent-target) "/" child) file "" (point))))))
(defun org-olpath-completing-read (prompt collection &rest args)
"Read an outline path like a file name."
- (let ((thetable collection)
- (org-completion-use-ido nil) ; does not work with ido.
- (org-completion-use-iswitchb nil)) ; or iswitchb
- (apply #'org-icompleting-read
+ (let ((thetable collection))
+ (apply #'completing-read
prompt
(lambda (string predicate &optional flag)
(cond
@@ -12175,7 +12258,7 @@ If not found, stay at current position and return nil."
(setq pos (and (re-search-forward
(concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t)
(match-beginning 0))))
- (if pos (goto-char pos))
+ (when pos (goto-char pos))
pos))
(defun org-create-dblock (plist)
@@ -12300,15 +12383,14 @@ This function can be used in a hook."
;;;; Completion
-(declare-function org-export-backend-name "org-export" (cl-x))
-(declare-function org-export-backend-options "org-export" (cl-x))
+(declare-function org-export-backend-options "ox" (cl-x) t)
(defun org-get-export-keywords ()
"Return a list of all currently understood export keywords.
Export keywords include options, block names, attributes and
keywords relative to each registered export back-end."
(let (keywords)
(dolist (backend
- (org-bound-and-true-p org-export-registered-backends)
+ (bound-and-true-p org-export-registered-backends)
(delq nil keywords))
;; Back-end name (for keywords, like #+LATEX:)
(push (upcase (symbol-name (org-export-backend-name backend))) keywords)
@@ -12330,11 +12412,11 @@ keywords relative to each registered export back-end."
("v" "#+BEGIN_VERSE\n?\n#+END_VERSE")
("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM")
("c" "#+BEGIN_CENTER\n?\n#+END_CENTER")
- ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX")
+ ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT")
("L" "#+LaTeX: ")
- ("h" "#+BEGIN_HTML\n?\n#+END_HTML")
+ ("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT")
("H" "#+HTML: ")
- ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII")
+ ("a" "#+BEGIN_EXPORT ascii\n?\n#+END_EXPORT")
("A" "#+ASCII: ")
("i" "#+INDEX: ?")
("I" "#+INCLUDE: %file ?"))
@@ -12353,7 +12435,7 @@ variable `org-mtags-prefer-muse-templates'."
(list
(string :tag "Key")
(string :tag "Template")))
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3"))
(defun org-try-structure-completion ()
@@ -12381,18 +12463,18 @@ expands them."
(setq ind (buffer-substring (point-at-bol) (point))))
(t (newline))))
(setq start (point))
- (if (string-match "%file" rpl)
- (setq rpl (replace-match
- (concat
- "\""
- (save-match-data
- (abbreviate-file-name (read-file-name "Include file: ")))
- "\"")
- t t rpl)))
+ (when (string-match "%file" rpl)
+ (setq rpl (replace-match
+ (concat
+ "\""
+ (save-match-data
+ (abbreviate-file-name (read-file-name "Include file: ")))
+ "\"")
+ t t rpl)))
(setq rpl (mapconcat 'identity (split-string rpl "\n")
(concat "\n" ind)))
(insert rpl)
- (if (re-search-backward "\\?" start t) (delete-char 1))))
+ (when (re-search-backward "\\?" start t) (delete-char 1))))
;;;; TODO, DEADLINE, Comments
@@ -12401,7 +12483,8 @@ expands them."
(interactive)
(save-excursion
(org-back-to-heading)
- (looking-at org-complex-heading-regexp)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
(goto-char (or (match-end 3) (match-end 2) (match-end 1)))
(skip-chars-forward " \t")
(unless (memq (char-before) '(?\s ?\t)) (insert " "))
@@ -12451,8 +12534,7 @@ nil or a string to be used for the todo mark." )
(if (eq major-mode 'org-agenda-mode)
(apply 'org-agenda-todo-yesterday arg)
(let* ((org-use-effective-time t)
- (hour (third (decode-time
- (org-current-time))))
+ (hour (nth 2 (decode-time (org-current-time))))
(org-extend-today-until (1+ hour)))
(org-todo arg))))
@@ -12466,44 +12548,49 @@ nil or a string to be used for the todo mark." )
(org-back-to-heading t)
(let ((bound1 (point))
(bound0 (save-excursion (outline-next-heading) (point))))
- (when (re-search-forward
- (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
- org-deadline-time-regexp "\\)\\|\\("
- org-ts-regexp "\\)")
- bound0 t)
- (if (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]" bound1 t)
- (replace-match "0" t nil nil 1))))))
-
+ (when (and (re-search-forward
+ (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
+ org-deadline-time-regexp "\\)\\|\\("
+ org-ts-regexp "\\)")
+ bound0 t)
+ (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]"
+ bound1 t))
+ (replace-match "0" t nil nil 1)))))
+
+(defvar org-state) ;; dynamically scoped into this function
(defun org-todo (&optional arg)
"Change the TODO state of an item.
+
The state of an item is given by a keyword at the start of the heading,
like
*** TODO Write paper
*** DONE Call mom
The different keywords are specified in the variable `org-todo-keywords'.
-By default the available states are \"TODO\" and \"DONE\".
-So for this example: when the item starts with TODO, it is changed to DONE.
+By default the available states are \"TODO\" and \"DONE\". So, for this
+example: when the item starts with TODO, it is changed to DONE.
When it starts with DONE, the DONE is removed. And when neither TODO nor
DONE are present, add TODO at the beginning of the heading.
-With \\[universal-argument] prefix arg, use completion to determine the new \
+With `\\[universal-argument]' prefix ARG, use completion to determine the new \
state.
-With numeric prefix arg, switch to that state.
-With a double \\[universal-argument] prefix, switch to the next set of TODO \
+With numeric prefix ARG, switch to that state.
+With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \
+next set of TODO \
keywords (nextset).
-With a triple \\[universal-argument] prefix, circumvent any state blocking.
+With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
+prefix, circumvent any state blocking.
With a numeric prefix arg of 0, inhibit note taking for the change.
With a numeric prefix arg of -1, cancel repeater to allow marking as DONE.
When called through ELisp, arg is also interpreted in the following way:
-`none' -> empty state
-\"\"(empty string) -> switch to empty state
-`done' -> switch to DONE
-`nextset' -> switch to the next set of keywords
-`previousset' -> switch to the previous set of keywords
-\"WAITING\" -> switch to the specified keyword, but only if it
- really is a member of `org-todo-keywords'."
+`none' -> empty state
+\"\" -> switch to empty state
+`done' -> switch to DONE
+`nextset' -> switch to the next set of keywords
+`previousset' -> switch to the previous set of keywords
+\"WAITING\" -> switch to the specified keyword, but only if it
+ really is a member of `org-todo-keywords'."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
@@ -12512,8 +12599,8 @@ When called through ELisp, arg is also interpreted in the following way:
(org-map-entries
`(org-todo ,arg)
org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
- (if (equal arg '(16)) (setq arg 'nextset))
+ cl (when (outline-invisible-p) (org-end-of-subtree nil t))))
+ (when (equal arg '(16)) (setq arg 'nextset))
(when (equal arg -1) (org-cancel-repeater) (setq arg nil))
(let ((org-blocker-hook org-blocker-hook)
commentp
@@ -12530,7 +12617,7 @@ When called through ELisp, arg is also interpreted in the following way:
(when (org-in-commented-heading-p t)
(org-toggle-comment)
(setq commentp t))
- (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
+ (when (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
(or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
(looking-at "\\(?: *\\|[ \t]*$\\)"))
(let* ((match-data (match-data))
@@ -12566,16 +12653,15 @@ When called through ELisp, arg is also interpreted in the following way:
(or (not org-use-fast-todo-selection)
(not org-todo-key-trigger)))
;; Read a state with completion
- (org-icompleting-read
- "State: " (mapcar 'list org-todo-keywords-1)
+ (completing-read
+ "State: " (mapcar #'list org-todo-keywords-1)
nil t))
((eq arg 'right)
(if this
(if tail (car tail) nil)
(car org-todo-keywords-1)))
((eq arg 'left)
- (if (equal member org-todo-keywords-1)
- nil
+ (unless (equal member org-todo-keywords-1)
(if this
(nth (- (length org-todo-keywords-1)
(length tail) 2)
@@ -12628,7 +12714,7 @@ When called through ELisp, arg is also interpreted in the following way:
(org-with-wide-buffer
(run-hook-with-args-until-failure
'org-blocker-hook change-plist))))
- (if (org-called-interactively-p 'interactive)
+ (if (called-interactively-p 'interactive)
(user-error "TODO state change from %s to %s blocked (by \"%s\")"
this org-state org-block-entry-blocking)
;; fail silently
@@ -12664,8 +12750,8 @@ When called through ELisp, arg is also interpreted in the following way:
;; we need to look at recording a time and note
(setq dolog (or (nth 1 (assoc org-state org-todo-log-states))
(nth 2 (assoc this org-todo-log-states))))
- (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
- (setq dolog 'time))
+ (when (and (eq dolog 'note) (eq org-inhibit-logging 'note))
+ (setq dolog 'time))
(when (or (and (not org-state) (not org-closed-keep-when-no-todo))
(and org-state
(member org-state org-not-done-keywords)
@@ -12676,19 +12762,19 @@ When called through ELisp, arg is also interpreted in the following way:
(when (and now-done-p org-log-done)
;; It is now done, and it was not done before
(org-add-planning-info 'closed (org-current-effective-time))
- (if (and (not dolog) (eq 'note org-log-done))
- (org-add-log-setup 'done org-state this 'findpos 'note)))
+ (when (and (not dolog) (eq 'note org-log-done))
+ (org-add-log-setup 'done org-state this 'note)))
(when (and org-state dolog)
;; This is a non-nil state, and we need to log it
- (org-add-log-setup 'state org-state this 'findpos dolog)))
+ (org-add-log-setup 'state org-state this dolog)))
;; Fixup tag positioning
(org-todo-trigger-tag-changes org-state)
(and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
(when org-provide-todo-statistics
(org-update-parent-todo-statistics))
(run-hooks 'org-after-todo-state-change-hook)
- (if (and arg (not (member org-state org-done-keywords)))
- (setq head (org-get-todo-sequence-head org-state)))
+ (when (and arg (not (member org-state org-done-keywords)))
+ (setq head (org-get-todo-sequence-head org-state)))
(put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
;; Do we need to trigger a repeat?
(when now-done-p
@@ -12699,14 +12785,13 @@ When called through ELisp, arg is also interpreted in the following way:
(org-get-heading))))
(org-auto-repeat-maybe org-state))
;; Fixup cursor location if close to the keyword
- (if (and (outline-on-heading-p)
- (not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
- (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
- (progn
- (goto-char (or (match-end 2) (match-end 1)))
- (and (looking-at " ") (just-one-space))))
+ (when (and (outline-on-heading-p)
+ (not (bolp))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-todo-line-regexp))
+ (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
+ (goto-char (or (match-end 2) (match-end 1)))
+ (and (looking-at " ") (just-one-space)))
(when org-trigger-hook
(save-excursion
(run-hook-with-args 'org-trigger-hook change-plist)))
@@ -12748,10 +12833,10 @@ changes. Such blocking occurs when:
(> child-level this-level))
;; this todo has children, check whether they are all
;; completed
- (if (and (not (org-entry-is-done-p))
- (org-entry-is-todo-p))
- (progn (setq org-block-entry-blocking (org-get-heading))
- (throw 'dont-block nil)))
+ (when (and (not (org-entry-is-done-p))
+ (org-entry-is-todo-p))
+ (setq org-block-entry-blocking (org-get-heading))
+ (throw 'dont-block nil))
(outline-next-heading)
(setq child-level (funcall outline-level))))))
;; Otherwise, if the task's parent has the :ORDERED: property, and
@@ -12760,7 +12845,7 @@ changes. Such blocking occurs when:
(org-back-to-heading t)
(let* ((pos (point))
(parent-pos (and (org-up-heading-safe) (point))))
- (if (not parent-pos) (throw 'dont-block t)) ; no parent
+ (unless parent-pos (throw 'dont-block t)) ; no parent
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
(forward-line 1)
(re-search-forward org-not-done-heading-regexp pos t))
@@ -12769,11 +12854,11 @@ changes. Such blocking occurs when:
;; Search further up the hierarchy, to see if an ancestor is blocked
(while t
(goto-char parent-pos)
- (if (not (looking-at org-not-done-heading-regexp))
- (throw 'dont-block t)) ; do not block, parent is not a TODO
+ (unless (looking-at org-not-done-heading-regexp)
+ (throw 'dont-block t)) ; do not block, parent is not a TODO
(setq pos (point))
(setq parent-pos (and (org-up-heading-safe) (point)))
- (if (not parent-pos) (throw 'dont-block t)) ; no parent
+ (unless parent-pos (throw 'dont-block t)) ; no parent
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
(forward-line 1)
(re-search-forward org-not-done-heading-regexp pos t)
@@ -12841,15 +12926,14 @@ changes because there are unchecked boxes in this entry."
(outline-next-heading)
(setq end (point))
(goto-char beg)
- (if (org-list-search-forward
- (concat (org-item-beginning-re)
- "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
- "\\[[- ]\\]")
- end t)
- (progn
- (if (boundp 'org-blocked-by-checkboxes)
- (setq org-blocked-by-checkboxes t))
- (throw 'dont-block nil)))))
+ (when (org-list-search-forward
+ (concat (org-item-beginning-re)
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
+ "\\[[- ]\\]")
+ end t)
+ (when (boundp 'org-blocked-by-checkboxes)
+ (setq org-blocked-by-checkboxes t))
+ (throw 'dont-block nil))))
t))) ; do not block
(defun org-entry-blocked-p ()
@@ -12865,7 +12949,9 @@ changes because there are unchecked boxes in this entry."
(defun org-update-statistics-cookies (all)
"Update the statistics cookie, either from TODO or from checkboxes.
-This should be called with the cursor in a line with a statistics cookie."
+This should be called with the cursor in a line with a statistics
+cookie. When called with a \\[universal-argument] prefix, update
+all statistics cookies in the buffer."
(interactive "P")
(if all
(progn
@@ -12881,7 +12967,7 @@ This should be called with the cursor in a line with a statistics cookie."
(setq l1 (org-outline-level))
(setq end (save-excursion
(outline-next-heading)
- (if (org-at-heading-p) (setq l2 (org-outline-level)))
+ (when (org-at-heading-p) (setq l2 (org-outline-level)))
(point)))
(if (and (save-excursion
(re-search-forward
@@ -12918,7 +13004,7 @@ statistics everywhere."
(box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
level ltoggle l1 new ndel
(cnt-all 0) (cnt-done 0) is-percent kwd
- checkbox-beg ov ovs ove cookie-present)
+ checkbox-beg cookie-present)
(catch 'exit
(save-excursion
(beginning-of-line 1)
@@ -12965,8 +13051,9 @@ statistics everywhere."
(and (member kwd org-done-keywords)
(member kwd (cadr org-provide-todo-statistics))))))
(setq cnt-all (1+ cnt-all))
- (if (eq org-provide-todo-statistics t)
- (and kwd (setq cnt-all (1+ cnt-all)))))
+ (and (eq org-provide-todo-statistics t)
+ kwd
+ (setq cnt-all (1+ cnt-all))))
(when (or (and (member org-provide-todo-statistics '(t all-headlines))
(member kwd org-done-keywords))
(and (listp org-provide-todo-statistics)
@@ -12984,15 +13071,10 @@ statistics everywhere."
(max 1 cnt-all)))
(format "[%d/%d]" cnt-done cnt-all))
ndel (- (match-end 0) checkbox-beg))
- ;; handle overlays when updating cookie from column view
- (when (setq ov (car (overlays-at checkbox-beg)))
- (setq ovs (overlay-start ov) ove (overlay-end ov))
- (delete-overlay ov))
(goto-char checkbox-beg)
(insert new)
(delete-region (point) (+ (point) ndel))
- (when org-auto-align-tags (org-fix-tags-on-the-fly))
- (when ov (move-overlay ov ovs ove)))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly)))
(when cookie-present
(run-hook-with-args 'org-after-todo-statistics-hook
cnt-done (- cnt-all cnt-done))))))
@@ -13028,9 +13110,9 @@ This hook runs even if there is no statistics cookie present, in which case
(when (and (stringp state) (> (length state) 0))
(setq changes (append changes (cdr (assoc state l)))))
(when (member state org-not-done-keywords)
- (setq changes (append changes (cdr (assoc 'todo l)))))
+ (setq changes (append changes (cdr (assq 'todo l)))))
(when (member state org-done-keywords)
- (setq changes (append changes (cdr (assoc 'done l)))))
+ (setq changes (append changes (cdr (assq 'done l)))))
(dolist (c changes)
(org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
@@ -13086,13 +13168,13 @@ Returns the new TODO keyword, or nil if no state change should occur."
(set-buffer (get-buffer-create " *Org todo*"))
(org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
(erase-buffer)
- (org-set-local 'org-done-keywords done-keywords)
+ (setq-local org-done-keywords done-keywords)
(setq tbl fulltable cnt 0)
(while (setq e (pop tbl))
(cond
((equal e '(:startgroup))
(push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
+ (unless (= cnt 0)
(setq cnt 0)
(insert "\n"))
(insert "{ "))
@@ -13100,7 +13182,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(setq ingroup nil cnt 0)
(insert "}\n"))
((equal e '(:newline))
- (when (not (= cnt 0))
+ (unless (= cnt 0)
(setq cnt 0)
(insert "\n")
(setq e (car tbl))
@@ -13109,19 +13191,19 @@ Returns the new TODO keyword, or nil if no state change should occur."
(setq tbl (cdr tbl)))))
(t
(setq tg (car e) c (cdr e))
- (if ingroup (push tg (car groups)))
+ (when ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
(org-get-todo-face tg)))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (when (and (= cnt 0) (not ingroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(when (= (setq cnt (1+ cnt)) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (when ingroup (insert " "))
(setq cnt 0)))))
(insert "\n")
(goto-char (point-min))
- (if (not expert) (org-fit-window-to-buffer))
+ (unless expert (org-fit-window-to-buffer))
(message "[a-z..]:Set [SPC]:clear")
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
(cond
@@ -13190,11 +13272,12 @@ on INACTIVE-OK."
(defvar org-log-note-how nil)
(defvar org-log-note-extra)
(defun org-auto-repeat-maybe (done-word)
- "Check if the current headline contains a repeated deadline/schedule.
+ "Check if the current headline contains a repeated time-stamp.
+
If yes, set TODO state back to what it was and change the base date
of repeating deadline/scheduled time stamps to new date.
+
This function is run automatically after each state change to a DONE state."
- ;; last-state is dynamically scoped into this function
(let* ((repeat (org-get-repeat))
(aa (assoc org-last-state org-todo-kwd-alist))
(interpret (nth 1 aa))
@@ -13202,73 +13285,102 @@ This function is run automatically after each state change to a DONE state."
(whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
(msg "Entry repeats: ")
(org-log-done nil)
- (org-todo-log-states nil)
- re type n what ts time to-state)
+ (org-todo-log-states nil))
(when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
- (if (eq org-log-repeat t) (setq org-log-repeat 'state))
- (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE")
- org-todo-repeat-to-state))
- (unless (and to-state (member to-state org-todo-keywords-1))
- (setq to-state (if (eq interpret 'type) org-last-state head)))
- (org-todo to-state)
+ (when (eq org-log-repeat t) (setq org-log-repeat 'state))
+ (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
+ org-todo-repeat-to-state)))
+ (unless (and to-state (member to-state org-todo-keywords-1))
+ (setq to-state (if (eq interpret 'type) org-last-state head)))
+ (org-todo to-state))
(when (or org-log-repeat (org-entry-get nil "CLOCK"))
(org-entry-put nil "LAST_REPEAT" (format-time-string
(org-time-stamp-format t t))))
(when org-log-repeat
(if (or (memq 'org-add-log-note (default-value 'post-command-hook))
(memq 'org-add-log-note post-command-hook))
- ;; OK, we are already setup for some record
- (if (eq org-log-repeat 'note)
- ;; make sure we take a note, not only a time stamp
- (setq org-log-note-how 'note))
- ;; Set up for taking a record
- (org-add-log-setup 'state (or done-word (car org-done-keywords))
+ ;; We are already setup for some record.
+ (when (eq org-log-repeat 'note)
+ ;; Make sure we take a note, not only a time stamp.
+ (setq org-log-note-how 'note))
+ ;; Set up for taking a record.
+ (org-add-log-setup 'state
+ (or done-word (car org-done-keywords))
org-last-state
- 'findpos org-log-repeat)))
+ org-log-repeat)))
(org-back-to-heading t)
(org-add-planning-info nil nil 'closed)
- (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
- org-deadline-time-regexp "\\)\\|\\("
- org-ts-regexp "\\)"))
- (while (re-search-forward
- re (save-excursion (outline-next-heading) (point)) t)
- (setq type (if (match-end 1) org-scheduled-string
- (if (match-end 3) org-deadline-string "Plain:"))
- ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0))))
- (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)
- (setq n (string-to-number (match-string 2 ts))
- what (match-string 3 ts))
- (if (equal what "w") (setq n (* n 7) what "d"))
- (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)))
- (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n))
- ;; Preparation, see if we need to modify the start date for the change
- (when (match-end 1)
- (setq time (save-match-data (org-time-string-to-time ts)))
- (cond
- ((equal (match-string 1 ts) ".")
- ;; Shift starting date to today
- (org-timestamp-change
- (- (org-today) (time-to-days time))
- 'day))
- ((equal (match-string 1 ts) "+")
- (let ((nshiftmax 10) (nshift 0))
- (while (or (= nshift 0)
- (<= (time-to-days time)
- (time-to-days (current-time))))
- (when (= (incf nshift) nshiftmax)
- (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift))
- (user-error "Abort")))
- (org-timestamp-change n (cdr (assoc what whata)))
- (org-at-timestamp-p t)
- (setq ts (match-string 1))
- (setq time (save-match-data (org-time-string-to-time ts)))))
- (org-timestamp-change (- n) (cdr (assoc what whata)))
- ;; rematch, so that we have everything in place for the real shift
- (org-at-timestamp-p t)
- (setq ts (match-string 1))
- (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))))
- (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t))
- (setq msg (concat msg type " " org-last-changed-timestamp " "))))
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (while (re-search-forward org-ts-regexp end t)
+ (when (save-match-data
+ (or (org-at-planning-p)
+ (org-at-property-p)
+ (eq (org-element-type (save-excursion
+ (backward-char)
+ (org-element-context)))
+ 'timestamp)))
+ (let ((type (cond ((match-end 1) org-scheduled-string)
+ ((match-end 3) org-deadline-string)
+ (t "Plain:")))
+ (ts (or (match-string 2) (match-string 4) (match-string 0))))
+ (cond
+ ((not
+ (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))
+ ;; Time-stamps without a repeater are usually skipped.
+ ;; However, a SCHEDULED time-stamp without one is
+ ;; removed, as it is considered as no longer relevant.
+ (when (equal type org-scheduled-string)
+ (org-remove-timestamp-with-keyword type)))
+ (t
+ (let ((n (string-to-number (match-string 2 ts)))
+ (what (match-string 3 ts)))
+ (when (equal what "w") (setq n (* n 7) what "d"))
+ (when (and (equal what "h")
+ (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
+ ts)))
+ (user-error
+ "Cannot repeat in Repeat in %d hour(s) because no hour \
+has been set"
+ n))
+ ;; Preparation, see if we need to modify the start
+ ;; date for the change.
+ (when (match-end 1)
+ (let ((time (save-match-data (org-time-string-to-time ts))))
+ (cond
+ ((equal (match-string 1 ts) ".")
+ ;; Shift starting date to today
+ (org-timestamp-change
+ (- (org-today) (time-to-days time))
+ 'day))
+ ((equal (match-string 1 ts) "+")
+ (let ((nshiftmax 10)
+ (nshift 0))
+ (while (or (= nshift 0)
+ (not (time-less-p (current-time) time)))
+ (when (= (cl-incf nshift) nshiftmax)
+ (or (y-or-n-p
+ (format "%d repeater intervals were not \
+enough to shift date past today. Continue? "
+ nshift))
+ (user-error "Abort")))
+ (org-timestamp-change n (cdr (assoc what whata)))
+ (org-at-timestamp-p t)
+ (setq ts (match-string 1))
+ (setq time
+ (save-match-data
+ (org-time-string-to-time ts)))))
+ (org-timestamp-change (- n) (cdr (assoc what whata)))
+ ;; Rematch, so that we have everything in
+ ;; place for the real shift.
+ (org-at-timestamp-p t)
+ (setq ts (match-string 1))
+ (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
+ ts)))))
+ (save-excursion
+ (org-timestamp-change n (cdr (assoc what whata)) nil t))
+ (setq msg
+ (concat
+ msg type " " org-last-changed-timestamp " ")))))))))
(setq org-log-post-message msg)
(message "%s" msg))))
@@ -13276,7 +13388,7 @@ This function is run automatically after each state change to a DONE state."
"Make a compact tree which shows all headlines marked with TODO.
The tree will show the lines where the regexp matches, and all higher
headlines above the match.
-With a \\[universal-argument] prefix, prompt for a regexp to match.
+With a `\\[universal-argument]' prefix, prompt for a regexp to match.
With a numeric prefix N, construct a sparse tree for the Nth element
of `org-todo-keywords-1'."
(interactive "P")
@@ -13284,8 +13396,9 @@ of `org-todo-keywords-1'."
(kwd-re
(cond ((null arg) org-not-done-regexp)
((equal arg '(4))
- (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): "
- (mapcar 'list org-todo-keywords-1))))
+ (let ((kwd
+ (completing-read "Keyword (or KWD1|KWD2|...): "
+ (mapcar #'list org-todo-keywords-1))))
(concat "\\("
(mapconcat 'identity (org-split-string kwd "|") "\\|")
"\\)\\>")))
@@ -13310,9 +13423,9 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(org-map-entries
`(org-deadline ',arg ,time)
org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ cl (when (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((old-date (org-entry-get nil "DEADLINE"))
- (old-date-time (if old-date (org-time-string-to-time old-date)))
+ (old-date-time (when old-date (org-time-string-to-time old-date)))
(repeater (and old-date
(string-match
"\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
@@ -13321,8 +13434,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(cond
((equal arg '(4))
(when (and old-date org-log-redeadline)
- (org-add-log-setup 'deldeadline nil old-date 'findpos
- org-log-redeadline))
+ (org-add-log-setup 'deldeadline nil old-date org-log-redeadline))
(org-remove-timestamp-with-keyword org-deadline-string)
(message "Item no longer has a deadline."))
((equal arg '(16))
@@ -13350,8 +13462,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
org-log-redeadline
(not (equal old-date org-last-inserted-timestamp)))
(org-add-log-setup
- 'redeadline org-last-inserted-timestamp old-date 'findpos
- org-log-redeadline))
+ 'redeadline org-last-inserted-timestamp old-date org-log-redeadline))
(when repeater
(save-excursion
(org-back-to-heading t)
@@ -13381,9 +13492,9 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(org-map-entries
`(org-schedule ',arg ,time)
org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ cl (when (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((old-date (org-entry-get nil "SCHEDULED"))
- (old-date-time (if old-date (org-time-string-to-time old-date)))
+ (old-date-time (when old-date (org-time-string-to-time old-date)))
(repeater (and old-date
(string-match
"\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
@@ -13393,8 +13504,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
((equal arg '(4))
(progn
(when (and old-date org-log-reschedule)
- (org-add-log-setup 'delschedule nil old-date 'findpos
- org-log-reschedule))
+ (org-add-log-setup 'delschedule nil old-date org-log-reschedule))
(org-remove-timestamp-with-keyword org-scheduled-string)
(message "Item is no longer scheduled.")))
((equal arg '(16))
@@ -13422,8 +13532,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
org-log-reschedule
(not (equal old-date org-last-inserted-timestamp)))
(org-add-log-setup
- 'reschedule org-last-inserted-timestamp old-date 'findpos
- org-log-reschedule))
+ 'reschedule org-last-inserted-timestamp old-date org-log-reschedule))
(when repeater
(save-excursion
(org-back-to-heading t)
@@ -13468,10 +13577,10 @@ nil."
(if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point)))
(equal (char-before) ?\ ))
(backward-delete-char 1)
- (if (string-match "^[ \t]*$" (buffer-substring
- (point-at-bol) (point-at-eol)))
- (delete-region (point-at-bol)
- (min (point-max) (1+ (point-at-eol))))))))))
+ (when (string-match "^[ \t]*$" (buffer-substring
+ (point-at-bol) (point-at-eol)))
+ (delete-region (point-at-bol)
+ (min (point-max) (1+ (point-at-eol))))))))))
(defvar org-time-was-given) ; dynamically scoped parameter
(defvar org-end-time-was-given) ; dynamically scoped parameter
@@ -13482,7 +13591,7 @@ nil."
;; planning info location is fixed in the section.
(org-with-wide-buffer
(beginning-of-line)
- (and (org-looking-at-p org-planning-line-re)
+ (and (looking-at-p org-planning-line-re)
(eq (point)
(ignore-errors
(if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
@@ -13530,14 +13639,14 @@ WHAT entry will also be removed."
(org-back-to-heading t)
(forward-line)
(unless (bolp) (insert "\n"))
- (cond ((org-looking-at-p org-planning-line-re)
+ (cond ((looking-at-p org-planning-line-re)
;; Move to current indentation.
(skip-chars-forward " \t")
;; Check if we have to remove something.
(dolist (type (if what (cons what remove) remove))
(save-excursion
(when (re-search-forward
- (case type
+ (cl-case type
(closed org-closed-time-regexp)
(deadline org-deadline-time-regexp)
(scheduled org-scheduled-time-regexp)
@@ -13554,7 +13663,7 @@ WHAT entry will also be removed."
(line-end-position))))))
;; If there is nothing more to add and no more keyword
;; is left, remove the line completely.
- (if (and (org-looking-at-p "[ \t]*$") (not what))
+ (if (and (looking-at-p "[ \t]*$") (not what))
(delete-region (line-beginning-position)
(line-beginning-position 2))
;; If we removed last keyword, do not leave trailing
@@ -13568,10 +13677,10 @@ WHAT entry will also be removed."
(t (insert-before-markers "\n")
(backward-char 1)
(when org-adapt-indentation
- (org-indent-to-column (1+ (org-outline-level))))))
+ (indent-to-column (1+ (org-outline-level))))))
(when what
;; Insert planning keyword.
- (insert (case what
+ (insert (cl-case what
(closed org-closed-string)
(deadline org-deadline-string)
(scheduled org-scheduled-string)
@@ -13587,7 +13696,8 @@ WHAT entry will also be removed."
(unless (eolp) (insert " "))
ts))))))
-(defvar org-log-note-marker (make-marker))
+(defvar org-log-note-marker (make-marker)
+ "Marker pointing at the entry where the note is to be inserted.")
(defvar org-log-note-purpose nil)
(defvar org-log-note-state nil)
(defvar org-log-note-previous-state nil)
@@ -13596,8 +13706,7 @@ WHAT entry will also be removed."
(defvar org-log-note-return-to (make-marker))
(defvar org-log-note-effective-time nil
"Remembered current time so that dynamically scoped
-`org-extend-today-until' affects tha timestamps in state change
-log")
+`org-extend-today-until' affects timestamps in state change log")
(defvar org-log-post-message nil
"Message to be displayed after a log note has been stored.
@@ -13607,7 +13716,7 @@ The auto-repeater uses this.")
"Add a note to the current entry.
This is done in the same way as adding a state change note."
(interactive)
- (org-add-log-setup 'note nil nil 'findpos nil))
+ (org-add-log-setup 'note))
(defun org-log-beginning (&optional create)
"Return expected start of log notes in current entry.
@@ -13615,13 +13724,13 @@ When optional argument CREATE is non-nil, the function creates
a drawer to store notes, if necessary. Returned position ignores
narrowing."
(org-with-wide-buffer
- (org-end-of-meta-data)
- (let ((end (if (org-at-heading-p) (point)
- (save-excursion (outline-next-heading) (point))))
- (drawer (org-log-into-drawer)))
+ (let ((drawer (org-log-into-drawer)))
(cond
(drawer
+ (org-end-of-meta-data)
(let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))
+ (end (if (org-at-heading-p) (point)
+ (save-excursion (outline-next-heading) (point))))
(case-fold-search t))
(catch 'exit
;; Try to find existing drawer.
@@ -13639,38 +13748,29 @@ narrowing."
(insert ":" drawer ":\n:END:\n")
(org-indent-region beg (point)))
(end-of-line -1)))))
- (org-log-state-notes-insert-after-drawers
- (while (and (looking-at org-drawer-regexp)
- (progn (goto-char (match-end 0))
- (re-search-forward org-property-end-re end t)))
+ (t
+ (org-end-of-meta-data org-log-state-notes-insert-after-drawers)
+ (skip-chars-forward " \t\n")
+ (beginning-of-line)
+ (unless org-log-states-order-reversed
+ (org-skip-over-state-notes)
+ (skip-chars-backward " \t\n")
(forward-line)))))
(if (bolp) (point) (line-beginning-position 2))))
-(defun org-add-log-setup (&optional purpose state prev-state findpos how extra)
+(defun org-add-log-setup (&optional purpose state prev-state how extra)
"Set up the post command hook to take a note.
If this is about to TODO state change, the new state is expected in STATE.
-When FINDPOS is non-nil, find the correct position for the note in
-the current entry. If not, assume that it can be inserted at point.
HOW is an indicator what kind of note should be created.
EXTRA is additional text that will be inserted into the notes buffer."
- (org-with-wide-buffer
- (when findpos
- (goto-char (org-log-beginning t))
- (unless org-log-states-order-reversed
- (org-skip-over-state-notes)
- (skip-chars-backward " \t\n\r")
- (forward-line)))
- (move-marker org-log-note-marker (point))
- ;; Preserve position even if a property drawer is inserted in the
- ;; process.
- (set-marker-insertion-type org-log-note-marker t)
- (setq org-log-note-purpose purpose
- org-log-note-state state
- org-log-note-previous-state prev-state
- org-log-note-how how
- org-log-note-extra extra
- org-log-note-effective-time (org-current-effective-time))
- (add-hook 'post-command-hook 'org-add-log-note 'append)))
+ (move-marker org-log-note-marker (point))
+ (setq org-log-note-purpose purpose
+ org-log-note-state state
+ org-log-note-previous-state prev-state
+ org-log-note-how how
+ org-log-note-extra extra
+ org-log-note-effective-time (org-current-effective-time))
+ (add-hook 'post-command-hook 'org-add-log-note 'append))
(defun org-skip-over-state-notes ()
"Skip past the list of State notes in an entry."
@@ -13691,17 +13791,17 @@ EXTRA is additional text that will be inserted into the notes buffer."
("%T" . ,org-ts-regexp)
("%u" . ".*?")
("%U" . ".*?")))))))
- (while (org-looking-at-p regexp)
+ (while (looking-at-p regexp)
(goto-char (or (org-list-get-next-item (point) struct prevs)
(org-list-get-item-end (point) struct)))))))
-(defun org-add-log-note (&optional purpose)
- "Pop up a window for taking a note, and add this note later at point."
+(defun org-add-log-note (&optional _purpose)
+ "Pop up a window for taking a note, and add this note later."
(remove-hook 'post-command-hook 'org-add-log-note)
(setq org-log-note-window-configuration (current-window-configuration))
(delete-other-windows)
(move-marker org-log-note-return-to (point))
- (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker))
+ (pop-to-buffer-same-window (marker-buffer org-log-note-marker))
(goto-char org-log-note-marker)
(org-switch-to-buffer-other-window "*Org Note*")
(erase-buffer)
@@ -13730,100 +13830,99 @@ EXTRA is additional text that will be inserted into the notes buffer."
((eq org-log-note-purpose 'note)
"this entry")
(t (error "This should not happen")))))
- (if org-log-note-extra (insert org-log-note-extra))
- (org-set-local 'org-finish-function 'org-store-log-note)
+ (when org-log-note-extra (insert org-log-note-extra))
+ (setq-local org-finish-function 'org-store-log-note)
(run-hooks 'org-log-buffer-setup-hook)))
(defvar org-note-abort nil) ; dynamically scoped
(defun org-store-log-note ()
"Finish taking a log note, and insert it to where it belongs."
- (let ((txt (buffer-string)))
- (kill-buffer (current-buffer))
- (let ((note (cdr (assq org-log-note-purpose org-log-note-headings))) lines)
- (while (string-match "\\`# .*\n[ \t\n]*" txt)
- (setq txt (replace-match "" t t txt)))
- (if (string-match "\\s-+\\'" txt)
- (setq txt (replace-match "" t t txt)))
- (setq lines (org-split-string txt "\n"))
- (when (and note (string-match "\\S-" note))
- (setq note
- (org-replace-escapes
- note
- (list (cons "%u" (user-login-name))
- (cons "%U" user-full-name)
- (cons "%t" (format-time-string
- (org-time-stamp-format 'long 'inactive)
- org-log-note-effective-time))
- (cons "%T" (format-time-string
- (org-time-stamp-format 'long nil)
- org-log-note-effective-time))
- (cons "%d" (format-time-string
- (org-time-stamp-format nil 'inactive)
- org-log-note-effective-time))
- (cons "%D" (format-time-string
- (org-time-stamp-format nil nil)
- org-log-note-effective-time))
- (cons "%s" (cond
- ((not org-log-note-state) "")
- ((org-string-match-p org-ts-regexp
- org-log-note-state)
- (format "\"[%s]\""
- (substring org-log-note-state 1 -1)))
- (t (format "\"%s\"" org-log-note-state))))
- (cons "%S"
- (cond
- ((not org-log-note-previous-state) "")
- ((org-string-match-p org-ts-regexp
- org-log-note-previous-state)
- (format "\"[%s]\""
- (substring
- org-log-note-previous-state 1 -1)))
- (t (format "\"%s\""
- org-log-note-previous-state)))))))
- (when lines (setq note (concat note " \\\\")))
- (push note lines))
- (when (or current-prefix-arg org-note-abort)
- (when (org-log-into-drawer)
- (org-remove-empty-drawer-at org-log-note-marker))
- (setq lines nil))
- (when lines
- (with-current-buffer (marker-buffer org-log-note-marker)
- (org-with-wide-buffer
- (goto-char org-log-note-marker)
- (move-marker org-log-note-marker nil)
- ;; Make sure point is at the beginning of an empty line.
- (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
- ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n"))))
- ;; In an existing list, add a new item at the top level.
- ;; Otherwise, indent line like a regular one.
- (let ((itemp (org-in-item-p)))
- (if itemp
- (org-indent-line-to
- (let ((struct (save-excursion
- (goto-char itemp) (org-list-struct))))
- (org-list-get-ind (org-list-get-top-point struct) struct)))
- (org-indent-line)))
- (insert (org-list-bullet-string "-") (pop lines))
- (let ((ind (org-list-item-body-column (line-beginning-position))))
- (dolist (line lines)
- (insert "\n")
- (org-indent-line-to ind)
- (insert line)))
- (message "Note stored")
- (org-back-to-heading t)
- (org-cycle-hide-drawers 'children))
- ;; Fix `buffer-undo-list' when `org-store-log-note' is called
- ;; from within `org-add-log-note' because `buffer-undo-list'
- ;; is then modified outside of `org-with-remote-undo'.
- (when (eq this-command 'org-agenda-todo)
- (setcdr buffer-undo-list (cddr buffer-undo-list)))))))
- ;; Don't add undo information when called from `org-agenda-todo'
+ (let ((txt (prog1 (buffer-string)
+ (kill-buffer)))
+ (note (cdr (assq org-log-note-purpose org-log-note-headings)))
+ lines)
+ (while (string-match "\\`# .*\n[ \t\n]*" txt)
+ (setq txt (replace-match "" t t txt)))
+ (when (string-match "\\s-+\\'" txt)
+ (setq txt (replace-match "" t t txt)))
+ (setq lines (org-split-string txt "\n"))
+ (when (org-string-nw-p note)
+ (setq note
+ (org-replace-escapes
+ note
+ (list (cons "%u" (user-login-name))
+ (cons "%U" user-full-name)
+ (cons "%t" (format-time-string
+ (org-time-stamp-format 'long 'inactive)
+ org-log-note-effective-time))
+ (cons "%T" (format-time-string
+ (org-time-stamp-format 'long nil)
+ org-log-note-effective-time))
+ (cons "%d" (format-time-string
+ (org-time-stamp-format nil 'inactive)
+ org-log-note-effective-time))
+ (cons "%D" (format-time-string
+ (org-time-stamp-format nil nil)
+ org-log-note-effective-time))
+ (cons "%s" (cond
+ ((not org-log-note-state) "")
+ ((string-match-p org-ts-regexp
+ org-log-note-state)
+ (format "\"[%s]\""
+ (substring org-log-note-state 1 -1)))
+ (t (format "\"%s\"" org-log-note-state))))
+ (cons "%S"
+ (cond
+ ((not org-log-note-previous-state) "")
+ ((string-match-p org-ts-regexp
+ org-log-note-previous-state)
+ (format "\"[%s]\""
+ (substring
+ org-log-note-previous-state 1 -1)))
+ (t (format "\"%s\""
+ org-log-note-previous-state)))))))
+ (when lines (setq note (concat note " \\\\")))
+ (push note lines))
+ (when (and lines (not (or current-prefix-arg org-note-abort)))
+ (with-current-buffer (marker-buffer org-log-note-marker)
+ (org-with-wide-buffer
+ ;; Find location for the new note.
+ (goto-char org-log-note-marker)
+ (set-marker org-log-note-marker nil)
+ (goto-char (org-log-beginning t))
+ ;; Make sure point is at the beginning of an empty line.
+ (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
+ ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n"))))
+ ;; In an existing list, add a new item at the top level.
+ ;; Otherwise, indent line like a regular one.
+ (let ((itemp (org-in-item-p)))
+ (if itemp
+ (indent-line-to
+ (let ((struct (save-excursion
+ (goto-char itemp) (org-list-struct))))
+ (org-list-get-ind (org-list-get-top-point struct) struct)))
+ (org-indent-line)))
+ (insert (org-list-bullet-string "-") (pop lines))
+ (let ((ind (org-list-item-body-column (line-beginning-position))))
+ (dolist (line lines)
+ (insert "\n")
+ (indent-line-to ind)
+ (insert line)))
+ (message "Note stored")
+ (org-back-to-heading t)
+ (org-cycle-hide-drawers 'children))
+ ;; Fix `buffer-undo-list' when `org-store-log-note' is called
+ ;; from within `org-add-log-note' because `buffer-undo-list'
+ ;; is then modified outside of `org-with-remote-undo'.
+ (when (eq this-command 'org-agenda-todo)
+ (setcdr buffer-undo-list (cddr buffer-undo-list))))))
+ ;; Don't add undo information when called from `org-agenda-todo'.
(let ((buffer-undo-list (eq this-command 'org-agenda-todo)))
(set-window-configuration org-log-note-window-configuration)
(with-current-buffer (marker-buffer org-log-note-return-to)
(goto-char org-log-note-return-to))
(move-marker org-log-note-return-to nil)
- (and org-log-post-message (message "%s" org-log-post-message))))
+ (when org-log-post-message (message "%s" org-log-post-message))))
(defun org-remove-empty-drawer-at (pos)
"Remove an empty drawer at position POS.
@@ -13859,10 +13958,10 @@ D Show deadlines and scheduled items between a date range."
(interactive "P")
(setq type (or type org-sparse-tree-default-date-type))
(setq org-ts-type type)
- (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty
- [d]eadlines [b]efore-date [a]fter-date [D]ates range
- [c]ycle through date types: %s"
- (case type
+ (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty
+ \[d]eadlines [b]efore-date [a]fter-date [D]ates range
+ \[c]ycle through date types: %s"
+ (cl-case type
(all "all timestamps")
(scheduled "only scheduled")
(deadline "only deadline")
@@ -13871,7 +13970,7 @@ D Show deadlines and scheduled items between a date range."
(closed "with a closed time-stamp")
(otherwise "scheduled/deadline")))
(let ((answer (read-char-exclusive)))
- (case answer
+ (cl-case answer
(?c
(org-sparse-tree
arg
@@ -13885,20 +13984,19 @@ D Show deadlines and scheduled items between a date range."
(?T (org-show-todo-tree '(4)))
(?m (call-interactively 'org-match-sparse-tree))
((?p ?P)
- (let* ((kwd (org-icompleting-read
- "Property: " (mapcar 'list (org-buffer-property-keys))))
- (value (org-icompleting-read
- "Value: " (mapcar 'list (org-property-values kwd)))))
+ (let* ((kwd (completing-read
+ "Property: " (mapcar #'list (org-buffer-property-keys))))
+ (value (completing-read
+ "Value: " (mapcar #'list (org-property-values kwd)))))
(unless (string-match "\\`{.*}\\'" value)
(setq value (concat "\"" value "\"")))
(org-match-sparse-tree arg (concat kwd "=" value))))
((?r ?R ?/) (call-interactively 'org-occur))
(otherwise (user-error "No such sparse tree command \"%c\"" answer)))))
-(defvar org-occur-highlights nil
+(defvar-local org-occur-highlights nil
"List of overlays used for occur matches.")
-(make-variable-buffer-local 'org-occur-highlights)
-(defvar org-occur-parameters nil
+(defvar-local org-occur-parameters nil
"Parameters of the active org-occur calls.
This is a list, each call to org-occur pushes as cons cell,
containing the regular expression and the callback, onto the list.
@@ -13908,18 +14006,21 @@ will only contain one set of parameters. When the highlights are
removed (for example with `C-c C-c', or with the next edit (depending
on `org-remove-highlights-with-change'), this variable is emptied
as well.")
-(make-variable-buffer-local 'org-occur-parameters)
(defun org-occur (regexp &optional keep-previous callback)
"Make a compact tree which shows all matches of REGEXP.
-The tree will show the lines where the regexp matches, and all higher
-headlines above the match. It will also show the heading after the match,
-to make sure editing the matching entry is easy.
-If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous
-call to `org-occur' will be kept, to allow stacking of calls to this
-command.
-If CALLBACK is non-nil, it is a function which is called to confirm
-that the match should indeed be shown."
+
+The tree will show the lines where the regexp matches, and any other context
+defined in `org-show-context-detail', which see.
+
+When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
+done by a previous call to `org-occur' will be kept, to allow stacking of
+calls to this command.
+
+Optional argument CALLBACK can be a function of no argument. In this case,
+it is called with point at the end of the match, match data being set
+accordingly. Current match is shown only if the return value is non-nil.
+The function must neither move point nor alter narrowing."
(interactive "sRegexp: \nP")
(when (equal regexp "")
(user-error "Regexp cannot be empty"))
@@ -13929,33 +14030,35 @@ that the match should indeed be shown."
(let ((cnt 0))
(save-excursion
(goto-char (point-min))
- (if (or (not keep-previous) ; do not want to keep
- (not org-occur-highlights)) ; no previous matches
- ;; hide everything
- (org-overview))
- (while (re-search-forward regexp nil t)
- (backward-char) ;; FIXME: Match timestamps at the end of a headline
- (when (or (not callback)
- (save-match-data (funcall callback)))
- (setq cnt (1+ cnt))
- (when org-highlight-sparse-tree-matches
- (org-highlight-new-match (match-beginning 0) (match-end 0)))
- (org-show-context 'occur-tree))))
+ (when (or (not keep-previous) ; do not want to keep
+ (not org-occur-highlights)) ; no previous matches
+ ;; hide everything
+ (org-overview))
+ (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
+ (isearch-no-upper-case-p regexp t)
+ org-occur-case-fold-search)))
+ (while (re-search-forward regexp nil t)
+ (when (or (not callback)
+ (save-match-data (funcall callback)))
+ (setq cnt (1+ cnt))
+ (when org-highlight-sparse-tree-matches
+ (org-highlight-new-match (match-beginning 0) (match-end 0)))
+ (org-show-context 'occur-tree)))))
(when org-remove-highlights-with-change
- (org-add-hook 'before-change-functions 'org-remove-occur-highlights
- nil 'local))
+ (add-hook 'before-change-functions 'org-remove-occur-highlights
+ nil 'local))
(unless org-sparse-tree-open-archived-trees
(org-hide-archived-subtrees (point-min) (point-max)))
(run-hooks 'org-occur-hook)
- (if (org-called-interactively-p 'interactive)
- (message "%d match(es) for regexp %s" cnt regexp))
+ (when (called-interactively-p 'interactive)
+ (message "%d match(es) for regexp %s" cnt regexp))
cnt))
-(defun org-occur-next-match (&optional n reset)
+(defun org-occur-next-match (&optional n _reset)
"Function for `next-error-function' to find sparse tree matches.
N is the number of matches to move, when negative move backwards.
-RESET is entirely ignored - this function always goes back to the
-starting point when no match is found."
+This function always goes back to the starting point when no
+match is found."
(let* ((limit (if (< n 0) (point-min) (point-max)))
(search-func (if (< n 0)
'previous-single-char-property-change
@@ -13992,28 +14095,33 @@ be shown."
DETAIL is either nil, `minimal', `local', `ancestors', `lineage',
`tree', `canonical' or t. See `org-show-context-detail' for more
information."
- (unless (org-before-first-heading-p)
- ;; Show current heading and possibly its entry, following headline
- ;; or all children.
- (if (and (org-at-heading-p) (not (eq detail 'local)))
- (org-flag-heading nil)
- (org-show-entry)
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-flag-heading nil)
+ (org-show-entry)
+ ;; If point is hidden within a drawer or a block, make sure to
+ ;; expose it.
+ (dolist (o (overlays-at (point)))
+ (when (memq (overlay-get o 'invisible) '(org-hide-block outline))
+ (delete-overlay o)))
+ (unless (org-before-first-heading-p)
(org-with-limited-levels
- (case detail
- ((tree canonical t) (outline-show-children))
+ (cl-case detail
+ ((tree canonical t) (org-show-children))
((nil minimal ancestors))
(t (save-excursion
(outline-next-heading)
- (org-flag-heading nil))))))
- ;; Show all siblings.
- (when (eq detail 'lineage) (org-show-siblings))
- ;; Show ancestors, possibly with their children.
- (when (memq detail '(ancestors lineage tree canonical t))
- (save-excursion
- (while (org-up-heading-safe)
- (org-flag-heading nil)
- (when (memq detail '(canonical t)) (org-show-entry))
- (when (memq detail '(tree canonical t)) (outline-show-children)))))))
+ (org-flag-heading nil)))))))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors lineage tree canonical t))
+ (save-excursion
+ (while (org-up-heading-safe)
+ (org-flag-heading nil)
+ (when (memq detail '(canonical t)) (org-show-entry))
+ (when (memq detail '(tree canonical t)) (org-show-children))))))
(defvar org-reveal-start-hook nil
"Hook run before revealing a location.")
@@ -14028,9 +14136,8 @@ With optional argument SIBLINGS, on each level of the hierarchy all
siblings are shown. This repairs the tree structure to what it would
look like when opened with hierarchical calls to `org-cycle'.
-With double optional argument \\[universal-argument] \\[universal-argument], \
-go to the parent and show the
-entire tree."
+With a \\[universal-argument] \\[universal-argument] prefix, \
+go to the parent and show the entire tree."
(interactive "P")
(run-hooks 'org-reveal-start-hook)
(cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
@@ -14048,13 +14155,13 @@ entire tree."
(overlay-put ov 'org-type 'org-occur)
(push ov org-occur-highlights)))
-(defun org-remove-occur-highlights (&optional beg end noremove)
+(defun org-remove-occur-highlights (&optional _beg _end noremove)
"Remove the occur highlights from the buffer.
BEG and END are ignored. If NOREMOVE is nil, remove this function
from the `before-change-functions' in the current buffer."
(interactive)
(unless org-inhibit-highlight-removal
- (mapc 'delete-overlay org-occur-highlights)
+ (mapc #'delete-overlay org-occur-highlights)
(setq org-occur-highlights nil)
(setq org-occur-parameters nil)
(unless noremove
@@ -14078,7 +14185,7 @@ from the `before-change-functions' in the current buffer."
(interactive)
(org-priority 'down))
-(defun org-priority (&optional action show)
+(defun org-priority (&optional action _show)
"Change the priority of an item.
ACTION can be `set', `up', `down', or a character."
(interactive "P")
@@ -14090,23 +14197,23 @@ ACTION can be `set', `up', `down', or a character."
(let (current new news have remove)
(save-excursion
(org-back-to-heading t)
- (if (looking-at org-priority-regexp)
- (setq current (string-to-char (match-string 2))
- have t))
+ (when (looking-at org-priority-regexp)
+ (setq current (string-to-char (match-string 2))
+ have t))
(cond
((eq action 'remove)
(setq remove t new ?\ ))
((or (eq action 'set)
- (if (featurep 'xemacs) (characterp action) (integerp action)))
+ (integerp action))
(if (not (eq action 'set))
(setq new action)
(message "Priority %c-%c, SPC to remove: "
org-highest-priority org-lowest-priority)
(save-match-data
(setq new (read-char-exclusive))))
- (if (and (= (upcase org-highest-priority) org-highest-priority)
- (= (upcase org-lowest-priority) org-lowest-priority))
- (setq new (upcase new)))
+ (when (and (= (upcase org-highest-priority) org-highest-priority)
+ (= (upcase org-lowest-priority) org-lowest-priority))
+ (setq new (upcase new)))
(cond ((equal new ?\ ) (setq remove t))
((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
(user-error "Priority must be between `%c' and `%c'"
@@ -14132,16 +14239,16 @@ ACTION can be `set', `up', `down', or a character."
org-default-priority
(1+ org-default-priority))))))
(t (user-error "Invalid action")))
- (if (or (< (upcase new) org-highest-priority)
- (> (upcase new) org-lowest-priority))
- (if (and (memq action '(up down))
- (not have) (not (eq last-command this-command)))
- ;; `new' is from default priority
- (error
- "The default can not be set, see `org-default-priority' why")
- ;; normal cycling: `new' is beyond highest/lowest priority
- ;; and is wrapped around to the empty priority
- (setq remove t)))
+ (when (or (< (upcase new) org-highest-priority)
+ (> (upcase new) org-lowest-priority))
+ (if (and (memq action '(up down))
+ (not have) (not (eq last-command this-command)))
+ ;; `new' is from default priority
+ (error
+ "The default can not be set, see `org-default-priority' why")
+ ;; normal cycling: `new' is beyond highest/lowest priority
+ ;; and is wrapped around to the empty priority
+ (setq remove t)))
(setq news (format "%c" new))
(if have
(if remove
@@ -14195,6 +14302,7 @@ Can be set by the action argument to `org-scan-tags' and `org-map-entries'.")
(defvar org-scanner-tags nil
"The current tag list while the tags scanner is running.")
+
(defvar org-trust-scanner-tags nil
"Should `org-get-tags-at' use the tags for the scanner.
This is for internal dynamical scoping only.
@@ -14206,6 +14314,8 @@ obtain a list of properties. Building the tags list for each entry in such
a file becomes an N^2 operation - but with this variable set, it scales
as N.")
+(defvar org--matcher-tags-todo-only nil)
+
(defun org-scan-tags (action matcher todo-only &optional start-level)
"Scan headline tags with inheritance and produce output ACTION.
@@ -14214,11 +14324,14 @@ or `agenda' to produce an entry list for an agenda view. It can also be
a Lisp form or a function that should be called at each matched headline, in
this case the return value is a list of all return values from these calls.
-MATCHER is a Lisp form to be evaluated, testing if a given set of tags
-qualifies a headline for inclusion. When TODO-ONLY is non-nil,
-only lines with a not-done TODO keyword are included in the output.
-This should be the same variable that was scoped into
-and set by `org-make-tags-matcher' when it constructed MATCHER.
+MATCHER is a function accepting three arguments, returning
+a non-nil value whenever a given set of tags qualifies a headline
+for inclusion. See `org-make-tags-matcher' for more information.
+As a special case, it can also be set to t (respectively nil) in
+order to match all (respectively none) headline.
+
+When TODO-ONLY is non-nil, only lines with a not-done TODO
+keyword are included in the output.
START-LEVEL can be a string with asterisks, reducing the scope to
headlines matching this string."
@@ -14229,8 +14342,8 @@ headlines matching this string."
(concat "\\*\\{" (number-to-string start-level) "\\} ")
org-outline-regexp)
" *\\(\\<\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- (org-re "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
+ (mapconcat #'regexp-quote org-todo-keywords-1 "\\|")
+ "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
(props (list 'face 'default
'done-face 'org-agenda-done
'undone-face 'default
@@ -14249,7 +14362,7 @@ headlines matching this string."
(llast 0) rtn rtn1 level category i txt
todo marker entry priority
ts-date ts-date-type ts-date-pair)
- (when (not (or (member action '(agenda sparse-tree)) (functionp action)))
+ (unless (or (member action '(agenda sparse-tree)) (functionp action))
(setq action (list 'lambda nil action)))
(save-excursion
(goto-char (point-min))
@@ -14260,8 +14373,10 @@ headlines matching this string."
(re-search-forward re nil t))
(setq org-map-continue-from nil)
(catch :skip
- (setq todo (if (match-end 1) (org-match-string-no-properties 2))
- tags (if (match-end 4) (org-match-string-no-properties 4)))
+ (setq todo
+ ;; TODO: is the 1-2 difference a bug?
+ (when (match-end 1) (match-string-no-properties 2))
+ tags (when (match-end 4) (match-string-no-properties 4)))
(goto-char (setq lspos (match-beginning 0)))
(setq level (org-reduced-level (org-outline-level))
category (org-get-category))
@@ -14295,18 +14410,20 @@ headlines matching this string."
(when (and tags org-use-tag-inheritance
(or (not (eq t org-use-tag-inheritance))
org-tags-exclude-from-inheritance))
- ;; selective inheritance, remove uninherited ones
+ ;; Selective inheritance, remove uninherited ones.
(setcdr (car tags-alist)
(org-remove-uninherited-tags (cdar tags-alist))))
(when (and
;; eval matcher only when the todo condition is OK
(and (or (not todo-only) (member todo org-not-done-keywords))
- (let ((case-fold-search t) (org-trust-scanner-tags t))
- (eval matcher)))
+ (if (functionp matcher)
+ (let ((case-fold-search t) (org-trust-scanner-tags t))
+ (funcall matcher todo tags-list level))
+ matcher))
- ;; Call the skipper, but return t if it does not skip,
- ;; so that the `and' form continues evaluating
+ ;; Call the skipper, but return t if it does not
+ ;; skip, so that the `and' form continues evaluating.
(progn
(unless (eq action 'sparse-tree) (org-agenda-skip))
t)
@@ -14394,7 +14511,9 @@ If optional argument TODO-ONLY is non-nil, only select lines that are
also TODO lines."
(interactive "P")
(org-agenda-prepare-buffers (list (current-buffer)))
- (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
+ (let ((org--matcher-tags-todo-only todo-only))
+ (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match))
+ org--matcher-tags-todo-only)))
(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
@@ -14403,7 +14522,7 @@ also TODO lines."
(if (or (eq t org-use-property-inheritance)
(and (stringp org-use-property-inheritance)
(let ((case-fold-search t))
- (org-string-match-p org-use-property-inheritance property)))
+ (string-match-p org-use-property-inheritance property)))
(and (listp org-use-property-inheritance)
(member-ignore-case property org-use-property-inheritance)))
;; Caching is not possible, check it directly.
@@ -14421,175 +14540,162 @@ instead of the agenda files."
(save-excursion
(org-uniquify
(delq nil
- (apply 'append
+ (apply #'append
(mapcar
(lambda (file)
(set-buffer (find-file-noselect file))
- (append (org-get-buffer-tags)
- (mapcar (lambda (x) (if (stringp (car-safe x))
- (list (car-safe x)) nil))
- org-tag-alist)))
- (if (and files (car files))
- files
+ (mapcar (lambda (x)
+ (and (stringp (car-safe x))
+ (list (car-safe x))))
+ (or org-current-tag-alist (org-get-buffer-tags))))
+ (if (car-safe files) files
(org-agenda-files))))))))
(defun org-make-tags-matcher (match)
"Create the TAGS/TODO matcher form for the selection string MATCH.
-The variable `todo-only' is scoped dynamically into this function.
-It will be set to t if the matcher restricts matching to TODO entries,
-otherwise will not be touched.
-
-Returns a cons of the selection string MATCH and the constructed
-lisp form implementing the matcher. The matcher is to be evaluated
-at an Org entry, with point on the headline, and returns t if the
-entry matches the selection string MATCH. The returned lisp form
-references two variables with information about the entry, which
-must be bound around the form's evaluation: todo, the TODO keyword
-at the entry (or nil of none); and tags-list, the list of all tags
-at the entry including inherited ones. Additionally, the category
-of the entry (if any) must be specified as the text property
-`org-category' on the headline.
-
-See also `org-scan-tags'.
-"
- (declare (special todo-only))
- (unless (boundp 'todo-only)
- (error "`org-make-tags-matcher' expects todo-only to be scoped in"))
+Returns a cons of the selection string MATCH and a function
+implementing the matcher.
+
+The matcher is to be called at an Org entry, with point on the
+headline, and returns non-nil if the entry matches the selection
+string MATCH. It must be called with three arguments: the TODO
+keyword at the entry (or nil if none), the list of all tags at
+the entry including inherited ones and the reduced level of the
+headline. Additionally, the category of the entry, if any, must
+be specified as the text property `org-category' on the headline.
+
+This function sets the variable `org--matcher-tags-todo-only' to
+a non-nil value if the matcher restricts matching to TODO
+entries, otherwise it is not touched.
+
+See also `org-scan-tags'."
(unless match
;; Get a new match request, with completion against the global
- ;; tags table and the local tags in current buffer
+ ;; tags table and the local tags in current buffer.
(let ((org-last-tags-completion-table
(org-uniquify
(delq nil (append (org-get-buffer-tags)
(org-global-tags-completion-table))))))
- (setq match (org-completing-read-no-i
- "Match: " 'org-tags-completion-function nil nil nil
- 'org-tags-history))))
+ (setq match
+ (completing-read
+ "Match: "
+ 'org-tags-completion-function nil nil nil 'org-tags-history))))
- ;; Parse the string and create a lisp form
(let ((match0 match)
- (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)"))
- minus tag mm
- tagsmatch todomatch tagsmatcher todomatcher kwd matcher
- orterms term orlist re-p str-p level-p level-op time-p
- prop-p pn pv po gv rest (start 0) (ss 0))
- ;; Expand group tags
+ (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")
+ (start 0)
+ tagsmatch todomatch tagsmatcher todomatcher)
+
+ ;; Expand group tags.
(setq match (org-tags-expand match))
;; Check if there is a TODO part of this match, which would be the
- ;; part after a "/". TO make sure that this slash is not part of
- ;; a property value to be matched against, we also check that there
- ;; is no " after that slash.
- ;; First, find the last slash
- (while (string-match "/+" match ss)
- (setq start (match-beginning 0) ss (match-end 0)))
+ ;; part after a "/". To make sure that this slash is not part of
+ ;; a property value to be matched against, we also check that
+ ;; there is no / after that slash. First, find the last slash.
+ (let ((s 0))
+ (while (string-match "/+" match s)
+ (setq start (match-beginning 0))
+ (setq s (match-end 0))))
(if (and (string-match "/+" match start)
- (not (save-match-data (string-match "\"" match start))))
- ;; match contains also a todo-matching request
+ (not (string-match-p "\"" match start)))
+ ;; Match contains also a TODO-matching request.
(progn
- (setq tagsmatch (substring match 0 (match-beginning 0))
- todomatch (substring match (match-end 0)))
- (if (string-match "^!" todomatch)
- (setq todo-only t todomatch (substring todomatch 1)))
- (if (string-match "^\\s-*$" todomatch)
- (setq todomatch nil)))
- ;; only matching tags
- (setq tagsmatch match todomatch nil))
-
- ;; Make the tags matcher
- (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch)))
- (setq tagsmatcher t)
- (setq orterms (org-split-string tagsmatch "|") orlist nil)
- (while (setq term (pop orterms))
- (while (and (equal (substring term -1) "\\") orterms)
- (setq term (concat term "|" (pop orterms)))) ; repair bad split
- (while (string-match re term)
- (setq rest (substring term (match-end 0))
- minus (and (match-end 1)
- (equal (match-string 1 term) "-"))
- tag (save-match-data (replace-regexp-in-string
- "\\\\-" "-"
- (match-string 2 term)))
- re-p (equal (string-to-char tag) ?{)
- level-p (match-end 4)
- prop-p (match-end 5)
- mm (cond
- (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list))
- (level-p
- (setq level-op (org-op-to-function (match-string 3 term)))
- `(,level-op level ,(string-to-number
- (match-string 4 term))))
- (prop-p
- (setq pn (match-string 5 term)
- po (match-string 6 term)
- pv (match-string 7 term)
- re-p (equal (string-to-char pv) ?{)
- str-p (equal (string-to-char pv) ?\")
- time-p (save-match-data
- (string-match "^\"[[<].*[]>]\"$" pv))
- pv (if (or re-p str-p) (substring pv 1 -1) pv))
- (if time-p (setq pv (org-matcher-time pv)))
- (setq po (org-op-to-function po (if time-p 'time str-p)))
- (cond
- ((equal pn "CATEGORY")
- (setq gv '(get-text-property (point) 'org-category)))
- ((equal pn "TODO")
- (setq gv 'todo))
- (t
- (setq gv `(org-cached-entry-get nil ,pn))))
- (if re-p
- (if (eq po 'org<>)
- `(not (string-match ,pv (or ,gv "")))
- `(string-match ,pv (or ,gv "")))
- (if str-p
- `(,po (or ,gv "") ,pv)
- `(,po (string-to-number (or ,gv ""))
- ,(string-to-number pv) ))))
- (t `(member ,tag tags-list)))
- mm (if minus (list 'not mm) mm)
- term rest)
- (push mm tagsmatcher))
- (push (if (> (length tagsmatcher) 1)
- (cons 'and tagsmatcher)
- (car tagsmatcher))
- orlist)
- (setq tagsmatcher nil))
- (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist)))
- (setq tagsmatcher
- (list 'progn '(setq org-cached-props nil) tagsmatcher)))
- ;; Make the todo matcher
- (if (or (not todomatch) (not (string-match "\\S-" todomatch)))
- (setq todomatcher t)
- (setq orterms (org-split-string todomatch "|") orlist nil)
- (dolist (term orterms)
- (while (string-match re term)
- (setq minus (and (match-end 1)
- (equal (match-string 1 term) "-"))
- kwd (match-string 2 term)
- re-p (equal (string-to-char kwd) ?{)
- term (substring term (match-end 0))
- mm (if re-p
- `(string-match ,(substring kwd 1 -1) todo)
- (list 'equal 'todo kwd))
- mm (if minus (list 'not mm) mm))
- (push mm todomatcher))
- (push (if (> (length todomatcher) 1)
- (cons 'and todomatcher)
- (car todomatcher))
- orlist)
- (setq todomatcher nil))
- (setq todomatcher (if (> (length orlist) 1)
- (cons 'or orlist) (car orlist))))
-
- ;; Return the string and lisp forms of the matcher
- (setq matcher (if todomatcher
- (list 'and tagsmatcher todomatcher)
- tagsmatcher))
- (when todo-only
- (setq matcher (list 'and '(member todo org-not-done-keywords)
- matcher)))
- (cons match0 matcher)))
+ (setq tagsmatch (substring match 0 (match-beginning 0)))
+ (setq todomatch (substring match (match-end 0)))
+ (when (string-prefix-p "!" todomatch)
+ (setq org--matcher-tags-todo-only t)
+ (setq todomatch (substring todomatch 1)))
+ (when (string-match "\\`\\s-*\\'" todomatch)
+ (setq todomatch nil)))
+ ;; Only matching tags.
+ (setq tagsmatch match)
+ (setq todomatch nil))
+
+ ;; Make the tags matcher.
+ (when (org-string-nw-p tagsmatch)
+ (let ((orlist nil)
+ (orterms (org-split-string tagsmatch "|"))
+ term)
+ (while (setq term (pop orterms))
+ (while (and (equal (substring term -1) "\\") orterms)
+ (setq term (concat term "|" (pop orterms)))) ;repair bad split.
+ (while (string-match re term)
+ (let* ((rest (substring term (match-end 0)))
+ (minus (and (match-end 1)
+ (equal (match-string 1 term) "-")))
+ (tag (save-match-data
+ (replace-regexp-in-string
+ "\\\\-" "-" (match-string 2 term))))
+ (regexp (eq (string-to-char tag) ?{))
+ (levelp (match-end 4))
+ (propp (match-end 5))
+ (mm
+ (cond
+ (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list))
+ (levelp
+ `(,(org-op-to-function (match-string 3 term))
+ level
+ ,(string-to-number (match-string 4 term))))
+ (propp
+ (let* ((gv (pcase (upcase (match-string 5 term))
+ ("CATEGORY"
+ '(get-text-property (point) 'org-category))
+ ("TODO" 'todo)
+ (p `(org-cached-entry-get nil ,p))))
+ (pv (match-string 7 term))
+ (regexp (eq (string-to-char pv) ?{))
+ (strp (eq (string-to-char pv) ?\"))
+ (timep (string-match-p "^\"[[<].*[]>]\"$" pv))
+ (po (org-op-to-function (match-string 6 term)
+ (if timep 'time strp))))
+ (setq pv (if (or regexp strp) (substring pv 1 -1) pv))
+ (when timep (setq pv (org-matcher-time pv)))
+ (cond ((and regexp (eq po 'org<>))
+ `(not (string-match ,pv (or ,gv ""))))
+ (regexp `(string-match ,pv (or ,gv "")))
+ (strp `(,po (or ,gv "") ,pv))
+ (t
+ `(,po
+ (string-to-number (or ,gv ""))
+ ,(string-to-number pv))))))
+ (t `(member ,tag tags-list)))))
+ (push (if minus `(not ,mm) mm) tagsmatcher)
+ (setq term rest)))
+ (push `(and ,@tagsmatcher) orlist)
+ (setq tagsmatcher nil))
+ (setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist)))))
+
+ ;; Make the TODO matcher.
+ (when (org-string-nw-p todomatch)
+ (let ((orlist nil))
+ (dolist (term (org-split-string todomatch "|"))
+ (while (string-match re term)
+ (let* ((minus (and (match-end 1)
+ (equal (match-string 1 term) "-")))
+ (kwd (match-string 2 term))
+ (regexp (eq (string-to-char kwd) ?{))
+ (mm (if regexp `(string-match ,(substring kwd 1 -1) todo)
+ `(equal todo ,kwd))))
+ (push (if minus `(not ,mm) mm) todomatcher))
+ (setq term (substring term (match-end 0))))
+ (push (if (> (length todomatcher) 1)
+ (cons 'and todomatcher)
+ (car todomatcher))
+ orlist)
+ (setq todomatcher nil))
+ (setq todomatcher (cons 'or orlist))))
+
+ ;; Return the string and function of the matcher. If no
+ ;; tags-specific or todo-specific matcher exists, match
+ ;; everything.
+ (let ((matcher (if (and tagsmatcher todomatcher)
+ `(and ,tagsmatcher ,todomatcher)
+ (or tagsmatcher todomatcher t))))
+ (when org--matcher-tags-todo-only
+ (setq matcher `(and (member todo org-not-done-keywords) ,matcher)))
+ (cons match0 `(lambda (todo tags-list level) ,matcher)))))
(defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded)
"Expand group tags in MATCH.
@@ -14639,7 +14745,7 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(modify-syntax-entry ?_ "w" stable)
;; Temporarily replace regexp-expressions in the match-expression.
(while (string-match "{.+?}" return-match)
- (incf count)
+ (cl-incf count)
(push (match-string 0 return-match) regexps-in-match)
(setq return-match (replace-match (format "<%d>" count) t nil return-match)))
(while (and taggroups-keys
@@ -14725,7 +14831,7 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(setq return-match (replace-regexp-in-string (format "<%d>" count)
(pop regexps-in-match)
return-match t t))
- (decf count))
+ (cl-decf count))
(if single-as-list
(if tags-in-group tags-in-group (list return-match))
return-match))
@@ -14798,7 +14904,7 @@ epoch to the beginning of today (00:00)."
(defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param
(defvar org-tags-overlay (make-overlay 1 1))
-(org-detach-overlay org-tags-overlay)
+(delete-overlay org-tags-overlay)
(defun org-get-local-tags-at (&optional pos)
"Get a list of tags defined in the current headline."
@@ -14832,10 +14938,9 @@ ignore inherited ones."
(org-back-to-heading t)
(while (not (equal lastpos (point)))
(setq lastpos (point))
- (when (looking-at
- (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$"))
+ (when (looking-at ".+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")
(setq ltags (org-split-string
- (org-match-string-no-properties 1) ":"))
+ (match-string-no-properties 1) ":"))
(when parent
(setq ltags (mapcar 'org-add-prop-inherited ltags)))
(setq tags (append
@@ -14844,7 +14949,7 @@ ignore inherited ones."
ltags)
tags)))
(or org-use-tag-inheritance (throw 'done t))
- (if local (throw 'done t))
+ (when local (throw 'done t))
(or (org-up-heading-safe) (error nil))
(setq parent t)))
(error nil)))))
@@ -14866,7 +14971,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
(let (res current)
(save-excursion
(org-back-to-heading t)
- (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$")
+ (if (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$"
(point-at-eol) t)
(progn
(setq current (match-string 1))
@@ -14892,29 +14997,24 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
(run-hooks 'org-after-tags-change-hook))
res))
-(defun org-align-tags-here (to-col)
- ;; Assumes that this is a headline
- "Align tags on the current headline to TO-COL."
- (let ((pos (point)) (col (current-column)) ncol tags-l p)
- (beginning-of-line 1)
- (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
- (< pos (match-beginning 2)))
- (progn
- (setq tags-l (- (match-end 2) (match-beginning 2)))
- (goto-char (match-beginning 1))
- (insert " ")
- (delete-region (point) (1+ (match-beginning 2)))
- (setq ncol (max (current-column)
- (1+ col)
- (if (> to-col 0)
- to-col
- (- (abs to-col) tags-l))))
- (setq p (point))
- (insert (make-string (- ncol (current-column)) ?\ ))
- (setq ncol (current-column))
- (when indent-tabs-mode (tabify p (point-at-eol)))
- (org-move-to-column (min ncol col)))
- (goto-char pos))))
+(defun org--align-tags-here (to-col)
+ "Align tags on the current headline to TO-COL.
+Assume point is on a headline."
+ (let ((pos (point)))
+ (beginning-of-line)
+ (if (or (not (looking-at ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
+ (>= pos (match-beginning 2)))
+ ;; No tags or point within tags: do not align.
+ (goto-char pos)
+ (goto-char (match-beginning 1))
+ (let ((shift (max (- (if (>= to-col 0) to-col
+ (- (abs to-col) (string-width (match-string 2))))
+ (current-column))
+ 1)))
+ (replace-match (make-string shift ?\s) nil nil nil 1)
+ ;; Preserve initial position, if possible. In any case, stop
+ ;; before tags.
+ (when (< pos (point)) (goto-char pos))))))
(defun org-set-tags-command (&optional arg just-align)
"Call the set-tags command for the current entry."
@@ -14944,7 +15044,8 @@ If DATA is nil or the empty string, any tags will be removed."
(when data
(save-excursion
(org-back-to-heading t)
- (when (looking-at org-complex-heading-regexp)
+ (when (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
(if (match-end 5)
(progn
(goto-char (match-beginning 5))
@@ -14955,11 +15056,11 @@ If DATA is nil or the empty string, any tags will be removed."
(insert " " data)
(org-set-tags nil 'align)))
(beginning-of-line 1)
- (if (looking-at ".*?\\([ \t]+\\)$")
- (delete-region (match-beginning 1) (match-end 1))))))
+ (when (looking-at ".*?\\([ \t]+\\)$")
+ (delete-region (match-beginning 1) (match-end 1))))))
(defun org-align-all-tags ()
- "Align the tags i all headings."
+ "Align the tags in all headings."
(interactive)
(save-excursion
(or (ignore-errors (org-back-to-heading t))
@@ -14990,27 +15091,36 @@ When JUST-ALIGN is non-nil, only align tags."
(if arg
(save-excursion
(goto-char (point-min))
- (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
- (while (re-search-forward org-outline-regexp-bol nil t)
- (org-set-tags nil t)
- (end-of-line)))
+ (while (re-search-forward org-outline-regexp-bol nil t)
+ (org-set-tags nil t)
+ (end-of-line))
(message "All tags realigned to column %d" org-tags-column))
(let* ((current (org-get-tags-string))
- (col (current-column))
(tags
(if just-align current
;; Get a new set of tags from the user.
(save-excursion
- (let* ((table
+ (let* ((seen)
+ (table
(setq
org-last-tags-completion-table
- (append
- org-tag-persistent-alist
- (or org-tag-alist (org-get-buffer-tags))
- (and
- org-complete-tags-always-offer-all-agenda-tags
- (org-global-tags-completion-table
- (org-agenda-files))))))
+ ;; Uniquify tags in alists, yet preserve
+ ;; structure (i.e., keywords).
+ (delq nil
+ (mapcar
+ (lambda (pair)
+ (let ((head (car pair)))
+ (cond ((symbolp head) pair)
+ ((member head seen) nil)
+ (t (push head seen)
+ pair))))
+ (append
+ (or org-current-tag-alist
+ (org-get-buffer-tags))
+ (and
+ org-complete-tags-always-offer-all-agenda-tags
+ (org-global-tags-completion-table
+ (org-agenda-files))))))))
(current-tags (org-split-string current ":"))
(inherited-tags
(nreverse (nthcdr (length current-tags)
@@ -15037,51 +15147,48 @@ When JUST-ALIGN is non-nil, only align tags."
(setq tags
(mapconcat
#'identity
- (sort (org-split-string tags (org-re "[^[:alnum:]_@#%]+"))
+ (sort (org-split-string tags "[^[:alnum:]_@#%]+")
org-tags-sort-function)
":")))
(if (not (org-string-nw-p tags)) (setq tags "")
- (unless (string-match ":\\'" tags) (setq tags (concat tags ":")))
- (unless (string-match "\\`:" tags) (setq tags (concat ":" tags))))
+ (unless (string-suffix-p ":" tags) (setq tags (concat tags ":")))
+ (unless (string-prefix-p ":" tags) (setq tags (concat ":" tags))))
- ;; Insert new tags at the correct column
- (beginning-of-line)
- (let ((level (if (looking-at org-outline-regexp)
- (- (match-end 0) (point) 1)
- 1)))
- (cond
- ((and (equal current "") (equal tags "")))
- ((re-search-forward
- (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
- (line-end-position)
- t)
- (if (equal tags "") (replace-match "" t t)
- (goto-char (match-beginning 0))
- (let* ((c0 (current-column))
- ;; Compute offset for the case of org-indent-mode
- ;; active.
- (di (if (org-bound-and-true-p org-indent-mode)
+ ;; Insert new tags at the correct column.
+ (unless (equal current tags)
+ (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
+ ;; Remove current tags, if any.
+ (when (match-end 5) (replace-match "" nil nil nil 5))
+ ;; Insert new tags, if any. Otherwise, remove trailing
+ ;; white spaces.
+ (end-of-line)
+ (if (not (equal tags ""))
+ (insert " " tags)
+ (skip-chars-backward " \t")
+ (delete-region (point) (line-end-position)))))
+ ;; Align tags, if any. Fix tags column if `org-indent-mode'
+ ;; is on.
+ (unless (equal tags "")
+ (let* ((level (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward "\\*")))
+ (offset (if (bound-and-true-p org-indent-mode)
(* (1- org-indent-indentation-per-level)
(1- level))
0))
- (p0 (if (eq (char-before) ?*) (1+ (point)) (point)))
- (tc (+ org-tags-column
- (if (> org-tags-column 0) (- di) di)))
- (c1 (max (1+ c0)
- (if (> tc 0) tc
- (- (- tc) (string-width tags)))))
- (rpl (concat (make-string (max 0 (- c1 c0)) ?\s) tags)))
- (replace-match rpl t t)
- (when (and (not (featurep 'xemacs)) indent-tabs-mode)
- (tabify p0 (point))))))
- (t (error "Tags alignment failed"))))
- (org-move-to-column col))
+ (tags-column
+ (+ org-tags-column
+ (if (> org-tags-column 0) (- offset) offset))))
+ (org--align-tags-here tags-column))))
(unless just-align (run-hooks 'org-after-tags-change-hook))))))
(defun org-change-tag-in-region (beg end tag off)
"Add or remove TAG for each entry in the region.
-This works in the agenda, and also in an org-mode buffer."
+This works in the agenda, and also in an Org buffer."
(interactive
(list (region-beginning) (region-end)
(let ((org-last-tags-completion-table
@@ -15090,37 +15197,37 @@ This works in the agenda, and also in an org-mode buffer."
(delq nil (append (org-get-buffer-tags)
(org-global-tags-completion-table))))
(org-global-tags-completion-table))))
- (org-icompleting-read
+ (completing-read
"Tag: " 'org-tags-completion-function nil nil nil
'org-tags-history))
(progn
(message "[s]et or [r]emove? ")
(equal (read-char-exclusive) ?r))))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (when (fboundp 'deactivate-mark) (deactivate-mark))
(let ((agendap (equal major-mode 'org-agenda-mode))
l1 l2 m buf pos newhead (cnt 0))
(goto-char end)
(setq l2 (1- (org-current-line)))
(goto-char beg)
(setq l1 (org-current-line))
- (loop for l from l1 to l2 do
- (org-goto-line l)
- (setq m (get-text-property (point) 'org-hd-marker))
- (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
- (and agendap m))
- (setq buf (if agendap (marker-buffer m) (current-buffer))
- pos (if agendap m (point)))
- (with-current-buffer buf
- (save-excursion
- (save-restriction
- (goto-char pos)
- (setq cnt (1+ cnt))
- (org-toggle-tag tag (if off 'off 'on))
- (setq newhead (org-get-heading)))))
- (and agendap (org-agenda-change-all-lines newhead m))))
+ (cl-loop for l from l1 to l2 do
+ (org-goto-line l)
+ (setq m (get-text-property (point) 'org-hd-marker))
+ (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
+ (and agendap m))
+ (setq buf (if agendap (marker-buffer m) (current-buffer))
+ pos (if agendap m (point)))
+ (with-current-buffer buf
+ (save-excursion
+ (save-restriction
+ (goto-char pos)
+ (setq cnt (1+ cnt))
+ (org-toggle-tag tag (if off 'off 'on))
+ (setq newhead (org-get-heading)))))
+ (and agendap (org-agenda-change-all-lines newhead m))))
(message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
-(defun org-tags-completion-function (string predicate &optional flag)
+(defun org-tags-completion-function (string _predicate &optional flag)
(let (s1 s2 rtn (ctable org-last-tags-completion-table)
(confirm (lambda (x) (stringp (car x)))))
(if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
@@ -15131,12 +15238,12 @@ This works in the agenda, and also in an org-mode buffer."
((eq flag nil)
;; try completion
(setq rtn (try-completion s2 ctable confirm))
- (if (stringp rtn)
- (setq rtn
- (concat s1 s2 (substring rtn (length s2))
- (if (and org-add-colon-after-tag-completion
- (assoc rtn ctable))
- ":" ""))))
+ (when (stringp rtn)
+ (setq rtn
+ (concat s1 s2 (substring rtn (length s2))
+ (if (and org-add-colon-after-tag-completion
+ (assoc rtn ctable))
+ ":" ""))))
rtn)
((eq flag t)
;; all-completions
@@ -15155,8 +15262,8 @@ Also insert END."
(defun org-fast-tag-show-exit (flag)
(save-excursion
(org-goto-line 3)
- (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
- (replace-match ""))
+ (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
+ (replace-match ""))
(when flag
(end-of-line 1)
(org-move-to-column (- (window-width) 19) t)
@@ -15165,11 +15272,8 @@ Also insert END."
(defun org-set-current-tags-overlay (current prefix)
"Add an overlay to CURRENT tag with PREFIX."
(let ((s (concat ":" (mapconcat 'identity current ":") ":")))
- (if (featurep 'xemacs)
- (org-overlay-display org-tags-overlay (concat prefix s)
- 'secondary-selection)
- (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
- (org-overlay-display org-tags-overlay (concat prefix s)))))
+ (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
+ (org-overlay-display org-tags-overlay (concat prefix s))))
(defvar org-last-tag-selection-key nil)
(defun org-fast-tag-selection (current inherited table &optional todo-table)
@@ -15199,8 +15303,7 @@ Returns the new tags string, or nil to not change the current settings."
groups ingroup intaggroup)
(save-excursion
(beginning-of-line 1)
- (if (looking-at
- (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
+ (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
(setq ov-start (match-beginning 1)
ov-end (match-end 1)
ov-prefix "")
@@ -15221,7 +15324,7 @@ Returns the new tags string, or nil to not change the current settings."
(set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
(org-switch-to-buffer-other-window " *Org tags*"))
(erase-buffer)
- (org-set-local 'org-done-keywords done-keywords)
+ (setq-local org-done-keywords done-keywords)
(org-fast-tag-insert "Inherited" inherited i-face "\n")
(org-fast-tag-insert "Current" current c-face "\n\n")
(org-fast-tag-show-exit exit-after-next)
@@ -15282,7 +15385,7 @@ Returns the new tags string, or nil to not change the current settings."
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
- (when (= (incf cnt) ncol)
+ (when (= (cl-incf cnt) ncol)
(insert "\n")
(when (or ingroup intaggroup) (insert " "))
(setq cnt 0)))))
@@ -15315,14 +15418,14 @@ Returns the new tags string, or nil to not change the current settings."
(org-fit-window-to-buffer)))
((or (= c ?\C-g)
(and (= c ?q) (not (rassoc c ntable))))
- (org-detach-overlay org-tags-overlay)
+ (delete-overlay org-tags-overlay)
(setq quit-flag t))
((= c ?\ )
(setq current nil)
(when exit-after-next (setq exit-after-next 'now)))
((= c ?\t)
(condition-case nil
- (setq tg (org-icompleting-read
+ (setq tg (completing-read
"Tag: "
(or buffer-tags
(with-current-buffer buf
@@ -15330,7 +15433,7 @@ Returns the new tags string, or nil to not change the current settings."
(org-get-buffer-tags))))))
(quit (setq tg "")))
(when (string-match "\\S-" tg)
- (add-to-list 'buffer-tags (list tg))
+ (cl-pushnew (list tg) buffer-tags :test #'equal)
(if (member tg current)
(setq current (delete tg current))
(push tg current)))
@@ -15342,9 +15445,9 @@ Returns the new tags string, or nil to not change the current settings."
((setq e (rassoc c ntable) tg (car e))
(if (member tg current)
(setq current (delete tg current))
- (loop for g in groups do
- (when (member tg g)
- (dolist (x g) (setq current (delete x current)))))
+ (cl-loop for g in groups do
+ (when (member tg g)
+ (dolist (x g) (setq current (delete x current)))))
(push tg current))
(when exit-after-next (setq exit-after-next 'now))))
@@ -15359,8 +15462,7 @@ Returns the new tags string, or nil to not change the current settings."
(delete-region (point) (point-at-eol))
(org-fast-tag-insert "Current" current c-face)
(org-set-current-tags-overlay current ov-prefix)
- (while (re-search-forward
- (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t)
+ (while (re-search-forward "\\[.\\] \\([[:alnum:]_@#%]+\\)" nil t)
(setq tg (match-string 1))
(add-text-properties
(match-beginning 1) (match-end 1)
@@ -15370,7 +15472,7 @@ Returns the new tags string, or nil to not change the current settings."
((member tg inherited) i-face)
(t (get-text-property (match-beginning 1) 'face))))))
(goto-char (point-min)))))
- (org-detach-overlay org-tags-overlay)
+ (delete-overlay org-tags-overlay)
(if rtn
(mapconcat 'identity current ":")
nil))))
@@ -15381,8 +15483,8 @@ Returns the new tags string, or nil to not change the current settings."
(user-error "Not on a heading"))
(save-excursion
(beginning-of-line 1)
- (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
- (org-match-string-no-properties 1)
+ (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (match-string-no-properties 1)
"")))
(defun org-get-tags ()
@@ -15394,16 +15496,17 @@ Returns the new tags string, or nil to not change the current settings."
(org-with-wide-buffer
(goto-char (point-min))
(let ((tag-re (concat org-outline-regexp-bol
- "\\(?:.*?[ \t]\\)?"
- (org-re ":\\([[:alnum:]_@#%:]+\\):[ \t]*$")))
+ "\\(?:.*?[ \t]\\)?:\\([[:alnum:]_@#%:]+\\):[ \t]*$"))
tags)
(while (re-search-forward tag-re nil t)
- (dolist (tag (org-split-string (org-match-string-no-properties 1) ":"))
+ (dolist (tag (org-split-string (match-string-no-properties 1) ":"))
(push tag tags)))
(mapcar #'list (append org-file-tags (org-uniquify tags))))))
;;;; The mapping API
+(defvar org-agenda-skip-comment-trees)
+(defvar org-agenda-skip-function)
(defun org-map-entries (func &optional match scope &rest skip)
"Call FUNC at each headline selected by MATCH in SCOPE.
@@ -15473,12 +15576,12 @@ a *different* entry, you cannot use these techniques."
(car (org-delete-all '(comment archive) skip)))
(org-tags-match-list-sublevels t)
(start-level (eq scope 'region-start-level))
- matcher file res
+ matcher res
org-todo-keywords-for-agenda
org-done-keywords-for-agenda
org-todo-keyword-alist-for-agenda
org-tag-alist-for-agenda
- todo-only)
+ org--matcher-tags-todo-only)
(cond
((eq match t) (setq matcher t))
@@ -15511,7 +15614,9 @@ a *different* entry, you cannot use these techniques."
(progn
(org-agenda-prepare-buffers
(and buffer-file-name (list buffer-file-name)))
- (setq res (org-scan-tags func matcher todo-only start-level)))
+ (setq res
+ (org-scan-tags
+ func matcher org--matcher-tags-todo-only start-level)))
;; Get the right scope
(cond
((and scope (listp scope) (symbolp (car scope)))
@@ -15528,11 +15633,13 @@ a *different* entry, you cannot use these techniques."
(org-agenda-prepare-buffers scope)
(dolist (file scope)
(with-current-buffer (org-find-base-buffer-visiting file)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (setq res (append res (org-scan-tags func matcher todo-only))))))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (setq res
+ (append
+ res
+ (org-scan-tags
+ func matcher org--matcher-tags-todo-only)))))))))
res)))
;;; Properties API
@@ -15559,7 +15666,7 @@ Being in this list makes sure that they are offered for completion.")
"Non nil when string PROPERTY is a valid property name."
(not
(or (equal property "")
- (org-string-match-p "\\s-" property))))
+ (string-match-p "\\s-" property))))
(defun org--update-property-plist (key val props)
"Associate KEY to VAL in alist PROPS.
@@ -15586,7 +15693,7 @@ return nil."
(org-back-to-heading t))
(t (org-with-limited-levels (org-back-to-heading t))))))
(forward-line)
- (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at-p org-planning-line-re) (forward-line))
(cond ((looking-at org-property-drawer-re)
(forward-line)
(cons (point) (progn (goto-char (match-end 0))
@@ -15615,7 +15722,7 @@ See `org-property-re' for match data, if applicable."
(unless (org-at-property-p) (user-error "Not at a property"))
(message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
(let ((c (read-char-exclusive)))
- (case c
+ (cl-case c
(?s (call-interactively #'org-set-property))
(?d (call-interactively #'org-delete-property))
(?D (call-interactively #'org-delete-property-globally))
@@ -15636,7 +15743,7 @@ With numerical prefix arg, use the nth allowed value, 0 stands for the
When INCREMENT is non-nil, set the property to the next allowed value."
(interactive "P")
- (if (equal value 0) (setq value 10))
+ (when (equal value 0) (setq value 10))
(let* ((completion-ignore-case t)
(prop org-effort-property)
(cur (org-entry-get nil prop))
@@ -15650,7 +15757,7 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(or (car (nth (1- value) allowed))
(car (org-last allowed))))
((and allowed increment)
- (or (caadr (member (list cur) allowed))
+ (or (cl-caadr (member (list cur) allowed))
(user-error "Allowed effort values are not set")))
(allowed
(message "Select 1-9,0, [RET%s]: %s"
@@ -15660,24 +15767,23 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(if (equal rpl ?\r)
cur
(setq rpl (- rpl ?0))
- (if (equal rpl 0) (setq rpl 10))
+ (when (equal rpl 0) (setq rpl 10))
(if (and (> rpl 0) (<= rpl (length allowed)))
(car (nth (1- rpl) allowed))
(org-completing-read "Effort: " allowed nil))))
(t
- (let (org-completion-use-ido org-completion-use-iswitchb)
- (org-completing-read
- (concat "Effort " (if (and cur (string-match "\\S-" cur))
- (concat "[" cur "]") "")
- ": ")
- existing nil nil "" nil cur))))))
+ (org-completing-read
+ (concat "Effort" (and cur (string-match "\\S-" cur)
+ (concat " [" cur "]"))
+ ": ")
+ existing nil nil "" nil cur)))))
(unless (equal (org-entry-get nil prop) val)
(org-entry-put nil prop val))
(org-refresh-property
'((effort . identity)
(effort-minutes . org-duration-string-to-minutes))
val)
- (when (string= heading org-clock-current-task)
+ (when (equal heading (bound-and-true-p org-clock-current-task))
(setq org-clock-effort (get-text-property (point-at-bol) 'effort))
(org-clock-update-mode-line))
(message "%s is now %s" prop val)))
@@ -15714,8 +15820,7 @@ strings."
(let ((clocksum (get-text-property (point) :org-clock-minutes)))
(when clocksum
(push (cons "CLOCKSUM"
- (org-columns-number-to-string
- (/ (float clocksum) 60.) 'add_times))
+ (org-minutes-to-clocksum-string clocksum))
props)))
(when specific (throw 'exit props)))
(when (or (not specific) (string= specific "CLOCKSUM_T"))
@@ -15723,29 +15828,28 @@ strings."
:org-clock-minutes-today)))
(when clocksumt
(push (cons "CLOCKSUM_T"
- (org-columns-number-to-string
- (/ (float clocksumt) 60.) 'add_times))
+ (org-minutes-to-clocksum-string clocksumt))
props)))
(when specific (throw 'exit props)))
(when (or (not specific) (string= specific "ITEM"))
- (when (looking-at org-complex-heading-regexp)
- (push (cons "ITEM"
- (concat
- (org-match-string-no-properties 1)
- (let ((title (org-match-string-no-properties 4)))
- (when (org-string-nw-p title)
- (concat " " (org-remove-tabs title))))))
- props))
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (push (cons "ITEM"
+ (let ((title (match-string-no-properties 4)))
+ (if (org-string-nw-p title)
+ (org-remove-tabs title)
+ "")))
+ props)))
(when specific (throw 'exit props)))
(when (or (not specific) (string= specific "TODO"))
(let ((case-fold-search nil))
(when (and (looking-at org-todo-line-regexp) (match-end 2))
- (push (cons "TODO" (org-match-string-no-properties 2)) props)))
+ (push (cons "TODO" (match-string-no-properties 2)) props)))
(when specific (throw 'exit props)))
(when (or (not specific) (string= specific "PRIORITY"))
(push (cons "PRIORITY"
(if (looking-at org-priority-regexp)
- (org-match-string-no-properties 2)
+ (match-string-no-properties 2)
(char-to-string org-default-priority)))
props)
(when specific (throw 'exit props)))
@@ -15770,7 +15874,7 @@ strings."
(when (or (not specific)
(member specific '("CLOSED" "DEADLINE" "SCHEDULED")))
(forward-line)
- (when (org-looking-at-p org-planning-line-re)
+ (when (looking-at-p org-planning-line-re)
(end-of-line)
(let ((bol (line-beginning-position))
;; Backward compatibility: time keywords used to
@@ -15787,14 +15891,17 @@ strings."
(skip-chars-forward " \t")
(and (looking-at org-ts-regexp-both)
(push (cons (car pair)
- (org-match-string-no-properties 0))
+ (match-string-no-properties 0))
props)))))))
(when specific (throw 'exit props)))
(when (or (not specific)
(member specific '("TIMESTAMP" "TIMESTAMP_IA")))
(let ((find-ts
(lambda (end ts)
- (let ((regexp (cond
+ ;; Fix next time-stamp before END. TS is the
+ ;; list of time-stamps found so far.
+ (let ((ts ts)
+ (regexp (cond
((string= specific "TIMESTAMP")
org-ts-regexp)
((string= specific "TIMESTAMP_IA")
@@ -15842,7 +15949,7 @@ strings."
(forward-line)
;; Then find timestamps in the section, skipping
;; planning line.
- (when (org-looking-at-p org-planning-line-re)
+ (when (looking-at-p org-planning-line-re)
(forward-line))
(let ((end (save-excursion (outline-next-heading))))
(setq props (nconc (funcall find-ts end ts) props))))))))
@@ -15864,10 +15971,10 @@ strings."
;; after its extension. We also forbid standard
;; properties to be named as special properties.
(while (re-search-forward org-property-re end t)
- (let* ((key (upcase (org-match-string-no-properties 2)))
- (extendp (org-string-match-p "\\+\\'" key))
+ (let* ((key (upcase (match-string-no-properties 2)))
+ (extendp (string-match-p "\\+\\'" key))
(key-base (if extendp (substring key 0 -1) key))
- (value (org-match-string-no-properties 3)))
+ (value (match-string-no-properties 3)))
(cond
((member-ignore-case key-base org-special-properties))
(extendp
@@ -15886,7 +15993,7 @@ strings."
(defun org-property--local-values (property literal-nil)
"Return value for PROPERTY in current entry.
-Value is a list whose care is the base value for PROPERTY and cdr
+Value is a list whose car is the base value for PROPERTY and cdr
a list of accumulated values. Return nil if neither is found in
the entry. Also return nil when PROPERTY is set to \"nil\",
unless LITERAL-NIL is non-nil."
@@ -15900,12 +16007,12 @@ unless LITERAL-NIL is non-nil."
(save-excursion
(let ((v (and (re-search-forward
(org-re-property property nil t) end t)
- (org-match-string-no-properties 3))))
+ (match-string-no-properties 3))))
(list (if literal-nil v (org-not-nil v)))))))
;; Find additional values.
(let* ((property+ (org-re-property (concat property "+") nil t)))
(while (re-search-forward property+ end t)
- (push (org-match-string-no-properties 3) value)))
+ (push (match-string-no-properties 3) value)))
;; Return final values.
(and (not (equal value '(nil))) (nreverse value))))))
@@ -16113,7 +16220,7 @@ decreases scheduled or deadline date by one day."
(org-set-tags nil 'align))
((equal property "SCHEDULED")
(forward-line)
- (if (and (org-looking-at-p org-planning-line-re)
+ (if (and (looking-at-p org-planning-line-re)
(re-search-forward
org-scheduled-time-regexp (line-end-position) t))
(cond ((string= value "earlier") (org-timestamp-change -1 'day))
@@ -16125,7 +16232,7 @@ decreases scheduled or deadline date by one day."
(org-schedule nil value))))
((equal property "DEADLINE")
(forward-line)
- (if (and (org-looking-at-p org-planning-line-re)
+ (if (and (looking-at-p org-planning-line-re)
(re-search-forward
org-deadline-time-regexp (line-end-position) t))
(cond ((string= value "earlier") (org-timestamp-change -1 'day))
@@ -16153,7 +16260,8 @@ decreases scheduled or deadline date by one day."
(org-indent-line)))))
(run-hook-with-args 'org-property-changed-functions property value)))
-(defun org-buffer-property-keys (&optional specials defaults columns)
+(defun org-buffer-property-keys
+ (&optional specials defaults columns ignore-malformed)
"Get all property keys in the current buffer.
When SPECIALS is non-nil, also list the special properties that
@@ -16164,7 +16272,10 @@ special meaning internally: ARCHIVE, CATEGORY, SUMMARY,
DESCRIPTION, LOCATION, and LOGGING and others.
When COLUMNS in non-nil, also include property names given in
-COLUMN formats in the current buffer."
+COLUMN formats in the current buffer.
+
+When IGNORE-MALFORMED is non-nil, malformed drawer repair will not be
+automatically performed, such drawers will be silently ignored."
(let ((case-fold-search t)
(props (append
(and specials org-special-properties)
@@ -16176,7 +16287,8 @@ COLUMN formats in the current buffer."
(let ((range (org-get-property-block)))
(catch 'skip
(unless range
- (when (and (not (org-before-first-heading-p))
+ (when (and (not ignore-malformed)
+ (not (org-before-first-heading-p))
(y-or-n-p (format "Malformed drawer at %d, repair?"
(line-beginning-position))))
(org-get-property-block nil t))
@@ -16201,11 +16313,11 @@ COLUMN formats in the current buffer."
(if (< begin (point)) (throw 'skip nil) (goto-char begin))
(while (< (point) end)
(let ((p (progn (looking-at org-property-re)
- (org-match-string-no-properties 2))))
+ (match-string-no-properties 2))))
;; Only add true property name, not extension symbol.
- (add-to-list 'props
- (if (not (org-string-match-p "\\+\\'" p)) p
- (substring p 0 -1))))
+ (push (if (not (string-match-p "\\+\\'" p)) p
+ (substring p 0 -1))
+ props))
(forward-line))))
(outline-next-heading)))
(when columns
@@ -16217,10 +16329,10 @@ COLUMN formats in the current buffer."
(start 0))
(while (string-match "%[0-9]*\\(\\S-+\\)" value start)
(setq start (match-end 0))
- (let ((p (org-match-string-no-properties 1 value)))
+ (let ((p (match-string-no-properties 1 value)))
(unless (member-ignore-case p org-special-properties)
- (add-to-list 'props p))))))))))
- (sort props (lambda (a b) (string< (upcase a) (upcase b))))))
+ (push p props))))))))))
+ (sort (delete-dups props) (lambda (a b) (string< (upcase a) (upcase b))))))
(defun org-property-values (key)
"List all non-nil values of property KEY in current buffer."
@@ -16230,8 +16342,8 @@ COLUMN formats in the current buffer."
(re (org-re-property key))
values)
(while (re-search-forward re nil t)
- (add-to-list 'values (org-entry-get (point) key)))
- values)))
+ (push (org-entry-get (point) key) values))
+ (delete-dups values))))
(defun org-insert-property-drawer ()
"Insert a property drawer into the current entry."
@@ -16240,8 +16352,8 @@ COLUMN formats in the current buffer."
(org-back-to-heading t)
(org-with-limited-levels (org-back-to-heading t)))
(forward-line)
- (when (org-looking-at-p org-planning-line-re) (forward-line))
- (unless (org-looking-at-p org-property-drawer-re)
+ (when (looking-at-p org-planning-line-re) (forward-line))
+ (unless (looking-at-p org-property-drawer-re)
;; Make sure we start editing a line from current entry, not from
;; next one. It prevents extending text properties or overlays
;; belonging to the latter.
@@ -16271,7 +16383,7 @@ Point is left between drawer's boundaries."
;; With C-u, fall back on `org-insert-property-drawer'
(arg (org-insert-property-drawer))
;; Check validity of suggested drawer's name.
- ((not (org-string-match-p org-drawer-regexp (format ":%s:" drawer)))
+ ((not (string-match-p org-drawer-regexp (format ":%s:" drawer)))
(user-error "Invalid drawer name"))
;; With an active region, insert a drawer at point.
((not (org-region-active-p))
@@ -16338,10 +16450,9 @@ This is computed according to `org-property-set-functions-alist'."
(funcall set-function prompt allowed nil
(not (get-text-property 0 'org-unrestricted
(caar allowed))))
- (let (org-completion-use-ido org-completion-use-iswitchb)
- (funcall set-function prompt
- (mapcar 'list (org-property-values property))
- nil nil "" nil cur)))))
+ (funcall set-function prompt
+ (mapcar 'list (org-property-values property))
+ nil nil "" nil cur))))
(org-trim val)))
(defvar org-last-set-property nil)
@@ -16350,7 +16461,7 @@ This is computed according to `org-property-set-functions-alist'."
"Read a property name."
(let ((completion-ignore-case t)
(default-prop (or (and (org-at-property-p)
- (org-match-string-no-properties 2))
+ (match-string-no-properties 2))
org-last-set-property)))
(org-completing-read
(concat "Property"
@@ -16431,7 +16542,7 @@ part of the buffer."
(props (if cat props0
(delete `("CATEGORY" . ,(org-get-category)) props0)))
(prop (if (< 1 (length props))
- (org-icompleting-read "Property: " props nil t)
+ (completing-read "Property: " props nil t)
(caar props))))
(list prop)))
(if (not property)
@@ -16444,7 +16555,7 @@ part of the buffer."
This function ignores narrowing, if any."
(interactive
(let* ((completion-ignore-case t)
- (prop (org-icompleting-read
+ (prop (completing-read
"Globally remove property: "
(mapcar #'list (org-buffer-property-keys)))))
(list prop)))
@@ -16453,7 +16564,7 @@ This function ignores narrowing, if any."
(let ((count 0)
(re (org-re-property (concat (regexp-quote property) "\\+?") t t)))
(while (re-search-forward re nil t)
- (when (org-entry-delete (point) property) (incf count)))
+ (when (org-entry-delete (point) property) (cl-incf count)))
(message "Property \"%s\" removed from %d entries" property count))))
(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
@@ -16465,9 +16576,9 @@ then applies it to the property in the column format's scope."
(interactive)
(unless (org-at-property-p)
(user-error "Not at a property"))
- (let ((prop (org-match-string-no-properties 2)))
+ (let ((prop (match-string-no-properties 2)))
(org-columns-get-format-and-top-level)
- (unless (nth 3 (assoc prop org-columns-current-fmt-compiled))
+ (unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t))
(user-error "No operator defined for property %s" prop))
(org-columns-compute prop)))
@@ -16513,7 +16624,7 @@ completion."
(org-add-props (car vals) '(org-unrestricted t)))
(if table (mapcar 'list vals) vals)))
-(defun org-property-previous-allowed-value (&optional previous)
+(defun org-property-previous-allowed-value (&optional _previous)
"Switch to the next allowed value for this property."
(interactive)
(org-property-next-allowed-value t))
@@ -16533,12 +16644,12 @@ completion."
nval)
(unless allowed
(user-error "Allowed values for this property have not been defined"))
- (if previous (setq allowed (reverse allowed)))
- (if (member value allowed)
- (setq nval (car (cdr (member value allowed)))))
+ (when previous (setq allowed (reverse allowed)))
+ (when (member value allowed)
+ (setq nval (car (cdr (member value allowed)))))
(setq nval (or nval (car allowed)))
- (if (equal nval value)
- (user-error "Only one allowed value for this property"))
+ (when (equal nval value)
+ (user-error "Only one allowed value for this property"))
(org-at-property-p)
(replace-match (concat " :" key ": " nval) t t)
(org-indent-line)
@@ -16573,31 +16684,28 @@ only headings."
(level 1)
(lmin 1)
(lmax 1)
- limit re end found pos heading cnt flevel)
+ end found flevel)
(unless buffer (error "File not found :%s" file))
(with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (setq limit (point-max))
- (goto-char (point-min))
- (dolist (heading path)
- (setq re (format org-complex-heading-regexp-format
- (regexp-quote heading)))
- (setq cnt 0 pos (point))
- (while (re-search-forward re end t)
- (setq level (- (match-end 1) (match-beginning 1)))
- (if (and (>= level lmin) (<= level lmax))
- (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
- (when (= cnt 0) (error "Heading not found on level %d: %s"
- lmax heading))
- (when (> cnt 1) (error "Heading not unique on level %d: %s"
- lmax heading))
- (goto-char found)
- (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
- (setq end (save-excursion (org-end-of-subtree t t))))
- (when (org-at-heading-p)
- (point-marker)))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (dolist (heading path)
+ (let ((re (format org-complex-heading-regexp-format
+ (regexp-quote heading)))
+ (cnt 0))
+ (while (re-search-forward re end t)
+ (setq level (- (match-end 1) (match-beginning 1)))
+ (when (and (>= level lmin) (<= level lmax))
+ (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
+ (when (= cnt 0)
+ (error "Heading not found on level %d: %s" lmax heading))
+ (when (> cnt 1)
+ (error "Heading not unique on level %d: %s" lmax heading))
+ (goto-char found)
+ (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
+ (setq end (save-excursion (org-end-of-subtree t t)))))
+ (when (org-at-heading-p)
+ (point-marker))))))
(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
"Find node HEADING in BUFFER.
@@ -16607,17 +16715,15 @@ If POS-ONLY is set, return just the position instead of a marker.
The heading text must match exact, but it may have a TODO keyword,
a priority cookie and tags in the standard locations."
(with-current-buffer (or buffer (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let (case-fold-search)
- (if (re-search-forward
- (format org-complex-heading-regexp-format
- (regexp-quote heading)) nil t)
- (if pos-only
- (match-beginning 0)
- (move-marker (make-marker) (match-beginning 0)))))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (case-fold-search)
+ (when (re-search-forward
+ (format org-complex-heading-regexp-format
+ (regexp-quote heading)) nil t)
+ (if pos-only
+ (match-beginning 0)
+ (move-marker (make-marker) (match-beginning 0))))))))
(defun org-find-exact-heading-in-directory (heading &optional dir)
"Find Org node headline HEADING in all .org files in directory DIR.
@@ -16738,7 +16844,7 @@ non-nil."
(if (not t2)
t1
(setq dh (- h2 h1) dm (- m2 m1))
- (if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
+ (when (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
(concat t1 "+" (number-to-string dh)
(and (/= 0 dm) (format ":%02d" dm)))))))
@@ -16753,7 +16859,7 @@ So these are more for recording a certain time/date."
(defvar org-date-ovl (make-overlay 1 1))
(overlay-put org-date-ovl 'face 'org-date-selected)
-(org-detach-overlay org-date-ovl)
+(delete-overlay org-date-ovl)
(defvar org-ans1) ; dynamically scoped parameter
(defvar org-ans2) ; dynamically scoped parameter
@@ -16775,9 +16881,9 @@ So these are more for recording a certain time/date."
(org-defkey map (kbd ".")
(lambda () (interactive)
;; Are we at the beginning of the prompt?
- (if (org-looking-back "^[^:]+: "
- (let ((inhibit-field-text-motion t))
- (line-beginning-position)))
+ (if (looking-back "^[^:]+: "
+ (let ((inhibit-field-text-motion t))
+ (line-beginning-position)))
(org-eval-in-calendar '(calendar-goto-today))
(insert "."))))
(org-defkey map (kbd "C-.")
@@ -16844,7 +16950,8 @@ So these are more for recording a certain time/date."
(defvar org-defdecode)
(defvar org-with-time)
-(defun org-read-date (&optional org-with-time to-time from-string prompt
+(defvar calendar-setup) ; Dynamically scoped.
+(defun org-read-date (&optional with-time to-time from-string prompt
default-time default-input inactive)
"Read a date, possibly a time, and make things smooth for the user.
The prompt will suggest to enter an ISO date, but you can also enter anything
@@ -16888,8 +16995,8 @@ If you don't like the calendar, turn it off with
With optional argument TO-TIME, the date will immediately be converted
to an internal time.
-With an optional argument ORG-WITH-TIME, the prompt will suggest to
-also insert a time. Note that when ORG-WITH-TIME is not set, you can
+With an optional argument WITH-TIME, the prompt will suggest to
+also insert a time. Note that when WITH-TIME is not set, you can
still enter a time, and this function will inform the calling routine
about this change. The calling routine may then choose to change the
format used to insert the time stamp into the buffer to include the time.
@@ -16898,83 +17005,90 @@ the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
the time/date that is used for everything that is not specified by the
user."
(require 'parse-time)
- (let* ((org-time-stamp-rounding-minutes
- (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
+ (let* ((org-with-time with-time)
+ (org-time-stamp-rounding-minutes
+ (if (equal org-with-time '(16))
+ '(0 0)
+ org-time-stamp-rounding-minutes))
(org-dcst org-display-custom-times)
(ct (org-current-time))
(org-def (or org-overriding-default-time default-time ct))
(org-defdecode (decode-time org-def))
- (dummy (progn
- (when (< (nth 2 org-defdecode) org-extend-today-until)
- (setcar (nthcdr 2 org-defdecode) -1)
- (setcar (nthcdr 1 org-defdecode) 59)
- (setq org-def (apply 'encode-time org-defdecode)
- org-defdecode (decode-time org-def)))))
(cur-frame (selected-frame))
- (mouse-autoselect-window nil) ; Don't let the mouse jump
- (calendar-frame-setup nil)
- (calendar-setup (when (eq calendar-setup 'calendar-only) 'calendar-only))
+ (mouse-autoselect-window nil) ; Don't let the mouse jump
+ (calendar-setup
+ (and (eq calendar-setup 'calendar-only) 'calendar-only))
(calendar-move-hook nil)
(calendar-view-diary-initially-flag nil)
(calendar-view-holidays-initially-flag nil)
- (timestr (format-time-string
- (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def))
- (prompt (concat (if prompt (concat prompt " ") "")
- (format "Date+time [%s]: " timestr)))
ans (org-ans0 "") org-ans1 org-ans2 final cal-frame)
-
- (cond
- (from-string (setq ans from-string))
- (org-read-date-popup-calendar
- (save-excursion
- (save-window-excursion
- (calendar)
- (when (eq calendar-setup 'calendar-only)
- (setq cal-frame
- (window-frame (get-buffer-window "*Calendar*" 'visible)))
- (select-frame cal-frame))
- (org-eval-in-calendar '(setq cursor-type nil) t)
- (unwind-protect
- (progn
- (calendar-forward-day (- (time-to-days org-def)
- (calendar-absolute-from-gregorian
- (calendar-current-date))))
- (org-eval-in-calendar nil t)
- (let* ((old-map (current-local-map))
- (map (copy-keymap calendar-mode-map))
- (minibuffer-local-map
- (copy-keymap org-read-date-minibuffer-local-map)))
- (org-defkey map (kbd "RET") 'org-calendar-select)
- (org-defkey map [mouse-1] 'org-calendar-select-mouse)
- (org-defkey map [mouse-2] 'org-calendar-select-mouse)
- (unwind-protect
- (progn
- (use-local-map map)
- (setq org-read-date-inactive inactive)
- (add-hook 'post-command-hook 'org-read-date-display)
- (setq org-ans0 (read-string prompt default-input
- 'org-read-date-history nil))
- ;; org-ans0: from prompt
- ;; org-ans1: from mouse click
- ;; org-ans2: from calendar motion
- (setq ans (concat org-ans0 " " (or org-ans1 org-ans2))))
- (remove-hook 'post-command-hook 'org-read-date-display)
- (use-local-map old-map)
- (when org-read-date-overlay
- (delete-overlay org-read-date-overlay)
- (setq org-read-date-overlay nil)))))
- (bury-buffer "*Calendar*")
- (when cal-frame
- (delete-frame cal-frame)
- (select-frame-set-input-focus cur-frame))))))
-
- (t ; Naked prompt only
- (unwind-protect
- (setq ans (read-string prompt default-input
- 'org-read-date-history timestr))
- (when org-read-date-overlay
- (delete-overlay org-read-date-overlay)
- (setq org-read-date-overlay nil)))))
+ ;; Rationalize `org-def' and `org-defdecode', if required.
+ (when (< (nth 2 org-defdecode) org-extend-today-until)
+ (setf (nth 2 org-defdecode) -1)
+ (setf (nth 1 org-defdecode) 59)
+ (setq org-def (apply #'encode-time org-defdecode))
+ (setq org-defdecode (decode-time org-def)))
+ (let* ((timestr (format-time-string
+ (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d")
+ org-def))
+ (prompt (concat (if prompt (concat prompt " ") "")
+ (format "Date+time [%s]: " timestr))))
+ (cond
+ (from-string (setq ans from-string))
+ (org-read-date-popup-calendar
+ (save-excursion
+ (save-window-excursion
+ (calendar)
+ (when (eq calendar-setup 'calendar-only)
+ (setq cal-frame
+ (window-frame (get-buffer-window "*Calendar*" 'visible)))
+ (select-frame cal-frame))
+ (org-eval-in-calendar '(setq cursor-type nil) t)
+ (unwind-protect
+ (progn
+ (calendar-forward-day (- (time-to-days org-def)
+ (calendar-absolute-from-gregorian
+ (calendar-current-date))))
+ (org-eval-in-calendar nil t)
+ (let* ((old-map (current-local-map))
+ (map (copy-keymap calendar-mode-map))
+ (minibuffer-local-map
+ (copy-keymap org-read-date-minibuffer-local-map)))
+ (org-defkey map (kbd "RET") 'org-calendar-select)
+ (org-defkey map [mouse-1] 'org-calendar-select-mouse)
+ (org-defkey map [mouse-2] 'org-calendar-select-mouse)
+ (unwind-protect
+ (progn
+ (use-local-map map)
+ (setq org-read-date-inactive inactive)
+ (add-hook 'post-command-hook 'org-read-date-display)
+ (setq org-ans0
+ (read-string prompt
+ default-input
+ 'org-read-date-history
+ nil))
+ ;; org-ans0: from prompt
+ ;; org-ans1: from mouse click
+ ;; org-ans2: from calendar motion
+ (setq ans
+ (concat org-ans0 " " (or org-ans1 org-ans2))))
+ (remove-hook 'post-command-hook 'org-read-date-display)
+ (use-local-map old-map)
+ (when org-read-date-overlay
+ (delete-overlay org-read-date-overlay)
+ (setq org-read-date-overlay nil)))))
+ (bury-buffer "*Calendar*")
+ (when cal-frame
+ (delete-frame cal-frame)
+ (select-frame-set-input-focus cur-frame))))))
+
+ (t ; Naked prompt only
+ (unwind-protect
+ (setq ans (read-string prompt default-input
+ 'org-read-date-history timestr))
+ (when org-read-date-overlay
+ (delete-overlay org-read-date-overlay)
+ (setq org-read-date-overlay nil))))))
(setq final (org-read-date-analyze ans org-def org-defdecode))
@@ -17035,16 +17149,18 @@ user."
(make-overlay (1- (point-at-eol)) (point-at-eol)))
(org-overlay-display org-read-date-overlay txt 'secondary-selection)))))
-(defun org-read-date-analyze (ans org-def org-defdecode)
+(defun org-read-date-analyze (ans def defdecode)
"Analyze the combined answer of the date prompt."
;; FIXME: cleanup and comment
;; Pass `current-time' result to `decode-time' (instead of calling
;; without arguments) so that only `current-time' has to be
;; overriden in tests.
- (let ((nowdecode (decode-time (current-time)))
+ (let ((org-def def)
+ (org-defdecode defdecode)
+ (nowdecode (decode-time (current-time)))
delta deltan deltaw deltadef year month day
hour minute second wday pm h2 m2 tl wday1
- iso-year iso-weekday iso-week iso-year iso-date futurep kill-year)
+ iso-year iso-weekday iso-week iso-date futurep kill-year)
(setq org-read-date-analyze-futurep nil
org-read-date-analyze-forced-year nil)
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
@@ -17060,11 +17176,11 @@ user."
;; info and postpone interpreting it until the rest of the parsing
;; is done.
(when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
- (setq iso-year (if (match-end 1)
- (org-small-year-to-year
- (string-to-number (match-string 1 ans))))
- iso-weekday (if (match-end 3)
- (string-to-number (match-string 3 ans)))
+ (setq iso-year (when (match-end 1)
+ (org-small-year-to-year
+ (string-to-number (match-string 1 ans))))
+ iso-weekday (when (match-end 3)
+ (string-to-number (match-string 3 ans)))
iso-week (string-to-number (match-string 2 ans)))
(setq ans (replace-match "" t t ans)))
@@ -17077,7 +17193,7 @@ user."
(string-to-number (format-time-string "%Y"))))
month (string-to-number (match-string 3 ans))
day (string-to-number (match-string 4 ans)))
- (if (< year 100) (setq year (+ 2000 year)))
+ (setq year (org-small-year-to-year year))
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
t nil ans)))
@@ -17101,26 +17217,26 @@ user."
(string-to-number (format-time-string "%Y"))))
month (string-to-number (match-string 1 ans))
day (string-to-number (match-string 2 ans)))
- (if (< year 100) (setq year (+ 2000 year)))
+ (setq year (org-small-year-to-year year))
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
t nil ans)))
;; Help matching am/pm times, because `parse-time-string' does not do that.
;; If there is a time with am/pm, and *no* time without it, we convert
;; so that matching will be successful.
- (loop for i from 1 to 2 do ; twice, for end time as well
- (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
- (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
- (setq hour (string-to-number (match-string 1 ans))
- minute (if (match-end 3)
- (string-to-number (match-string 3 ans))
- 0)
- pm (equal ?p
- (string-to-char (downcase (match-string 4 ans)))))
- (if (and (= hour 12) (not pm))
- (setq hour 0)
- (if (and pm (< hour 12)) (setq hour (+ 12 hour))))
- (setq ans (replace-match (format "%02d:%02d" hour minute)
- t t ans))))
+ (cl-loop for i from 1 to 2 do ; twice, for end time as well
+ (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
+ (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
+ (setq hour (string-to-number (match-string 1 ans))
+ minute (if (match-end 3)
+ (string-to-number (match-string 3 ans))
+ 0)
+ pm (equal ?p
+ (string-to-char (downcase (match-string 4 ans)))))
+ (if (and (= hour 12) (not pm))
+ (setq hour 0)
+ (when (and pm (< hour 12)) (setq hour (+ 12 hour))))
+ (setq ans (replace-match (format "%02d:%02d" hour minute)
+ t t ans))))
;; Check if a time range is given as a duration
(when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
@@ -17129,7 +17245,7 @@ user."
minute (string-to-number (match-string 2 ans))
m2 (+ minute (if (match-end 5) (string-to-number
(match-string 5 ans))0)))
- (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
+ (when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
(setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2)
t t ans)))
@@ -17233,17 +17349,17 @@ user."
(setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
(unless (equal wday wday1)
(setq day (+ day (% (- wday wday1 -7) 7))))))
- (if (and (boundp 'org-time-was-given)
- (nth 2 tl))
- (setq org-time-was-given t))
- (if (< year 100) (setq year (+ 2000 year)))
+ (when (and (boundp 'org-time-was-given)
+ (nth 2 tl))
+ (setq org-time-was-given t))
+ (when (< year 100) (setq year (+ 2000 year)))
;; Check of the date is representable
(if org-read-date-force-compatible-dates
(progn
- (if (< year 1970)
- (setq year 1970 org-read-date-analyze-forced-year t))
- (if (> year 2037)
- (setq year 2037 org-read-date-analyze-forced-year t)))
+ (when (< year 1970)
+ (setq year 1970 org-read-date-analyze-forced-year t))
+ (when (> year 2037)
+ (setq year 2037 org-read-date-analyze-forced-year t)))
(condition-case nil
(ignore (encode-time second minute hour day month year))
(error
@@ -17283,12 +17399,11 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to
(if wday1
(progn
(setq delta (mod (+ 7 (- wday1 wday)) 7))
- (if (= delta 0) (setq delta 7))
- (if (= dir ?-)
- (progn
- (setq delta (- delta 7))
- (if (= delta 0) (setq delta -7))))
- (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
+ (when (= delta 0) (setq delta 7))
+ (when (= dir ?-)
+ (setq delta (- delta 7))
+ (when (= delta 0) (setq delta -7)))
+ (when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
(list delta "d" rel))
(list (* n (if (= dir ?-) -1 1)) what rel)))))
@@ -17297,23 +17412,14 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to
The internal representation needed by the calendar is (month day year).
This is a wrapper to handle the brain-dead convention in calendar that
user function argument order change dependent on argument order."
- (if (boundp 'calendar-date-style)
- (cond
- ((eq calendar-date-style 'american)
- (list arg1 arg2 arg3))
- ((eq calendar-date-style 'european)
- (list arg2 arg1 arg3))
- ((eq calendar-date-style 'iso)
- (list arg2 arg3 arg1)))
- (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1
- (if (org-bound-and-true-p european-calendar-style)
- (list arg2 arg1 arg3)
- (list arg1 arg2 arg3)))))
+ (pcase calendar-date-style
+ (`american (list arg1 arg2 arg3))
+ (`european (list arg2 arg1 arg3))
+ (`iso (list arg2 arg3 arg1))))
(defun org-eval-in-calendar (form &optional keepdate)
"Eval FORM in the calendar window and return to current window.
-When KEEPDATE is non-nil, update `org-ans2' from the cursor date,
-otherwise stick to the current value of `org-ans2'."
+Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date."
(let ((sf (selected-frame))
(sw (selected-window)))
(select-window (get-buffer-window "*Calendar*" t))
@@ -17324,7 +17430,7 @@ otherwise stick to the current value of `org-ans2'."
(setq org-ans2 (format-time-string "%Y-%m-%d" time))))
(move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
(select-window sw)
- (org-select-frame-set-input-focus sf)))
+ (select-frame-set-input-focus sf)))
(defun org-calendar-select ()
"Return to `org-read-date' with the date currently selected.
@@ -17334,7 +17440,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
(let* ((date (calendar-cursor-to-date))
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
- (if (active-minibuffer-window) (exit-minibuffer))))
+ (when (active-minibuffer-window) (exit-minibuffer))))
(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
"Insert a date stamp for the date given by the internal TIME.
@@ -17347,7 +17453,7 @@ stamp.
The command returns the inserted time stamp."
(let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
stamp)
- (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
+ (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
(insert-before-markers (or pre ""))
(when (listp extra)
(setq extra (car extra))
@@ -17370,14 +17476,12 @@ The command returns the inserted time stamp."
(unless org-display-custom-times
(let ((p (point-min)) (bmp (buffer-modified-p)))
(while (setq p (next-single-property-change p 'display))
- (if (and (get-text-property p 'display)
- (eq (get-text-property p 'face) 'org-date))
- (remove-text-properties
- p (setq p (next-single-property-change p 'display))
- '(display t))))
+ (when (and (get-text-property p 'display)
+ (eq (get-text-property p 'face) 'org-date))
+ (remove-text-properties
+ p (setq p (next-single-property-change p 'display))
+ '(display t))))
(set-buffer-modified-p bmp)))
- (if (featurep 'xemacs)
- (remove-text-properties (point-min) (point-max) '(end-glyph t)))
(org-restart-font-lock)
(setq org-table-may-need-update t)
(if org-display-custom-times
@@ -17390,8 +17494,8 @@ The command returns the inserted time stamp."
t1 w1 with-hm tf time str w2 (off 0))
(save-match-data
(setq t1 (org-parse-time-string ts t))
- (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
- (setq off (- (match-end 0) (match-beginning 0)))))
+ (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
+ (setq off (- (match-end 0) (match-beginning 0)))))
(setq end (- end off))
(setq w1 (- end beg)
with-hm (and (nth 1 t1) (nth 2 t1))
@@ -17402,14 +17506,10 @@ The command returns the inserted time stamp."
(substring tf 1 -1) (apply 'encode-time time))
nil 'mouse-face 'highlight)
w2 (length str))
- (if (not (= w2 w1))
- (add-text-properties (1+ beg) (+ 2 beg)
- (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
- (if (featurep 'xemacs)
- (progn
- (put-text-property beg end 'invisible t)
- (put-text-property beg end 'end-glyph (make-glyph str)))
- (put-text-property beg end 'display str))))
+ (unless (= w2 w1)
+ (add-text-properties (1+ beg) (+ 2 beg)
+ (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
+ (put-text-property beg end 'display str)))
(defun org-fix-decoded-time (time)
"Set 0 instead of nil for the first 6 elements of time.
@@ -17417,19 +17517,17 @@ Don't touch the rest."
(let ((n 0))
(mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
-(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4")
-
(defun org-time-stamp-to-now (timestamp-string &optional seconds)
"Difference between TIMESTAMP-STRING and now in days.
If SECONDS is non-nil, return the difference in seconds."
- (let ((fdiff (if seconds 'org-float-time 'time-to-days)))
+ (let ((fdiff (if seconds #'float-time #'time-to-days)))
(- (funcall fdiff (org-time-string-to-time timestamp-string))
(funcall fdiff (current-time)))))
-(defun org-deadline-close (timestamp-string &optional ndays)
+(defun org-deadline-close-p (timestamp-string &optional ndays)
"Is the time in TIMESTAMP-STRING close to the current date?"
(setq ndays (or ndays (org-get-wdays timestamp-string)))
- (and (< (org-time-stamp-to-now timestamp-string) ndays)
+ (and (<= (org-time-stamp-to-now timestamp-string) ndays)
(not (org-entry-is-done-p))))
(defun org-get-wdays (ts &optional delay zero-delay)
@@ -17465,14 +17563,15 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
(let* ((date (calendar-cursor-to-date))
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
- (if (active-minibuffer-window) (exit-minibuffer))))
+ (when (active-minibuffer-window) (exit-minibuffer))))
(defun org-check-deadlines (ndays)
"Check if there are any deadlines due or past due.
A deadline is considered due if it happens within `org-deadline-warning-days'
days from today's date. If the deadline appears in an entry marked DONE,
-it is not shown. The prefix arg NDAYS can be used to test that many
-days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown."
+it is not shown. A numeric prefix argument NDAYS can be used to test that
+many days. If the prefix is a raw `\\[universal-argument]', all deadlines \
+are shown."
(interactive "P")
(let* ((org-warn-days
(cond
@@ -17482,7 +17581,7 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
(case-fold-search nil)
(regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
(callback
- (lambda () (org-deadline-close (match-string 1) org-warn-days))))
+ (lambda () (org-deadline-close-p (match-string 1) org-warn-days))))
(message "%d deadlines past-due or due within %d days"
(org-occur regexp nil callback)
org-warn-days)))
@@ -17500,7 +17599,7 @@ Allowed values for TYPE are:
When TYPE is nil, fall back on returning a regexp that matches
both scheduled and deadline timestamps."
- (case type
+ (cl-case type
(all org-ts-regexp-both)
(active org-ts-regexp)
(inactive org-ts-regexp-inactive)
@@ -17512,39 +17611,49 @@ both scheduled and deadline timestamps."
(regexp-opt (list org-deadline-string org-scheduled-string))
" *<\\([^>]+\\)>"))))
-(defun org-check-before-date (date)
- "Check if there are deadlines or scheduled entries before DATE."
+(defun org-check-before-date (d)
+ "Check if there are deadlines or scheduled entries before date D."
(interactive (list (org-read-date)))
- (let ((case-fold-search nil)
- (regexp (org-re-timestamp org-ts-type))
- (callback
- `(lambda ()
+ (let* ((case-fold-search nil)
+ (regexp (org-re-timestamp org-ts-type))
+ (ts-type org-ts-type)
+ (callback
+ (lambda ()
(let ((match (match-string 1)))
- (and ,(if (memq org-ts-type '(active inactive all))
- '(eq (org-element-type (org-element-context)) 'timestamp)
- '(org-at-planning-p))
+ (and (if (memq ts-type '(active inactive all))
+ (eq (org-element-type (save-excursion
+ (backward-char)
+ (org-element-context)))
+ 'timestamp)
+ (org-at-planning-p))
(time-less-p
(org-time-string-to-time match)
- (org-time-string-to-time date)))))))
+ (org-time-string-to-time d)))))))
(message "%d entries before %s"
- (org-occur regexp nil callback) date)))
+ (org-occur regexp nil callback)
+ d)))
-(defun org-check-after-date (date)
- "Check if there are deadlines or scheduled entries after DATE."
+(defun org-check-after-date (d)
+ "Check if there are deadlines or scheduled entries after date D."
(interactive (list (org-read-date)))
- (let ((case-fold-search nil)
- (regexp (org-re-timestamp org-ts-type))
- (callback
- `(lambda ()
+ (let* ((case-fold-search nil)
+ (regexp (org-re-timestamp org-ts-type))
+ (ts-type org-ts-type)
+ (callback
+ (lambda ()
(let ((match (match-string 1)))
- (and ,(if (memq org-ts-type '(active inactive all))
- '(eq (org-element-type (org-element-context)) 'timestamp)
- '(org-at-planning-p))
+ (and (if (memq ts-type '(active inactive all))
+ (eq (org-element-type (save-excursion
+ (backward-char)
+ (org-element-context)))
+ 'timestamp)
+ (org-at-planning-p))
(not (time-less-p
(org-time-string-to-time match)
- (org-time-string-to-time date))))))))
+ (org-time-string-to-time d))))))))
(message "%d entries after %s"
- (org-occur regexp nil callback) date)))
+ (org-occur regexp nil callback)
+ d)))
(defun org-check-dates-range (start-date end-date)
"Check for deadlines/scheduled entries between START-DATE and END-DATE."
@@ -17553,18 +17662,22 @@ both scheduled and deadline timestamps."
(let ((case-fold-search nil)
(regexp (org-re-timestamp org-ts-type))
(callback
- `(lambda ()
- (let ((match (match-string 1)))
- (and
- ,(if (memq org-ts-type '(active inactive all))
- '(eq (org-element-type (org-element-context)) 'timestamp)
- '(org-at-planning-p))
- (not (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time start-date)))
- (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time end-date)))))))
+ (let ((type org-ts-type))
+ (lambda ()
+ (let ((match (match-string 1)))
+ (and
+ (if (memq type '(active inactive all))
+ (eq (org-element-type (save-excursion
+ (backward-char)
+ (org-element-context)))
+ 'timestamp)
+ (org-at-planning-p))
+ (not (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time start-date)))
+ (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time end-date))))))))
(message "%d entries between %s and %s"
(org-occur regexp nil callback) start-date end-date)))
@@ -17583,16 +17696,16 @@ days in order to avoid rounding problems."
(unless (org-at-date-range-p t)
(goto-char (point-at-bol))
(re-search-forward org-tr-regexp-both (point-at-eol) t))
- (if (not (org-at-date-range-p t))
- (user-error "Not at a time-stamp range, and none found in current line")))
+ (unless (org-at-date-range-p t)
+ (user-error "Not at a time-stamp range, and none found in current line")))
(let* ((ts1 (match-string 1))
(ts2 (match-string 2))
(havetime (or (> (length ts1) 15) (> (length ts2) 15)))
(match-end (match-end 0))
(time1 (org-time-string-to-time ts1))
(time2 (org-time-string-to-time ts2))
- (t1 (org-float-time time1))
- (t2 (org-float-time time2))
+ (t1 (float-time time1))
+ (t2 (float-time time2))
(diff (abs (- t2 t1)))
(negative (< (- t2 t1) 0))
;; (ys (floor (* 365 24 60 60)))
@@ -17622,27 +17735,31 @@ days in order to avoid rounding problems."
(setq align t)
(and (looking-at " *|") (goto-char (match-end 0))))
(goto-char match-end))
- (if (looking-at
- "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
- (replace-match ""))
- (if negative (insert " -"))
+ (when (looking-at
+ "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
+ (replace-match ""))
+ (when negative (insert " -"))
(if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
(if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
(insert " " (format fh h m))))
- (if align (org-table-align))
+ (when align (org-table-align))
(message "Time difference inserted")))))
(defun org-make-tdiff-string (y d h m)
(let ((fmt "")
(l nil))
- (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")
- l (push y l)))
- (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")
- l (push d l)))
- (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")
- l (push h l)))
- (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")
- l (push m l)))
+ (when (> y 0)
+ (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " "))
+ (push y l))
+ (when (> d 0)
+ (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " "))
+ (push d l))
+ (when (> h 0)
+ (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " "))
+ (push h l))
+ (when (> m 0)
+ (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " "))
+ (push m l))
(apply 'format fmt (nreverse l))))
(defun org-time-string-to-time (s &optional buffer pos)
@@ -17657,31 +17774,42 @@ days in order to avoid rounding problems."
(defun org-time-string-to-seconds (s)
"Convert a timestamp string to a number of seconds."
- (org-float-time (org-time-string-to-time s)))
+ (float-time (org-time-string-to-time s)))
+
+(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
- "Convert a time stamp to an absolute day number.
-If there is a specifier for a cyclic time stamp, get the closest
-date to DAYNR.
-PREFER and SHOW-ALL are passed through to `org-closest-date'.
-The variable `date' is bound by the calendar when this is called."
+ "Convert time stamp S to an absolute day number.
+
+If DAYNR in non-nil, and there is a specifier for a cyclic time
+stamp, get the closest date to DAYNR. If PREFER is
+`past' (respectively `future') return a date past (respectively
+after) or equal to DAYNR.
+
+POS is the location of time stamp S, as a buffer position in
+BUFFER.
+
+Diary sexp timestamps are matched against DAYNR, when non-nil.
+If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is
+signalled."
(cond
- ((and daynr (string-match "\\`%%\\((.*)\\)" s))
- (if (org-diary-sexp-entry (match-string 1 s) "" date)
+ ((string-match "\\`%%\\((.*)\\)" s)
+ ;; Sexp timestamp: try to match DAYNR, if available, since we're
+ ;; only able to match individual dates. If it fails, raise an
+ ;; error.
+ (if (and daynr
+ (org-diary-sexp-entry
+ (match-string 1 s) "" (calendar-gregorian-from-absolute daynr)))
daynr
- (+ daynr 1000)))
- ((and daynr (string-match "\\+\\([0-9]+\\)[hdwmy]" s)
- (> (string-to-number (match-string 1 s)) 0))
- (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr
- (time-to-days (current-time))) (match-string 0 s)
- prefer show-all))
+ (signal 'org-diary-sexp-no-match (list s))))
+ ((and daynr show-all) (org-closest-date s daynr prefer))
(t (time-to-days
(condition-case errdata
- (apply 'encode-time (org-parse-time-string s))
+ (apply #'encode-time (org-parse-time-string s))
(error (error "Bad timestamp `%s'%s\nError was: %s"
- s (if (not (and buffer pos))
- ""
- (format-message " at %d in buffer `%s'" pos buffer))
+ s
+ (if (not (and buffer pos)) ""
+ (format-message " at %d in buffer `%s'" pos buffer))
(cdr errdata))))))))
(defun org-days-to-iso-week (days)
@@ -17704,31 +17832,33 @@ into a past one. Any year larger than 99 is returned unchanged."
(defun org-time-from-absolute (d)
"Return the time corresponding to date D.
D may be an absolute day number, or a calendar-type list (month day year)."
- (if (numberp d) (setq d (calendar-gregorian-from-absolute d)))
+ (when (numberp d) (setq d (calendar-gregorian-from-absolute d)))
(encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
+(defvar org-agenda-current-date)
(defun org-calendar-holiday ()
- "List of holidays, for Diary display in Org-mode."
+ "List of holidays, for Diary display in Org mode."
(require 'holidays)
- (let ((hl (funcall
- (if (fboundp 'calendar-check-holidays)
- 'calendar-check-holidays 'check-calendar-holidays) date)))
- (if hl (mapconcat 'identity hl "; "))))
+ (let ((hl (calendar-check-holidays org-agenda-current-date)))
+ (and hl (mapconcat #'identity hl "; "))))
-(defun org-diary-sexp-entry (sexp entry date)
- "Process a SEXP diary ENTRY for DATE."
+(defun org-diary-sexp-entry (sexp entry d)
+ "Process a SEXP diary ENTRY for date D."
(require 'diary-lib)
- (let ((result (if calendar-debug-sexp
- (let ((stack-trace-on-error t))
- (eval (car (read-from-string sexp))))
- (condition-case nil
- (eval (car (read-from-string sexp)))
- (error
- (beep)
- (message "Bad sexp at line %d in %s: %s"
- (org-current-line)
- (buffer-file-name) sexp)
- (sleep-for 2))))))
+ ;; `org-anniversary' and alike expect ENTRY and DATE to be bound
+ ;; dynamically.
+ (let* ((sexp `(let ((entry ,entry)
+ (date ',d))
+ ,(car (read-from-string sexp))))
+ (result (if calendar-debug-sexp (eval sexp)
+ (condition-case nil
+ (eval sexp)
+ (error
+ (beep)
+ (message "Bad sexp at line %d in %s: %s"
+ (org-current-line)
+ (buffer-file-name) sexp)
+ (sleep-for 2))))))
(cond ((stringp result) (split-string result "; "))
((and (consp result)
(not (consp (cdr result)))
@@ -17740,9 +17870,7 @@ D may be an absolute day number, or a calendar-type list (month day year)."
(defun org-diary-to-ical-string (frombuf)
"Get iCalendar entries from diary entries in buffer FROMBUF.
This uses the icalendar.el library."
- (let* ((tmpdir (if (featurep 'xemacs)
- (temp-directory)
- temporary-file-directory))
+ (let* ((tmpdir temporary-file-directory)
(tmpfile (make-temp-name
(expand-file-name "orgics" tmpdir)))
buf rtn b e)
@@ -17751,126 +17879,136 @@ This uses the icalendar.el library."
(setq buf (find-buffer-visiting tmpfile))
(set-buffer buf)
(goto-char (point-min))
- (if (re-search-forward "^BEGIN:VEVENT" nil t)
- (setq b (match-beginning 0)))
+ (when (re-search-forward "^BEGIN:VEVENT" nil t)
+ (setq b (match-beginning 0)))
(goto-char (point-max))
- (if (re-search-backward "^END:VEVENT" nil t)
- (setq e (match-end 0)))
+ (when (re-search-backward "^END:VEVENT" nil t)
+ (setq e (match-end 0)))
(setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
(kill-buffer buf)
(delete-file tmpfile)
rtn))
-(defun org-closest-date (start current change prefer show-all)
- "Find the date closest to CURRENT that is consistent with START and CHANGE.
-When PREFER is `past', return a date that is either CURRENT or past.
-When PREFER is `future', return a date that is either CURRENT or future.
-When SHOW-ALL is nil, only return the current occurrence of a time stamp."
- ;; Make the proper lists from the dates
- (catch 'exit
- (let ((a1 '(("h" . hour)
- ("d" . day)
- ("w" . week)
- ("m" . month)
- ("y" . year)))
- (shour (nth 2 (org-parse-time-string start)))
- dn dw sday cday n1 n2 n0
- d m y y1 y2 date1 date2 nmonths nm ny m2)
-
- (setq start (org-date-to-gregorian start)
- current (org-date-to-gregorian
- (if show-all
- current
- (time-to-days (current-time))))
- sday (calendar-absolute-from-gregorian start)
- cday (calendar-absolute-from-gregorian current))
-
- (if (<= cday sday) (throw 'exit sday))
-
- (when (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change)
- (setq dn (string-to-number (match-string 1 change))
- dw (cdr (assoc (match-string 2 change) a1))))
- (unless (and dn (> dn 0))
- (user-error "Invalid change specifier: %s" change))
- (if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
- (cond
- ((eq dw 'hour)
- (let ((missing-hours
- (mod (+ (- (* 24 (- cday sday)) shour) org-extend-today-until)
- dn)))
- (setq n1 (if (zerop missing-hours) cday
- (- cday (1+ (floor (/ missing-hours 24)))))
- n2 (+ cday (floor (/ (- dn missing-hours) 24))))))
- ((eq dw 'day)
- (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn))))
- n2 (+ n1 dn)))
- ((eq dw 'year)
- (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current))
- (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1))
- (setq date1 (list m d y1)
- n1 (calendar-absolute-from-gregorian date1)
- date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn)))
- n2 (calendar-absolute-from-gregorian date2)))
- ((eq dw 'month)
- ;; approx number of month between the two dates
- (setq nmonths (floor (/ (- cday sday) 30.436875)))
- ;; How often does dn fit in there?
- (setq d (nth 1 start) m (car start) y (nth 2 start)
- nm (* dn (max 0 (1- (floor (/ nmonths dn)))))
- m (+ m nm)
- ny (floor (/ m 12))
- y (+ y ny)
- m (- m (* ny 12)))
- (while (> m 12) (setq m (- m 12) y (1+ y)))
- (setq n1 (calendar-absolute-from-gregorian (list m d y)))
- (setq m2 (+ m dn) y2 y)
- (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
- (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))
- (while (<= n2 cday)
- (setq n1 n2 m m2 y y2)
- (setq m2 (+ m dn) y2 y)
- (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
- (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))))))
- ;; Make sure n1 is the earlier date
- (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2))
- (if show-all
- (cond
- ((eq prefer 'past) (if (= cday n2) n2 n1))
- ((eq prefer 'future) (if (= cday n1) n1 n2))
- (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))
- (cond
- ((eq prefer 'past) (if (= cday n2) n2 n1))
- ((eq prefer 'future) (if (= cday n1) n1 n2))
- (t (if (= cday n1) n1 n2)))))))
-
-(defun org-date-to-gregorian (date)
- "Turn any specification of DATE into a Gregorian date for the calendar."
- (cond ((integerp date) (calendar-gregorian-from-absolute date))
- ((and (listp date) (= (length date) 3)) date)
- ((stringp date)
- (setq date (org-parse-time-string date))
- (list (nth 4 date) (nth 3 date) (nth 5 date)))
- ((listp date)
- (list (nth 4 date) (nth 3 date) (nth 5 date)))))
+(defun org-closest-date (start current prefer)
+ "Return closest date to CURRENT starting from START.
+
+CURRENT and START are both time stamps.
+
+When PREFER is `past', return a date that is either CURRENT or
+past. When PREFER is `future', return a date that is either
+CURRENT or future.
+
+Only time stamps with a repeater are modified. Any other time
+stamp stay unchanged. In any case, return value is an absolute
+day number."
+ (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start))
+ ;; No repeater. Do not shift time stamp.
+ (time-to-days (apply #'encode-time (org-parse-time-string start)))
+ (let ((value (string-to-number (match-string 1 start)))
+ (type (match-string 2 start)))
+ (if (= 0 value)
+ ;; Repeater with a 0-value is considered as void.
+ (time-to-days (apply #'encode-time (org-parse-time-string start)))
+ (let* ((base (org-date-to-gregorian start))
+ (target (org-date-to-gregorian current))
+ (sday (calendar-absolute-from-gregorian base))
+ (cday (calendar-absolute-from-gregorian target))
+ n1 n2)
+ ;; If START is already past CURRENT, just return START.
+ (if (<= cday sday) sday
+ ;; Compute closest date before (N1) and closest date past
+ ;; (N2) CURRENT.
+ (pcase type
+ ("h"
+ (let ((missing-hours
+ (mod (+ (- (* 24 (- cday sday))
+ (nth 2 (org-parse-time-string start)))
+ org-extend-today-until)
+ value)))
+ (setf n1 (if (= missing-hours 0) cday
+ (- cday (1+ (/ missing-hours 24)))))
+ (setf n2 (+ cday (/ (- value missing-hours) 24)))))
+ ((or "d" "w")
+ (let ((value (if (equal type "w") (* 7 value) value)))
+ (setf n1 (+ sday (* value (/ (- cday sday) value))))
+ (setf n2 (+ n1 value))))
+ ("m"
+ (let* ((add-months
+ (lambda (d n)
+ ;; Add N months to gregorian date D, i.e.,
+ ;; a list (MONTH DAY YEAR). Return a valid
+ ;; gregorian date.
+ (let ((m (+ (nth 0 d) n)))
+ (list (mod m 12)
+ (nth 1 d)
+ (+ (/ m 12) (nth 2 d))))))
+ (months ; Complete months to TARGET.
+ (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base)))
+ (- (nth 0 target) (nth 0 base))
+ ;; If START's day is greater than
+ ;; TARGET's, remove incomplete month.
+ (if (> (nth 1 target) (nth 1 base)) 0 -1))
+ value)
+ value))
+ (before (funcall add-months base months)))
+ (setf n1 (calendar-absolute-from-gregorian before))
+ (setf n2
+ (calendar-absolute-from-gregorian
+ (funcall add-months before value)))))
+ (_
+ (let* ((d (nth 1 base))
+ (m (nth 0 base))
+ (y (nth 2 base))
+ (years ; Complete years to TARGET.
+ (* (/ (- (nth 2 target)
+ y
+ ;; If START's month and day are
+ ;; greater than TARGET's, remove
+ ;; incomplete year.
+ (if (or (> (nth 0 target) m)
+ (and (= (nth 0 target) m)
+ (> (nth 1 target) d)))
+ 0
+ 1))
+ value)
+ value))
+ (before (list m d (+ y years))))
+ (setf n1 (calendar-absolute-from-gregorian before))
+ (setf n2 (calendar-absolute-from-gregorian
+ (list m d (+ (nth 2 before) value)))))))
+ ;; Handle PREFER parameter, if any.
+ (cond
+ ((eq prefer 'past) (if (= cday n2) n2 n1))
+ ((eq prefer 'future) (if (= cday n1) n1 n2))
+ (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))))))))
+
+(defun org-date-to-gregorian (d)
+ "Turn any specification of date D into a Gregorian date for the calendar."
+ (cond ((integerp d) (calendar-gregorian-from-absolute d))
+ ((and (listp d) (= (length d) 3)) d)
+ ((stringp d)
+ (let ((d (org-parse-time-string d)))
+ (list (nth 4 d) (nth 3 d) (nth 5 d))))
+ ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d)))))
(defun org-parse-time-string (s &optional nodefault)
- "Parse the standard Org-mode time string.
+ "Parse the standard Org time string.
This should be a lot faster than the normal `parse-time-string'.
If time is not given, defaults to 0:00. However, with optional NODEFAULT,
hour and minute fields will be nil if not given."
(cond ((string-match org-ts-regexp0 s)
(list 0
- (if (or (match-beginning 8) (not nodefault))
- (string-to-number (or (match-string 8 s) "0")))
- (if (or (match-beginning 7) (not nodefault))
- (string-to-number (or (match-string 7 s) "0")))
+ (when (or (match-beginning 8) (not nodefault))
+ (string-to-number (or (match-string 8 s) "0")))
+ (when (or (match-beginning 7) (not nodefault))
+ (string-to-number (or (match-string 7 s) "0")))
(string-to-number (match-string 4 s))
(string-to-number (match-string 3 s))
(string-to-number (match-string 2 s))
nil nil nil))
((string-match "^<[^>]+>$" s)
(decode-time (seconds-to-time (org-matcher-time s))))
- (t (error "Not a standard Org-mode time string: %s" s))))
+ (t (error "Not a standard Org time string: %s" s))))
(defun org-timestamp-up (&optional arg)
"Increase the date item at the cursor by one.
@@ -17921,7 +18059,7 @@ INACTIVE-OK."
(ans (or (looking-at tsr)
(save-excursion
(skip-chars-backward "^[<\n\r\t")
- (if (> (point) (point-min)) (backward-char 1))
+ (when (> (point) (point-min)) (backward-char 1))
(and (looking-at tsr)
(> (- (match-end 0) pos) -1))))))
(and ans
@@ -17979,19 +18117,19 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
org-ts-what
extra rem
ts time time0 fixnext clrgx)
- (if (not (org-at-timestamp-p t))
- (user-error "Not at a timestamp"))
+ (unless (org-at-timestamp-p t)
+ (user-error "Not at a timestamp"))
(if (and (not what) (eq org-ts-what 'bracket))
(org-toggle-timestamp-type)
;; Point isn't on brackets. Remember the part of the time-stamp
;; the point was in. Indeed, size of time-stamps may change,
;; but point must be kept in the same category nonetheless.
(setq origin-cat org-ts-what)
- (if (and (not what) (not (eq org-ts-what 'day))
- org-display-custom-times
- (get-text-property (point) 'display)
- (not (get-text-property (1- (point)) 'display)))
- (setq org-ts-what 'day))
+ (when (and (not what) (not (eq org-ts-what 'day))
+ org-display-custom-times
+ (get-text-property (point) 'display)
+ (not (get-text-property (1- (point)) 'display)))
+ (setq org-ts-what 'day))
(setq org-ts-what (or what org-ts-what)
inactive (= (char-after (match-beginning 0)) ?\[)
ts (match-string 0))
@@ -18000,27 +18138,28 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
"\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
ts)
(setq extra (match-string 1 ts))
- (if suppress-tmp-delay
- (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
- (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
- (setq with-hm t))
+ (when suppress-tmp-delay
+ (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
+ (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
+ (setq with-hm t))
(setq time0 (org-parse-time-string ts))
(when (and updown
(eq org-ts-what 'minute)
(not current-prefix-arg))
;; This looks like s-up and s-down. Change by one rounding step.
(setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
- (when (not (= 0 (setq rem (% (nth 1 time0) dm))))
+ (unless (= 0 (setq rem (% (nth 1 time0) dm)))
(setcar (cdr time0) (+ (nth 1 time0)
(if (> n 0) (- rem) (- dm rem))))))
(setq time
- (encode-time (or (car time0) 0)
- (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
- (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
- (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
- (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
- (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
- (nthcdr 6 time0)))
+ (apply #'encode-time
+ (or (car time0) 0)
+ (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
+ (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
+ (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
+ (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
+ (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
+ (nthcdr 6 time0)))
(when (and (member org-ts-what '(hour minute))
extra
(string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
@@ -18030,15 +18169,15 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
n dm)))
(when (integerp org-ts-what)
(setq extra (org-modify-ts-extra extra org-ts-what n dm)))
- (if (eq what 'calendar)
- (let ((cal-date (org-get-date-from-calendar)))
- (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
- (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
- (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
- (setcar time0 (or (car time0) 0))
- (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
- (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
- (setq time (apply 'encode-time time0))))
+ (when (eq what 'calendar)
+ (let ((cal-date (org-get-date-from-calendar)))
+ (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
+ (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
+ (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
+ (setcar time0 (or (car time0) 0))
+ (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
+ (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
+ (setq time (apply 'encode-time time0))))
;; Insert the new time-stamp, and ensure point stays in the same
;; category as before (i.e. not after the last position in that
;; category).
@@ -18049,17 +18188,21 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(goto-char pos))
(save-match-data
(looking-at org-ts-regexp3)
- (goto-char (cond
- ;; `day' category ends before `hour' if any, or at
- ;; the end of the day name.
- ((eq origin-cat 'day)
- (min (or (match-beginning 7) (1- (match-end 5))) origin))
- ((eq origin-cat 'hour) (min (match-end 7) origin))
- ((eq origin-cat 'minute) (min (1- (match-end 8)) origin))
- ((integerp origin-cat) (min (1- (match-end 0)) origin))
- ;; `year' and `month' have both fixed size: point
- ;; couldn't have moved into another part.
- (t origin))))
+ (goto-char
+ (pcase origin-cat
+ ;; `day' category ends before `hour' if any, or at the end
+ ;; of the day name.
+ (`day (min (or (match-beginning 7) (1- (match-end 5))) origin))
+ (`hour (min (match-end 7) origin))
+ (`minute (min (1- (match-end 8)) origin))
+ ((pred integerp) (min (1- (match-end 0)) origin))
+ ;; Point was right after the time-stamp. However, the
+ ;; time-stamp length might have changed, so refer to
+ ;; (match-end 0) instead.
+ (`after (match-end 0))
+ ;; `year' and `month' have both fixed size: point couldn't
+ ;; have moved into another part.
+ (_ origin))))
;; Update clock if on a CLOCK line.
(org-clock-update-time-maybe)
;; Maybe adjust the closest clock in `org-clock-history'
@@ -18068,12 +18211,12 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(< 1 (length (delq nil (mapcar 'marker-position
org-clock-history))))))
(message "No clock to adjust")
- (cond ((save-excursion ; fix previous clock?
+ (cond ((save-excursion ; fix previous clock?
(re-search-backward org-ts-regexp0 nil t)
- (org-looking-back (concat org-clock-string " \\[")
- (line-beginning-position)))
+ (looking-back (concat org-clock-string " \\[")
+ (line-beginning-position)))
(setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
- ((save-excursion ; fix next clock?
+ ((save-excursion ; fix next clock?
(re-search-backward org-ts-regexp0 nil t)
(looking-at (concat org-ts-regexp0 "\\] =>")))
(setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
@@ -18083,7 +18226,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
(clfixnth
(+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100))))
- (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history))))
+ (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history))))
(if (not clfixpos)
(message "No clock to adjust")
(save-excursion
@@ -18097,10 +18240,10 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(file-name-nondirectory (buffer-file-name))
(org-get-heading t t)))))))))
;; Try to recenter the calendar window, if any.
- (if (and org-calendar-follow-timestamp-change
- (get-buffer-window "*Calendar*" t)
- (memq org-ts-what '(day month year)))
- (org-recenter-calendar (time-to-days time))))))
+ (when (and org-calendar-follow-timestamp-change
+ (get-buffer-window "*Calendar*" t)
+ (memq org-ts-what '(day month year)))
+ (org-recenter-calendar (time-to-days time))))))
(defun org-modify-ts-extra (s pos n dm)
"Change the different parts of the lead-time and repeat fields in timestamp."
@@ -18114,12 +18257,12 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
h (string-to-number (match-string 2 s)))
(if (org-pos-in-match-range pos 2)
(setq h (+ h n))
- (setq n (* dm (org-no-warnings (signum n))))
- (when (not (= 0 (setq rem (% m dm))))
+ (setq n (* dm (with-no-warnings (signum n))))
+ (unless (= 0 (setq rem (% m dm)))
(setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
(setq m (+ m n)))
- (if (< m 0) (setq m (+ m 60) h (1- h)))
- (if (> m 59) (setq m (- m 60) h (1+ h)))
+ (when (< m 0) (setq m (+ m 60) h (1- h)))
+ (when (> m 59) (setq m (- m 60) h (1+ h)))
(setq h (mod h 24))
(setq ng 1 new (format "-%02d:%02d" h m)))
((org-pos-in-match-range pos 6)
@@ -18139,14 +18282,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(substring s (match-end ng))))))
s))
-(defun org-recenter-calendar (date)
- "If the calendar is visible, recenter it to DATE."
+(defun org-recenter-calendar (d)
+ "If the calendar is visible, recenter it to date D."
(let ((cwin (get-buffer-window "*Calendar*" t)))
(when cwin
(let ((calendar-move-hook nil))
(with-selected-window cwin
- (calendar-goto-date (if (listp date) date
- (calendar-gregorian-from-absolute date))))))))
+ (calendar-goto-date
+ (if (listp d) d (calendar-gregorian-from-absolute d))))))))
(defun org-goto-calendar (&optional arg)
"Go to the Emacs calendar at the current date.
@@ -18157,17 +18300,17 @@ A prefix ARG can be used to force the current date."
(calendar-move-hook nil)
(calendar-view-holidays-initially-flag nil)
(calendar-view-diary-initially-flag nil))
- (if (or (org-at-timestamp-p)
- (save-excursion
- (beginning-of-line 1)
- (looking-at (concat ".*" tsr))))
- (let ((d1 (time-to-days (current-time)))
- (d2 (time-to-days
- (org-time-string-to-time (match-string 1)))))
- (setq diff (- d2 d1))))
+ (when (or (org-at-timestamp-p)
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at (concat ".*" tsr))))
+ (let ((d1 (time-to-days (current-time)))
+ (d2 (time-to-days
+ (org-time-string-to-time (match-string 1)))))
+ (setq diff (- d2 d1))))
(calendar)
(calendar-goto-today)
- (if (and diff (not arg)) (calendar-forward-day diff))))
+ (when (and diff (not arg)) (calendar-forward-day diff))))
(defun org-get-date-from-calendar ()
"Return a list (month day year) of date at point in calendar."
@@ -18203,7 +18346,7 @@ minutes.
For example, if the value of this variable is ((\"hours\" . 60)), then an
effort string \"2hours\" is equivalent to 120 minutes."
:group 'org-agenda
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(alist :key-type (string :tag "Modifier")
:value-type (number :tag "Minutes")))
@@ -18297,10 +18440,6 @@ The format is determined by `org-time-clocksum-format',
;; return formatted time duration
clocksum))))
-(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string)
-(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string
- "Org mode version 8.0")
-
(defun org-hours-to-clocksum-string (n)
(org-minutes-to-clocksum-string (* n 60)))
@@ -18356,10 +18495,6 @@ tables are not re-aligned, etc."
:version "24.3"
:group 'org-agenda)
-(define-obsolete-variable-alias
- 'org-agenda-ignore-drawer-properties
- 'org-agenda-ignore-properties "25.1")
-
(defcustom org-agenda-ignore-properties nil
"Avoid updating text properties when building the agenda.
Properties are used to prepare buffers for effort estimates,
@@ -18373,7 +18508,7 @@ The value is a list, with zero or more of the symbols `effort', `appt',
(const appt)
(const stats)
(const category))
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:group 'org-agenda)
@@ -18390,25 +18525,25 @@ Entries containing a colon are interpreted as H:MM by
(regexp-opt (mapcar 'car org-effort-durations))
"\\)")))
(while (string-match re s)
- (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
- (string-to-number (match-string 1 s))))
+ (cl-incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
+ (string-to-number (match-string 1 s))))
(setq s (replace-match "" nil t s)))
(setq result (floor result))
- (incf result (org-hh:mm-string-to-minutes s))
+ (cl-incf result (org-hh:mm-string-to-minutes s))
(if output-to-string (number-to-string result) result)))
;;;; Files
(defun org-save-all-org-buffers ()
- "Save all Org-mode buffers without user confirmation."
+ "Save all Org buffers without user confirmation."
(interactive)
- (message "Saving all Org-mode buffers...")
+ (message "Saving all Org buffers...")
(save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
(when (featurep 'org-id) (org-id-locations-save))
- (message "Saving all Org-mode buffers... done"))
+ (message "Saving all Org buffers... done"))
(defun org-revert-all-org-buffers ()
- "Revert all Org-mode buffers.
+ "Revert all Org buffers.
Prompt for confirmation when there are unsaved changes.
Be sure you know what you are doing before letting this function
overwrite your changes.
@@ -18425,13 +18560,11 @@ changes from another. I believe the procedure must be like this:
(user-error "Abort"))
(save-excursion
(save-window-excursion
- (mapc
- (lambda (b)
- (when (and (with-current-buffer b (derived-mode-p 'org-mode))
- (with-current-buffer b buffer-file-name))
- (org-pop-to-buffer-same-window b)
- (revert-buffer t 'no-confirm)))
- (buffer-list))
+ (dolist (b (buffer-list))
+ (when (and (with-current-buffer b (derived-mode-p 'org-mode))
+ (with-current-buffer b buffer-file-name))
+ (pop-to-buffer-same-window b)
+ (revert-buffer t 'no-confirm)))
(when (and (featurep 'org-id) org-id-track-globally)
(org-id-locations-load)))))
@@ -18440,29 +18573,19 @@ changes from another. I believe the procedure must be like this:
;;;###autoload
(defun org-switchb (&optional arg)
"Switch between Org buffers.
-With one prefix argument, restrict available buffers to files.
-With two prefix arguments, restrict available buffers to agenda files.
-Defaults to `iswitchb' for buffer name completion.
-Set `org-completion-use-ido' to make it use ido instead."
+With `\\[universal-argument]' prefix, restrict available buffers to files.
+
+With `\\[universal-argument] \\[universal-argument]' \
+prefix, restrict available buffers to agenda files."
(interactive "P")
- (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files))
- ((equal arg '(16)) (org-buffer-list 'agenda))
- (t (org-buffer-list))))
- (org-completion-use-iswitchb org-completion-use-iswitchb)
- (org-completion-use-ido org-completion-use-ido))
- (unless (or org-completion-use-ido org-completion-use-iswitchb)
- (setq org-completion-use-iswitchb t))
- (org-pop-to-buffer-same-window
- (org-icompleting-read "Org buffer: "
- (mapcar 'list (mapcar 'buffer-name blist))
- nil t))))
-
-;;; Define some older names previously used for this functionality
-;;;###autoload
-(defalias 'org-ido-switchb 'org-switchb)
-;;;###autoload
-(defalias 'org-iswitchb 'org-switchb)
+ (let ((blist (org-buffer-list
+ (cond ((equal arg '(4)) 'files)
+ ((equal arg '(16)) 'agenda)))))
+ (pop-to-buffer-same-window
+ (completing-read "Org buffer: "
+ (mapcar #'list (mapcar #'buffer-name blist))
+ nil t))))
(defun org-buffer-list (&optional predicate exclude-tmp)
"Return a list of Org buffers.
@@ -18552,15 +18675,15 @@ the buffer and restores the previous window configuration."
(if (stringp org-agenda-files)
(let ((cw (current-window-configuration)))
(find-file org-agenda-files)
- (org-set-local 'org-window-configuration cw)
- (org-add-hook 'after-save-hook
- (lambda ()
- (set-window-configuration
- (prog1 org-window-configuration
- (kill-buffer (current-buffer))))
- (org-install-agenda-files-menu)
- (message "New agenda file list installed"))
- nil 'local)
+ (setq-local org-window-configuration cw)
+ (add-hook 'after-save-hook
+ (lambda ()
+ (set-window-configuration
+ (prog1 org-window-configuration
+ (kill-buffer (current-buffer))))
+ (org-install-agenda-files-menu)
+ (message "New agenda file list installed"))
+ nil 'local)
(message "%s" (substitute-command-keys
"Edit list and finish with \\[save-buffer]")))
(customize-variable 'org-agenda-files)))
@@ -18619,7 +18742,7 @@ If the current buffer does not, find the first agenda file."
(while (and (setq file (pop files))
(not (equal (file-truename file) tcf)))))
(find-file (car (or files fs)))
- (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer)))))
+ (when (buffer-base-buffer) (pop-to-buffer-same-window (buffer-base-buffer)))))
(defun org-agenda-file-to-front (&optional to-end)
"Move/add the current file to the top of the agenda file list.
@@ -18637,7 +18760,7 @@ end of the list."
x had)
(setq x (assoc ctf file-alist) had x)
- (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
+ (unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
(if to-end
(setq file-alist (append (delq x file-alist) (list x)))
(setq file-alist (cons x (delq x file-alist))))
@@ -18658,9 +18781,9 @@ Optional argument FILE means use this file instead of the current."
(afile (abbreviate-file-name file))
(files (delq nil (mapcar
(lambda (x)
- (if (equal true-file
- (file-truename x))
- nil x))
+ (unless (equal true-file
+ (file-truename x))
+ x))
(org-agenda-files t)))))
(if (not (= (length files) (length (org-agenda-files t))))
(progn
@@ -18674,7 +18797,7 @@ Optional argument FILE means use this file instead of the current."
(defun org-check-agenda-file (file)
"Make sure FILE exists. If not, ask user what to do."
- (when (not (file-exists-p file))
+ (unless (file-exists-p file)
(message "Non-existent agenda file %s. [R]emove from list or [A]bort?"
(abbreviate-file-name file))
(let ((r (downcase (read-char-exclusive))))
@@ -18693,7 +18816,7 @@ which might be released later."
buf ; just return it
;; Make a new buffer and remember it
(setq buf (find-file-noselect file))
- (if buf (push buf org-agenda-new-buffers))
+ (when buf (push buf org-agenda-new-buffers))
buf)))
(defun org-release-buffers (blist)
@@ -18718,7 +18841,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(inhibit-read-only t)
(org-inhibit-startup org-agenda-inhibit-startup)
(rea (concat ":" org-archive-tag ":"))
- file re pos)
+ re pos)
(setq org-tag-alist-for-agenda nil
org-tag-groups-alist-for-agenda nil)
(save-excursion
@@ -18749,8 +18872,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(setq org-tag-alist-for-agenda
(org-uniquify
(append org-tag-alist-for-agenda
- org-tag-alist
- org-tag-persistent-alist)))
+ org-current-tag-alist)))
;; Merge current file's tag groups into global
;; `org-tag-groups-alist-for-agenda'.
(when org-group-tags
@@ -18765,8 +18887,8 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(when org-agenda-skip-archived-trees
(goto-char (point-min))
(while (re-search-forward rea nil t)
- (if (org-at-heading-p t)
- (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
+ (when (org-at-heading-p t)
+ (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
(setq re (format "^\\*+ .*\\<%s\\>" org-comment-string))
(while (re-search-forward re nil t)
@@ -18797,7 +18919,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(define-minor-mode org-cdlatex-mode
"Toggle the minor `org-cdlatex-mode'.
This mode supports entering LaTeX environment and math in LaTeX fragments
-in Org-mode.
+in Org mode.
\\{org-cdlatex-mode-map}"
nil " OCDL" nil
(when org-cdlatex-mode
@@ -18807,11 +18929,11 @@ in Org-mode.
(unless org-cdlatex-texmathp-advice-is-done
(setq org-cdlatex-texmathp-advice-is-done t)
(defadvice texmathp (around org-math-always-on activate)
- "Always return t in org-mode buffers.
+ "Always return t in Org buffers.
This is because we want to insert math symbols without dollars even outside
-the LaTeX math segments. If Orgmode thinks that point is actually inside
-an embedded LaTeX fragment, let texmathp do its job.
-\\[org-cdlatex-mode-map]"
+the LaTeX math segments. If Org mode thinks that point is actually inside
+an embedded LaTeX fragment, let `texmathp' do its job.
+`\\[org-cdlatex-mode-map]'"
(interactive)
(let (p)
(cond
@@ -18823,8 +18945,8 @@ an embedded LaTeX fragment, let texmathp do its job.
(let ((p (org-inside-LaTeX-fragment-p)))
(if (and p (member (car p) (plist-get org-format-latex-options :matchers)))
(setq ad-return-value t
- texmathp-why '("Org-mode embedded math" . 0))
- (if p ad-do-it)))))))))
+ texmathp-why '("Org mode embedded math" . 0))
+ (when p ad-do-it)))))))))
(defun turn-on-org-cdlatex ()
"Unconditionally turn on `org-cdlatex-mode'."
@@ -18849,7 +18971,7 @@ It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
(cdlatex-tab) t)
((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
-(defun org-cdlatex-underscore-caret (&optional arg)
+(defun org-cdlatex-underscore-caret (&optional _arg)
"Execute `cdlatex-sub-superscript' in LaTeX fragments.
Revert to the normal definition outside of these fragments."
(interactive "P")
@@ -18858,7 +18980,7 @@ Revert to the normal definition outside of these fragments."
(let (org-cdlatex-mode)
(call-interactively (key-binding (vector last-input-event))))))
-(defun org-cdlatex-math-modify (&optional arg)
+(defun org-cdlatex-math-modify (&optional _arg)
"Execute `cdlatex-math-modify' in LaTeX fragments.
Revert to the normal definition outside of these fragments."
(interactive "P")
@@ -18887,10 +19009,10 @@ environment remains unintended."
;; environment has been inserted.
(lines (when inserted
(save-excursion
- (- (loop while (< beg (point))
+ (- (cl-loop while (< beg (point))
with x = 0
do (forward-line -1)
- (incf x)
+ (cl-incf x)
finally return x)
(if (progn (goto-char beg)
(and (progn (skip-chars-forward " \t") (eolp))
@@ -18916,11 +19038,11 @@ environment remains unintended."
(save-excursion
(goto-char beg)
(while (< (point) end)
- (unless (eolp) (org-indent-line-to ind))
+ (unless (eolp) (indent-line-to ind))
(forward-line))))
(goto-char beg)
(forward-line lines)
- (org-indent-line-to ind)))
+ (indent-line-to ind)))
(set-marker beg nil)
(set-marker end nil)))
@@ -18969,7 +19091,7 @@ looks only before point, not after."
(while (re-search-backward "\\$\\$" lim t)
(setq dd-on (not dd-on)))
(goto-char pos)
- (if dd-on (cons "$$" m))))))
+ (when dd-on (cons "$$" m))))))
(defun org-inside-latex-macro-p ()
"Is point inside a LaTeX macro or its arguments?"
@@ -18977,27 +19099,26 @@ looks only before point, not after."
(org-in-regexp
"\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")))
-(defun org--format-latex-make-overlay (beg end image)
- "Build an overlay between BEG and END using IMAGE file."
- (let ((ov (make-overlay beg end)))
+(defun org--format-latex-make-overlay (beg end image &optional imagetype)
+ "Build an overlay between BEG and END using IMAGE file.
+Argument IMAGETYPE is the extension of the displayed image,
+as a string. It defaults to \"png\"."
+ (let ((ov (make-overlay beg end))
+ (imagetype (or (intern imagetype) 'png)))
(overlay-put ov 'org-overlay-type 'org-latex-overlay)
(overlay-put ov 'evaporate t)
(overlay-put ov
'modification-hooks
(list (lambda (o _flag _beg _end &optional _l)
(delete-overlay o))))
- (if (featurep 'xemacs)
- (progn
- (overlay-put ov 'invisible t)
- (overlay-put ov 'end-glyph (make-glyph (vector 'png :file image))))
- (overlay-put ov
- 'display
- (list 'image :type 'png :file image :ascent 'center)))))
+ (overlay-put ov
+ 'display
+ (list 'image :type imagetype :file image :ascent 'center))))
(defun org--list-latex-overlays (&optional beg end)
"List all Org LaTeX overlays in current buffer.
Limit to overlays between BEG and END when those are provided."
- (org-remove-if-not
+ (cl-remove-if-not
(lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay))
(overlays-in (or beg (point-min)) (or end (point-max)))))
@@ -19010,8 +19131,6 @@ overlays were removed, nil otherwise."
(mapc #'delete-overlay overlays)
overlays))
-(define-obsolete-function-alias
- 'org-preview-latex-fragment 'org-toggle-latex-fragment "24.4")
(defun org-toggle-latex-fragment (&optional arg)
"Preview the LaTeX fragment at point, or all locally or globally.
@@ -19022,75 +19141,71 @@ current section.
With prefix ARG, preview or clear image for all fragments in the
current subtree or in the whole buffer when used before the first
-headline. With a double prefix ARG \\[universal-argument] \
-\\[universal-argument] preview or clear images
+headline. With a prefix ARG `\\[universal-argument] \
+\\[universal-argument]' preview or clear images
for all fragments in the buffer."
(interactive "P")
- (unless (buffer-file-name (buffer-base-buffer))
- (user-error "Can't preview LaTeX fragment in a non-file buffer"))
(when (display-graphic-p)
(catch 'exit
(save-excursion
- (let ((window-start (window-start)) msg)
- (save-restriction
- (cond
- ((or (equal arg '(16))
- (and (equal arg '(4))
- (org-with-limited-levels (org-before-first-heading-p))))
- (if (org-remove-latex-fragment-image-overlays)
- (progn (message "LaTeX fragments images removed from buffer")
- (throw 'exit nil))
- (setq msg "Creating images for buffer...")))
- ((equal arg '(4))
- (org-with-limited-levels (org-back-to-heading t))
- (let ((beg (point))
- (end (progn (org-end-of-subtree t) (point))))
- (if (org-remove-latex-fragment-image-overlays beg end)
- (progn
- (message "LaTeX fragment images removed from subtree")
- (throw 'exit nil))
- (setq msg "Creating images for subtree...")
- (narrow-to-region beg end))))
- ((let ((datum (org-element-context)))
- (when (memq (org-element-type datum)
- '(latex-environment latex-fragment))
- (let* ((beg (org-element-property :begin datum))
- (end (org-element-property :end datum)))
- (if (org-remove-latex-fragment-image-overlays beg end)
- (progn (message "LaTeX fragment image removed")
- (throw 'exit nil))
- (narrow-to-region beg end)
- (setq msg "Creating image..."))))))
- (t
- (org-with-limited-levels
- (let ((beg (if (org-at-heading-p) (line-beginning-position)
- (outline-previous-heading)
- (point)))
- (end (progn (outline-next-heading) (point))))
- (if (org-remove-latex-fragment-image-overlays beg end)
- (progn
- (message "LaTeX fragment images removed from section")
+ (let (beg end msg)
+ (cond
+ ((or (equal arg '(16))
+ (and (equal arg '(4))
+ (org-with-limited-levels (org-before-first-heading-p))))
+ (if (org-remove-latex-fragment-image-overlays)
+ (progn (message "LaTeX fragments images removed from buffer")
(throw 'exit nil))
- (setq msg "Creating images for section...")
- (narrow-to-region beg end))))))
- (let ((file (buffer-file-name (buffer-base-buffer))))
- (org-format-latex
- (concat org-latex-preview-ltxpng-directory
- (file-name-sans-extension (file-name-nondirectory file)))
- ;; Emacs cannot overlay images from remote hosts.
- ;; Create it in `temporary-file-directory' instead.
- (if (file-remote-p file) temporary-file-directory
- default-directory)
- 'overlays msg 'forbuffer
- org-latex-create-formula-image-program)))
- ;; Work around a bug that doesn't restore window's start
- ;; when widening back the buffer.
- (set-window-start nil window-start)
+ (setq msg "Creating images for buffer...")))
+ ((equal arg '(4))
+ (org-with-limited-levels (org-back-to-heading t))
+ (setq beg (point))
+ (setq end (progn (org-end-of-subtree t) (point)))
+ (if (org-remove-latex-fragment-image-overlays beg end)
+ (progn
+ (message "LaTeX fragment images removed from subtree")
+ (throw 'exit nil))
+ (setq msg "Creating images for subtree...")))
+ ((let ((datum (org-element-context)))
+ (when (memq (org-element-type datum)
+ '(latex-environment latex-fragment))
+ (setq beg (org-element-property :begin datum))
+ (setq end (org-element-property :end datum))
+ (if (org-remove-latex-fragment-image-overlays beg end)
+ (progn (message "LaTeX fragment image removed")
+ (throw 'exit nil))
+ (setq msg "Creating image...")))))
+ (t
+ (org-with-limited-levels
+ (setq beg (if (org-at-heading-p) (line-beginning-position)
+ (outline-previous-heading)
+ (point)))
+ (setq end (progn (outline-next-heading) (point)))
+ (if (org-remove-latex-fragment-image-overlays beg end)
+ (progn
+ (message "LaTeX fragment images removed from section")
+ (throw 'exit nil))
+ (setq msg "Creating images for section...")))))
+ (let ((file (buffer-file-name (buffer-base-buffer))))
+ (org-format-latex
+ (concat org-preview-latex-image-directory "org-ltximg")
+ beg end
+ ;; Emacs cannot overlay images from remote hosts. Create
+ ;; it in `temporary-file-directory' instead.
+ (if (or (not file) (file-remote-p file))
+ temporary-file-directory
+ default-directory)
+ 'overlays msg 'forbuffer org-preview-latex-default-process))
(message (concat msg "done")))))))
(defun org-format-latex
- (prefix &optional dir overlays msg forbuffer processing-type)
- "Replace LaTeX fragments with links to an image, and produce images.
+ (prefix &optional beg end dir overlays msg forbuffer processing-type)
+ "Replace LaTeX fragments with links to an image.
+
+The function takes care of creating the replacement image.
+
+Only consider fragments between BEG and END when those are
+provided.
When optional argument OVERLAYS is non-nil, display the image on
top of the fragment instead of replacing it.
@@ -19104,11 +19219,11 @@ Some of the options can be changed using the variable
(let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}")
(cnt 0)
checkdir-flag)
- (goto-char (point-min))
+ (goto-char (or beg (point-min)))
;; Optimize overlay creation: (info "(elisp) Managing Overlays").
(when (and overlays (memq processing-type '(dvipng imagemagick)))
- (overlay-recenter (point-max)))
- (while (re-search-forward math-regexp nil t)
+ (overlay-recenter (or end (point-max))))
+ (while (re-search-forward math-regexp end t)
(unless (and overlays
(eq (get-char-property (point) 'org-overlay-type)
'org-latex-overlay))
@@ -19122,85 +19237,88 @@ Some of the options can be changed using the variable
(goto-char (org-element-property :end context))
(skip-chars-backward " \r\t\n")
(point))))
- (case processing-type
- (mathjax
- ;; Prepare for MathJax processing.
- (if (not (string-match "\\`\\$\\$?" value))
- (goto-char end)
- (delete-region beg end)
- (if (string= (match-string 0 value) "$$")
- (insert "\\[" (substring value 2 -2) "\\]")
- (insert "\\(" (substring value 1 -1) "\\)"))))
- ((dvipng imagemagick)
- ;; Process to an image.
- (incf cnt)
- (goto-char beg)
- (let* ((face (face-at-point))
- ;; Get the colors from the face at point.
- (fg
- (let ((color (plist-get org-format-latex-options
- :foreground)))
- (if (and forbuffer (eq color 'auto))
- (face-attribute face :foreground nil 'default)
- color)))
- (bg
- (let ((color (plist-get org-format-latex-options
- :background)))
- (if (and forbuffer (eq color 'auto))
- (face-attribute face :background nil 'default)
- color)))
- (hash (sha1 (prin1-to-string
- (list org-format-latex-header
- org-latex-default-packages-alist
- org-latex-packages-alist
- org-format-latex-options
- forbuffer value fg bg))))
- (absprefix (expand-file-name prefix dir))
- (linkfile (format "%s_%s.png" prefix hash))
- (movefile (format "%s_%s.png" absprefix hash))
- (sep (and block-type "\n\n"))
- (link (concat sep "[[file:" linkfile "]]" sep))
- (options
- (org-combine-plists
- org-format-latex-options
- `(:foreground ,fg :background ,bg))))
- (when msg (message msg cnt))
- (unless checkdir-flag ; Ensure the directory exists.
- (setq checkdir-flag t)
- (let ((todir (file-name-directory absprefix)))
- (unless (file-directory-p todir)
- (make-directory todir t))))
- (unless (file-exists-p movefile)
- (org-create-formula-image
- value movefile options forbuffer processing-type))
- (if overlays
- (progn
- (dolist (o (overlays-in beg end))
- (when (eq (overlay-get o 'org-overlay-type)
- 'org-latex-overlay)
- (delete-overlay o)))
- (org--format-latex-make-overlay beg end movefile)
- (goto-char end))
- (delete-region beg end)
- (insert
- (org-add-props link
- (list 'org-latex-src
- (replace-regexp-in-string "\"" "" value)
- 'org-latex-src-embed-type
- (if block-type 'paragraph 'character)))))))
- (mathml
- ;; Process to MathML.
- (unless (org-format-latex-mathml-available-p)
- (user-error "LaTeX to MathML converter not configured"))
- (incf cnt)
- (when msg (message msg cnt))
- (goto-char beg)
- (delete-region beg end)
- (insert (org-format-latex-as-mathml
- value block-type prefix dir)))
- (otherwise
- (error "Unknown conversion type %s for LaTeX fragments"
- processing-type)))))))))))
+ (cond
+ ((eq processing-type 'mathjax)
+ ;; Prepare for MathJax processing.
+ (if (not (string-match "\\`\\$\\$?" value))
+ (goto-char end)
+ (delete-region beg end)
+ (if (string= (match-string 0 value) "$$")
+ (insert "\\[" (substring value 2 -2) "\\]")
+ (insert "\\(" (substring value 1 -1) "\\)"))))
+ ((assq processing-type org-preview-latex-process-alist)
+ ;; Process to an image.
+ (cl-incf cnt)
+ (goto-char beg)
+ (let* ((processing-info
+ (cdr (assq processing-type org-preview-latex-process-alist)))
+ (face (face-at-point))
+ ;; Get the colors from the face at point.
+ (fg
+ (let ((color (plist-get org-format-latex-options
+ :foreground)))
+ (if (and forbuffer (eq color 'auto))
+ (face-attribute face :foreground nil 'default)
+ color)))
+ (bg
+ (let ((color (plist-get org-format-latex-options
+ :background)))
+ (if (and forbuffer (eq color 'auto))
+ (face-attribute face :background nil 'default)
+ color)))
+ (hash (sha1 (prin1-to-string
+ (list org-format-latex-header
+ org-latex-default-packages-alist
+ org-latex-packages-alist
+ org-format-latex-options
+ forbuffer value fg bg))))
+ (imagetype (or (plist-get processing-info :image-output-type) "png"))
+ (absprefix (expand-file-name prefix dir))
+ (linkfile (format "%s_%s.%s" prefix hash imagetype))
+ (movefile (format "%s_%s.%s" absprefix hash imagetype))
+ (sep (and block-type "\n\n"))
+ (link (concat sep "[[file:" linkfile "]]" sep))
+ (options
+ (org-combine-plists
+ org-format-latex-options
+ `(:foreground ,fg :background ,bg))))
+ (when msg (message msg cnt))
+ (unless checkdir-flag ; Ensure the directory exists.
+ (setq checkdir-flag t)
+ (let ((todir (file-name-directory absprefix)))
+ (unless (file-directory-p todir)
+ (make-directory todir t))))
+ (unless (file-exists-p movefile)
+ (org-create-formula-image
+ value movefile options forbuffer processing-type))
+ (if overlays
+ (progn
+ (dolist (o (overlays-in beg end))
+ (when (eq (overlay-get o 'org-overlay-type)
+ 'org-latex-overlay)
+ (delete-overlay o)))
+ (org--format-latex-make-overlay beg end movefile imagetype)
+ (goto-char end))
+ (delete-region beg end)
+ (insert
+ (org-add-props link
+ (list 'org-latex-src
+ (replace-regexp-in-string "\"" "" value)
+ 'org-latex-src-embed-type
+ (if block-type 'paragraph 'character)))))))
+ ((eq processing-type 'mathml)
+ ;; Process to MathML.
+ (unless (org-format-latex-mathml-available-p)
+ (user-error "LaTeX to MathML converter not configured"))
+ (cl-incf cnt)
+ (when msg (message msg cnt))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (org-format-latex-as-mathml
+ value block-type prefix dir)))
+ (t
+ (error "Unknown conversion process %s for LaTeX fragments"
+ processing-type)))))))))))
(defun org-create-math-formula (latex-frag &optional mathml-file)
"Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
@@ -19216,22 +19334,24 @@ inspection."
(region-beginning) (region-end)))))
(read-string "LaTeX Fragment: " frag nil frag))))
(unless latex-frag (user-error "Invalid LaTeX fragment"))
- (let* ((tmp-in-file (file-relative-name
- (make-temp-name (expand-file-name "ltxmathml-in"))))
- (ignore (write-region latex-frag nil tmp-in-file))
+ (let* ((tmp-in-file
+ (let ((file (file-relative-name
+ (make-temp-name (expand-file-name "ltxmathml-in")))))
+ (write-region latex-frag nil file)
+ file))
(tmp-out-file (file-relative-name
(make-temp-name (expand-file-name "ltxmathml-out"))))
(cmd (format-spec
org-latex-to-mathml-convert-command
`((?j . ,(and org-latex-to-mathml-jar-file
- (shell-quote-argument
- (expand-file-name
- org-latex-to-mathml-jar-file))))
+ (shell-quote-argument
+ (expand-file-name
+ org-latex-to-mathml-jar-file))))
(?I . ,(shell-quote-argument tmp-in-file))
(?i . ,latex-frag)
(?o . ,(shell-quote-argument tmp-out-file)))))
mathml shell-command-output)
- (when (org-called-interactively-p 'any)
+ (when (called-interactively-p 'any)
(unless (org-format-latex-mathml-available-p)
(user-error "LaTeX to MathML converter not configured")))
(message "Running %s" cmd)
@@ -19255,7 +19375,7 @@ inspection."
(concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml))
(when mathml-file
(write-region mathml nil mathml-file))
- (when (org-called-interactively-p 'any)
+ (when (called-interactively-p 'any)
(message mathml)))
((message "LaTeX to MathML conversion failed")
(message shell-command-output)))
@@ -19294,31 +19414,6 @@ inspection."
;; Failed conversion. Return the LaTeX fragment verbatim
latex-frag)))
-(defun org-create-formula-image (string tofile options buffer &optional type)
- "Create an image from LaTeX source using dvipng or convert.
-This function calls either `org-create-formula-image-with-dvipng'
-or `org-create-formula-image-with-imagemagick' depending on the
-value of `org-latex-create-formula-image-program' or on the value
-of the optional TYPE variable.
-
-Note: ultimately these two function should be combined as they
-share a good deal of logic."
- (org-check-external-command
- "latex" "needed to convert LaTeX fragments to images")
- (funcall
- (case (or type org-latex-create-formula-image-program)
- (dvipng
- (org-check-external-command
- "dvipng" "needed to convert LaTeX fragments to images")
- #'org-create-formula-image-with-dvipng)
- (imagemagick
- (org-check-external-command
- "convert" "you need to install imagemagick")
- #'org-create-formula-image-with-imagemagick)
- (t (error
- "Invalid value of `org-latex-create-formula-image-program'")))
- string tofile options buffer))
-
(declare-function org-export-get-backend "ox" (name))
(declare-function org-export--get-global-options "ox" (&optional backend))
(declare-function org-export--get-inbuffer-options "ox" (&optional backend))
@@ -19349,133 +19444,105 @@ horizontal and vertical directions."
(/ (display-mm-height) 25.4)))
(error "Attempt to calculate the dpi of a non-graphic display")))
-;; This function borrows from Ganesh Swami's latex2png.el
-(defun org-create-formula-image-with-dvipng (string tofile options buffer)
- "This calls dvipng."
- (require 'ox-latex)
- (let* ((tmpdir (if (featurep 'xemacs)
- (temp-directory)
- temporary-file-directory))
+(defun org-create-formula-image
+ (string tofile options buffer &optional processing-type)
+ "Create an image from LaTeX source using external processes.
+
+The LaTeX STRING is saved to a temporary LaTeX file, then
+converted to an image file by process PROCESSING-TYPE defined in
+`org-preview-latex-process-alist'. A nil value defaults to
+`org-preview-latex-default-process'.
+
+The generated image file is eventually moved to TOFILE.
+
+The OPTIONS argument controls the size, foreground color and
+background color of the generated image.
+
+When BUFFER non-nil, this function is used for LaTeX previewing.
+Otherwise, it is used to deal with LaTeX snippets showed in
+a HTML file."
+ (let* ((processing-type (or processing-type
+ org-preview-latex-default-process))
+ (processing-info
+ (cdr (assq processing-type org-preview-latex-process-alist)))
+ (programs (plist-get processing-info :programs))
+ (error-message (or (plist-get processing-info :message) ""))
+ (use-xcolor (plist-get processing-info :use-xcolor))
+ (image-input-type (plist-get processing-info :image-input-type))
+ (image-output-type (plist-get processing-info :image-output-type))
+ (post-clean (or (plist-get processing-info :post-clean)
+ '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log"
+ ".svg" ".png" ".jpg" ".jpeg" ".out")))
+ (latex-header (or (plist-get processing-info :latex-header)
+ (org-create-formula--latex-header)))
+ (latex-compiler (plist-get processing-info :latex-compiler))
+ (image-converter (plist-get processing-info :image-converter))
+ (tmpdir temporary-file-directory)
(texfilebase (make-temp-name
(expand-file-name "orgtex" tmpdir)))
(texfile (concat texfilebase ".tex"))
- (dvifile (concat texfilebase ".dvi"))
- (pngfile (concat texfilebase ".png"))
- (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
- ;; This assumes that the display has the same pixel width in
- ;; the horizontal and vertical directions
- (dpi (number-to-string (* scale (if buffer (org--get-display-dpi) 120))))
+ (font-height (face-attribute 'default :height nil))
+ (image-size-adjust (or (plist-get processing-info :image-size-adjust)
+ '(1.0 . 1.0)))
+ (scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust))
+ (or (plist-get options (if buffer :scale :html-scale)) 1.0)))
+ (dpi (* scale (floor (if buffer font-height 140.0))))
(fg (or (plist-get options (if buffer :foreground :html-foreground))
"Black"))
(bg (or (plist-get options (if buffer :background :html-background))
- "Transparent")))
- (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))
- (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg))))
- (if (eq bg 'default) (setq bg (org-dvipng-color :background))
- (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg))))
- (let ((latex-header (org-create-formula--latex-header)))
+ "Transparent"))
+ (log-buf (get-buffer-create "*Org Preview LaTeX Output*"))
+ (resize-mini-windows nil)) ;Fix Emacs flicker when creating image.
+ (dolist (program programs)
+ (org-check-external-command program error-message))
+ (if use-xcolor
+ (progn (if (eq fg 'default)
+ (setq fg (org-latex-color :foreground))
+ (setq fg (org-latex-color-format fg)))
+ (if (eq bg 'default)
+ (setq bg (org-latex-color :background))
+ (setq bg (org-latex-color-format
+ (if (string= bg "Transparent") "white" bg))))
+ (with-temp-file texfile
+ (insert latex-header)
+ (insert "\n\\begin{document}\n"
+ "\\definecolor{fg}{rgb}{" fg "}\n"
+ "\\definecolor{bg}{rgb}{" bg "}\n"
+ "\n\\pagecolor{bg}\n"
+ "\n{\\color{fg}\n"
+ string
+ "\n}\n"
+ "\n\\end{document}\n")))
+ (if (eq fg 'default)
+ (setq fg (org-dvipng-color :foreground))
+ (unless (string= fg "Transparent")
+ (setq fg (org-dvipng-color-format fg))))
+ (if (eq bg 'default)
+ (setq bg (org-dvipng-color :background))
+ (unless (string= bg "Transparent")
+ (setq bg (org-dvipng-color-format bg))))
(with-temp-file texfile
(insert latex-header)
(insert "\n\\begin{document}\n" string "\n\\end{document}\n")))
- (let ((dir default-directory))
- (ignore-errors
- (cd tmpdir)
- (call-process "latex" nil nil nil texfile))
- (cd dir))
- (if (not (file-exists-p dvifile))
- (progn (message "Failed to create dvi file from %s" texfile) nil)
- (ignore-errors
- (if (featurep 'xemacs)
- (call-process "dvipng" nil nil nil
- "-fg" fg "-bg" bg
- "-T" "tight"
- "-o" pngfile
- dvifile)
- (call-process "dvipng" nil nil nil
- "-fg" fg "-bg" bg
- "-D" dpi
- ;;"-x" scale "-y" scale
- "-T" "tight"
- "-o" pngfile
- dvifile)))
- (if (not (file-exists-p pngfile))
- (if org-format-latex-signal-error
- (error "Failed to create png file from %s" texfile)
- (message "Failed to create png file from %s" texfile)
- nil)
- ;; Use the requested file name and clean up
- (copy-file pngfile tofile 'replace)
- (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do
- (if (file-exists-p (concat texfilebase e))
- (delete-file (concat texfilebase e))))
- pngfile))))
-
-(declare-function org-latex-compile "ox-latex" (texfile &optional snippet))
-(defun org-create-formula-image-with-imagemagick (string tofile options buffer)
- "This calls convert, which is included into imagemagick."
- (require 'ox-latex)
- (let* ((tmpdir (if (featurep 'xemacs)
- (temp-directory)
- temporary-file-directory))
- (texfilebase (make-temp-name
- (expand-file-name "orgtex" tmpdir)))
- (texfile (concat texfilebase ".tex"))
- (pdffile (concat texfilebase ".pdf"))
- (pngfile (concat texfilebase ".png"))
- (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
- (dpi (number-to-string (* scale (if buffer (org--get-display-dpi) 120))))
- (fg (or (plist-get options (if buffer :foreground :html-foreground))
- "black"))
- (bg (or (plist-get options (if buffer :background :html-background))
- "white")))
- (if (eq fg 'default) (setq fg (org-latex-color :foreground))
- (setq fg (org-latex-color-format fg)))
- (if (eq bg 'default) (setq bg (org-latex-color :background))
- (setq bg (org-latex-color-format
- (if (string= bg "Transparent") "white" bg))))
- (let ((latex-header (org-create-formula--latex-header)))
- (with-temp-file texfile
- (insert latex-header)
- (insert "\n\\begin{document}\n"
- "\\definecolor{fg}{rgb}{" fg "}\n"
- "\\definecolor{bg}{rgb}{" bg "}\n"
- "\n\\pagecolor{bg}\n"
- "\n{\\color{fg}\n"
- string
- "\n}\n"
- "\n\\end{document}\n")))
- (org-latex-compile texfile t)
- (if (not (file-exists-p pdffile))
- (progn (message "Failed to create pdf file from %s" texfile) nil)
- (ignore-errors
- (if (featurep 'xemacs)
- (call-process "convert" nil nil nil
- "-density" "96"
- "-trim"
- "-antialias"
- pdffile
- "-quality" "100"
- ;; "-sharpen" "0x1.0"
- pngfile)
- (call-process "convert" nil nil nil
- "-density" dpi
- "-trim"
- "-antialias"
- pdffile
- "-quality" "100"
- ;; "-sharpen" "0x1.0"
- pngfile)))
- (if (not (file-exists-p pngfile))
- (if org-format-latex-signal-error
- (error "Failed to create png file from %s" texfile)
- (message "Failed to create png file from %s" texfile)
- nil)
- ;; Use the requested file name and clean up
- (copy-file pngfile tofile 'replace)
- (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do
- (if (file-exists-p (concat texfilebase e))
- (delete-file (concat texfilebase e))))
- pngfile))))
+
+ (let* ((err-msg (format "Please adjust '%s' part of \
+`org-preview-latex-process-alist'."
+ processing-type))
+ (image-input-file
+ (org-compile-file
+ texfile latex-compiler image-input-type err-msg log-buf))
+ (image-output-file
+ (org-compile-file
+ image-input-file image-converter image-output-type err-msg log-buf
+ `((?F . ,(shell-quote-argument fg))
+ (?B . ,(shell-quote-argument bg))
+ (?D . ,(shell-quote-argument (format "%s" dpi)))
+ (?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0))))))))
+ (copy-file image-output-file tofile 'replace)
+ (dolist (e post-clean)
+ (when (file-exists-p (concat texfilebase e))
+ (delete-file (concat texfilebase e))))
+ image-output-file)))
(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
"Fill a LaTeX header template TPL.
@@ -19499,22 +19566,22 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
(setq rpl (if (or (match-end 1) (not def-pkg))
"" (org-latex-packages-to-string def-pkg snippets-p t))
tpl (replace-match rpl t t tpl))
- (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
+ (when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
(if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl)
(setq rpl (if (or (match-end 1) (not pkg))
"" (org-latex-packages-to-string pkg snippets-p t))
tpl (replace-match rpl t t tpl))
- (if pkg (setq end
- (concat end "\n"
- (org-latex-packages-to-string pkg snippets-p)))))
+ (when pkg (setq end
+ (concat end "\n"
+ (org-latex-packages-to-string pkg snippets-p)))))
(if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl)
(setq rpl (if (or (match-end 1) (not extra))
"" (concat extra "\n"))
tpl (replace-match rpl t t tpl))
- (if (and extra (string-match "\\S-" extra))
- (setq end (concat end "\n" extra))))
+ (when (and extra (string-match "\\S-" extra))
+ (setq end (concat end "\n" extra))))
(if (string-match "\\S-" end)
(concat tpl "\n" end)
@@ -19538,35 +19605,21 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
(defun org-dvipng-color (attr)
"Return a RGB color specification for dvipng."
- (apply 'format "rgb %s %s %s"
- (mapcar 'org-normalize-color
- (if (featurep 'xemacs)
- (color-rgb-components
- (face-property 'default
- (cond ((eq attr :foreground) 'foreground)
- ((eq attr :background) 'background))))
- (color-values (face-attribute 'default attr nil))))))
+ (org-dvipng-color-format (face-attribute 'default attr nil)))
(defun org-dvipng-color-format (color-name)
"Convert COLOR-NAME to a RGB color value for dvipng."
- (apply 'format "rgb %s %s %s"
+ (apply #'format "rgb %s %s %s"
(mapcar 'org-normalize-color
(color-values color-name))))
(defun org-latex-color (attr)
"Return a RGB color for the LaTeX color package."
- (apply 'format "%s,%s,%s"
- (mapcar 'org-normalize-color
- (if (featurep 'xemacs)
- (color-rgb-components
- (face-property 'default
- (cond ((eq attr :foreground) 'foreground)
- ((eq attr :background) 'background))))
- (color-values (face-attribute 'default attr nil))))))
+ (org-latex-color-format (face-attribute 'default attr nil)))
(defun org-latex-color-format (color-name)
"Convert COLOR-NAME to a RGB color value."
- (apply 'format "%s,%s,%s"
+ (apply #'format "%s,%s,%s"
(mapcar 'org-normalize-color
(color-values color-name))))
@@ -19578,8 +19631,7 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
;; Image display
-(defvar org-inline-image-overlays nil)
-(make-variable-buffer-local 'org-inline-image-overlays)
+(defvar-local org-inline-image-overlays nil)
(defun org-toggle-inline-images (&optional include-linked)
"Toggle the display of inline images.
@@ -19588,10 +19640,10 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
(if org-inline-image-overlays
(progn
(org-remove-inline-images)
- (when (org-called-interactively-p 'interactive)
+ (when (called-interactively-p 'interactive)
(message "Inline image display turned off")))
(org-display-inline-images include-linked)
- (when (org-called-interactively-p 'interactive)
+ (when (called-interactively-p 'interactive)
(message (if org-inline-image-overlays
(format "%d images displayed inline"
(length org-inline-image-overlays))
@@ -19634,7 +19686,7 @@ boundaries."
(org-with-wide-buffer
(goto-char (or beg (point-min)))
(let ((case-fold-search t)
- (file-extension-re (org-image-file-name-regexp)))
+ (file-extension-re (image-file-name-regexp)))
(while (re-search-forward "[][]\\[\\(?:file\\|[./~]\\)" end t)
(let ((link (save-match-data (org-element-context))))
;; Check if we're at an inline image.
@@ -19644,8 +19696,8 @@ boundaries."
(let ((parent (org-element-property :parent link)))
(or (not (eq (org-element-type parent) 'link))
(not (cdr (org-element-contents parent)))))
- (org-string-match-p file-extension-re
- (org-element-property :path link)))
+ (string-match-p file-extension-re
+ (org-element-property :path link)))
(let ((file (expand-file-name
(org-link-unescape
(org-element-property :path link)))))
@@ -19716,10 +19768,7 @@ boundaries."
(list 'org-display-inline-remove-overlay))
(push ov org-inline-image-overlays)))))))))))))))
-(define-obsolete-function-alias
- 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3")
-
-(defun org-display-inline-remove-overlay (ov after beg end &optional len)
+(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."
(let ((inhibit-modification-hooks t))
(when (and ov after)
@@ -19729,7 +19778,7 @@ boundaries."
(defun org-remove-inline-images ()
"Remove inline display of images."
(interactive)
- (mapc 'delete-overlay org-inline-image-overlays)
+ (mapc #'delete-overlay org-inline-image-overlays)
(setq org-inline-image-overlays nil))
;;;; Key bindings
@@ -19751,6 +19800,7 @@ boundaries."
'org-next-visible-heading)
(define-key org-mode-map [remap outline-previous-visible-heading]
'org-previous-visible-heading)
+(define-key org-mode-map [remap show-children] 'org-show-children)
;; Outline functions from `outline-mode-prefix-map' that can not
;; be remapped in Org:
@@ -19763,13 +19813,10 @@ boundaries."
;; | Outline function | key binding | Org replacement |
;; |------------------------------------+-------------+--------------------------|
-;; | `outline-next-visible-heading' | `C-c C-n' | better: skip inlinetasks |
-;; | `outline-previous-visible-heading' | `C-c C-p' | better: skip inlinetasks |
;; | `outline-up-heading' | `C-c C-u' | still same function |
;; | `outline-move-subtree-up' | overridden | better: org-shiftup |
;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
;; | `show-entry' | overridden | no replacement |
-;; | `show-children' | `C-c C-i' | visibility cycling |
;; | `show-branches' | `C-c C-k' | still same function |
;; | `show-subtree' | overridden | visibility cycling |
;; | `show-all' | overridden | no replacement |
@@ -19789,8 +19836,7 @@ boundaries."
(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
(org-defkey org-mode-map "\M-\t" #'pcomplete)
;; The following line is necessary under Suse GNU/Linux
-(unless (featurep 'xemacs)
- (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
+(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)
(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
(define-key org-mode-map [backtab] 'org-shifttab)
@@ -19823,17 +19869,14 @@ boundaries."
;; Babel keys
(define-key org-mode-map org-babel-key-prefix org-babel-map)
-(mapc (lambda (pair)
- (define-key org-babel-map (car pair) (cdr pair)))
- org-babel-key-bindings)
+(dolist (pair org-babel-key-bindings)
+ (define-key org-babel-map (car pair) (cdr pair)))
;;; Extra keys for tty access.
;; We only set them when really needed because otherwise the
;; menus don't show the simple keys
-(when (or org-use-extra-keys
- (featurep 'xemacs) ;; because XEmacs supports multi-device stuff
- (not window-system))
+(when (or org-use-extra-keys (not window-system))
(org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down)
(org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading)
(org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return)
@@ -19992,7 +20035,7 @@ boundaries."
(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort)
(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
-(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock)
+(org-defkey org-mode-map "\C-c\C-xi" 'org-columns-insert-dblock)
(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
@@ -20011,10 +20054,6 @@ boundaries."
(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation)
-(when (featurep 'xemacs)
- (org-defkey org-mode-map 'button3 'popup-mode-menu))
-
-
(defconst org-speed-commands-default
'(
("Outline Navigation")
@@ -20095,10 +20134,10 @@ boundaries."
(user-error "Speed commands are not activated, customize `org-use-speed-commands'")
(with-output-to-temp-buffer "*Help*"
(princ "User-defined Speed commands\n===========================\n")
- (mapc 'org-print-speed-command org-speed-commands-user)
+ (mapc #'org-print-speed-command org-speed-commands-user)
(princ "\n")
(princ "Built-in Speed commands\n=======================\n")
- (mapc 'org-print-speed-command org-speed-commands-default))
+ (mapc #'org-print-speed-command org-speed-commands-default))
(with-current-buffer "*Help*"
(setq truncate-lines t))))
@@ -20117,9 +20156,6 @@ If not, return to the original position and throw an error."
(defvar org-table-auto-blank-field) ; defined in org-table.el
(defvar org-speed-command nil)
-(define-obsolete-function-alias
- 'org-speed-command-default-hook 'org-speed-command-activate "24.3")
-
(defun org-speed-command-activate (keys)
"Hook for activating single-letter speed commands.
`org-speed-commands-default' specifies a minimal command set.
@@ -20130,9 +20166,6 @@ Use `org-speed-commands-user' for further customization."
(cdr (assoc keys (append org-speed-commands-user
org-speed-commands-default)))))
-(define-obsolete-function-alias
- 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3")
-
(defun org-babel-speed-command-activate (keys)
"Hook for activating single-letter code block commands."
(when (and (bolp) (looking-at org-babel-src-block-regexp))
@@ -20181,7 +20214,7 @@ overwritten, and the table is not marked as requiring realignment."
(t (let (org-use-speed-commands)
(call-interactively 'org-self-insert-command)))))
((and
- (org-table-p)
+ (org-at-table-p)
(progn
;; Check if we blank the field, and if that triggers align.
(and (featurep 'org-table) org-table-auto-blank-field
@@ -20204,71 +20237,75 @@ overwritten, and the table is not marked as requiring realignment."
(setq org-table-may-need-update t)
(self-insert-command N)
(org-fix-tags-on-the-fly)
- (if org-self-insert-cluster-for-undo
- (if (not (eq last-command 'org-self-insert-command))
+ (when org-self-insert-cluster-for-undo
+ (if (not (eq last-command 'org-self-insert-command))
+ (setq org-self-insert-command-undo-counter 1)
+ (if (>= org-self-insert-command-undo-counter 20)
(setq org-self-insert-command-undo-counter 1)
- (if (>= org-self-insert-command-undo-counter 20)
- (setq org-self-insert-command-undo-counter 1)
- (and (> org-self-insert-command-undo-counter 0)
- buffer-undo-list (listp buffer-undo-list)
- (not (cadr buffer-undo-list)) ; remove nil entry
- (setcdr buffer-undo-list (cddr buffer-undo-list)))
- (setq org-self-insert-command-undo-counter
- (1+ org-self-insert-command-undo-counter))))))))
+ (and (> org-self-insert-command-undo-counter 0)
+ buffer-undo-list (listp buffer-undo-list)
+ (not (cadr buffer-undo-list)) ; remove nil entry
+ (setcdr buffer-undo-list (cddr buffer-undo-list)))
+ (setq org-self-insert-command-undo-counter
+ (1+ org-self-insert-command-undo-counter))))))))
(defun org-check-before-invisible-edit (kind)
"Check is editing if kind KIND would be dangerous with invisible text around.
The detailed reaction depends on the user option `org-catch-invisible-edits'."
;; First, try to get out of here as quickly as possible, to reduce overhead
- (if (and org-catch-invisible-edits
- (or (not (boundp 'visible-mode)) (not visible-mode))
- (or (get-char-property (point) 'invisible)
- (get-char-property (max (point-min) (1- (point))) 'invisible)))
- ;; OK, we need to take a closer look
- (let* ((invisible-at-point (get-char-property (point) 'invisible))
- (invisible-before-point (if (bobp) nil (get-char-property
- (1- (point)) 'invisible)))
- (border-and-ok-direction
- (or
- ;; Check if we are acting predictably before invisible text
- (and invisible-at-point (not invisible-before-point)
- (memq kind '(insert delete-backward)))
- ;; Check if we are acting predictably after invisible text
- ;; This works not well, and I have turned it off. It seems
- ;; better to always show and stop after invisible text.
- ;; (and (not invisible-at-point) invisible-before-point
- ;; (memq kind '(insert delete)))
- )))
- (when (or (memq invisible-at-point '(outline org-hide-block t))
- (memq invisible-before-point '(outline org-hide-block t)))
- (if (eq org-catch-invisible-edits 'error)
- (user-error "Editing in invisible areas is prohibited, make them visible first"))
- (if (and org-custom-properties-overlays
- (y-or-n-p "Display invisible properties in this buffer? "))
- (org-toggle-custom-properties-visibility)
- ;; Make the area visible
- (save-excursion
- (if invisible-before-point
- (goto-char (previous-single-char-property-change
- (point) 'invisible)))
- (outline-show-subtree))
- (cond
- ((eq org-catch-invisible-edits 'show)
- ;; That's it, we do the edit after showing
- (message
- "Unfolding invisible region around point before editing")
- (sit-for 1))
- ((and (eq org-catch-invisible-edits 'smart)
- border-and-ok-direction)
- (message "Unfolding invisible region around point before editing"))
- (t
- ;; Don't do the edit, make the user repeat it in full visibility
- (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
+ (when (and org-catch-invisible-edits
+ (or (not (boundp 'visible-mode)) (not visible-mode))
+ (or (get-char-property (point) 'invisible)
+ (get-char-property (max (point-min) (1- (point))) 'invisible)))
+ ;; OK, we need to take a closer look
+ (let* ((invisible-at-point (get-char-property (point) 'invisible))
+ (invisible-before-point (unless (bobp) (get-char-property
+ (1- (point)) 'invisible)))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible text
+ (and invisible-at-point (not invisible-before-point)
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+ (when (or (memq invisible-at-point '(outline org-hide-block t))
+ (memq invisible-before-point '(outline org-hide-block t)))
+ (when (eq org-catch-invisible-edits 'error)
+ (user-error "Editing in invisible areas is prohibited, make them visible first"))
+ (if (and org-custom-properties-overlays
+ (y-or-n-p "Display invisible properties in this buffer? "))
+ (org-toggle-custom-properties-visibility)
+ ;; Make the area visible
+ (save-excursion
+ (when invisible-before-point
+ (goto-char (previous-single-char-property-change
+ (point) 'invisible)))
+ (outline-show-subtree))
+ (cond
+ ((eq org-catch-invisible-edits 'show)
+ ;; That's it, we do the edit after showing
+ (message
+ "Unfolding invisible region around point before editing")
+ (sit-for 1))
+ ((and (eq org-catch-invisible-edits 'smart)
+ border-and-ok-direction)
+ (message "Unfolding invisible region around point before editing"))
+ (t
+ ;; Don't do the edit, make the user repeat it in full visibility
+ (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
(defun org-fix-tags-on-the-fly ()
- (when (and (equal (char-after (point-at-bol)) ?*)
+ "Align tags in headline at point.
+Unlike to `org-set-tags', it ignores region and sorting."
+ (when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit
(org-at-heading-p))
- (org-align-tags-here org-tags-column)))
+ (let ((org-ignore-region t)
+ (org-tags-sort-function nil))
+ (org-set-tags nil t))))
(defun org-delete-backward-char (N)
"Like `delete-backward-char', insert whitespace at field end in tables.
@@ -20279,7 +20316,7 @@ because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
(org-check-before-invisible-edit 'delete-backward)
- (if (and (org-table-p)
+ (if (and (org-at-table-p)
(eq N 1)
(string-match "|" (buffer-substring (point-at-bol) (point)))
(looking-at ".*?|"))
@@ -20287,14 +20324,13 @@ because, in this case the deletion might narrow the column."
(noalign (looking-at "[^|\n\r]* |"))
(c org-table-may-need-update))
(backward-delete-char N)
- (if (not overwrite-mode)
- (progn
- (skip-chars-forward "^|")
- (insert " ")
- (goto-char (1- pos))))
+ (unless overwrite-mode
+ (skip-chars-forward "^|")
+ (insert " ")
+ (goto-char (1- pos)))
;; noalign: if there were two spaces at the end, this field
;; does not determine the width of the column.
- (if noalign (setq org-table-may-need-update c)))
+ (when noalign (setq org-table-may-need-update c)))
(backward-delete-char N)
(org-fix-tags-on-the-fly))))
@@ -20307,7 +20343,7 @@ because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
(org-check-before-invisible-edit 'delete)
- (if (and (org-table-p)
+ (if (and (org-at-table-p)
(not (bolp))
(not (= (char-after) ?|))
(eq N 1))
@@ -20320,12 +20356,12 @@ because, in this case the deletion might narrow the column."
(goto-char pos)
;; noalign: if there were two spaces at the end, this field
;; does not determine the width of the column.
- (if noalign (setq org-table-may-need-update c)))
+ (when noalign (setq org-table-may-need-update c)))
(delete-char N))
(delete-char N)
(org-fix-tags-on-the-fly))))
-;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
+;; Make `delete-selection-mode' work with Org mode and Orgtbl mode
(put 'org-self-insert-command 'delete-selection
(lambda ()
(not (run-hook-with-args-until-success
@@ -20344,7 +20380,7 @@ because, in this case the deletion might narrow the column."
(put 'org-delete-char 'flyspell-delayed t)
(put 'org-delete-backward-char 'flyspell-delayed t)
-;; Make pabbrev-mode expand after org-mode commands
+;; Make pabbrev-mode expand after Org mode commands
(put 'org-self-insert-command 'pabbrev-expand-after-command t)
(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
@@ -20354,9 +20390,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(let (new old)
(while commands
(setq old (pop commands) new (pop commands))
- (if (fboundp 'command-remapping)
- (org-defkey map (vector 'remap old) new)
- (substitute-key-definition old new map global-map)))))
+ (org-defkey map (vector 'remap old) new))))
(defun org-transpose-words ()
"Transpose words for Org.
@@ -20498,7 +20532,7 @@ See `org-ctrl-c-ctrl-c-hook' for more information.")
(defun org-shiftselect-error ()
"Throw an error because Shift-Cursor command was applied in wrong context."
(if (and (boundp 'shift-select-mode) shift-select-mode)
- (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'")
+ (user-error "To use shift-selection with Org mode, customize `org-support-shift-select'")
(user-error "This command works only in special context like headlines or timestamps")))
(defun org-call-for-shift-select (cmd)
@@ -20553,7 +20587,7 @@ individual commands for more information."
(call-interactively 'org-indent-item-tree))
(t (org-modifier-cursor-error))))
-(defun org-shiftmetaup (&optional arg)
+(defun org-shiftmetaup (&optional _arg)
"Drag the line at point up.
In a table, kill the current row.
On a clock timestamp, update the value of the timestamp like `S-<up>'
@@ -20567,7 +20601,7 @@ Everywhere else, drag the line at point up."
(call-interactively 'org-timestamp-up)))
(t (call-interactively 'org-drag-line-backward))))
-(defun org-shiftmetadown (&optional arg)
+(defun org-shiftmetadown (&optional _arg)
"Drag the line at point down.
In a table, insert an empty row at the current line.
On a clock timestamp, update the value of the timestamp like `S-<down>'
@@ -20585,7 +20619,7 @@ Everywhere else, drag the line at point down."
(user-error
"Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
-(defun org-metaleft (&optional arg)
+(defun org-metaleft (&optional _arg)
"Promote heading, list item at point or move table column left.
Calls `org-do-promote', `org-outdent-item' or `org-table-move-column',
@@ -20619,13 +20653,13 @@ and returns at first non-nil value."
(call-interactively 'org-outdent-item))
(t (call-interactively 'backward-word))))
-(defun org-metaright (&optional arg)
+(defun org-metaright (&optional _arg)
"Demote heading, list item at point or move table column right.
In front of a drawer or a block keyword, indent it correctly.
Calls `org-do-demote', `org-indent-item', `org-table-move-column',
-`org-indnet-drawer' or `org-indent-block' depending on context.
+`org-indent-drawer' or `org-indent-block' depending on context.
With no specific context, calls the Emacs default `forward-word'.
See the individual commands for more information.
@@ -20680,11 +20714,11 @@ this function returns t, nil otherwise."
(goto-char (point-at-eol))
(setq end (max end (point)))
(while (re-search-forward re end t)
- (if (get-char-property (match-beginning 0) 'invisible)
- (throw 'exit t))))
+ (when (get-char-property (match-beginning 0) 'invisible)
+ (throw 'exit t))))
nil))))
-(defun org-metaup (&optional arg)
+(defun org-metaup (&optional _arg)
"Move subtree up or move table row up.
Calls `org-move-subtree-up' or `org-table-move-row' or
`org-move-item-up', depending on context. See the individual commands
@@ -20706,7 +20740,7 @@ for more information."
((org-at-item-p) (call-interactively 'org-move-item-up))
(t (org-drag-element-backward))))
-(defun org-metadown (&optional arg)
+(defun org-metadown (&optional _arg)
"Move subtree down or move table row down.
Calls `org-move-subtree-down' or `org-table-move-row' or
`org-move-item-down', depending on context. See the individual
@@ -20952,19 +20986,19 @@ this numeric value."
(defun org-copy-special ()
"Copy region in table or copy current subtree.
-Calls `org-table-copy' or `org-copy-subtree', depending on context.
-See the individual commands for more information."
+Calls `org-table-copy-region' or `org-copy-subtree', depending on
+context. See the individual commands for more information."
(interactive)
(call-interactively
- (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
+ (if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree)))
(defun org-cut-special ()
"Cut region in table or cut current subtree.
-Calls `org-table-copy' or `org-cut-subtree', depending on context.
-See the individual commands for more information."
+Calls `org-table-cut-region' or `org-cut-subtree', depending on
+context. See the individual commands for more information."
(interactive)
(call-interactively
- (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
+ (if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree)))
(defun org-paste-special (arg)
"Paste rectangular region into table, or past subtree relative to level.
@@ -20975,11 +21009,6 @@ See the individual commands for more information."
(org-table-paste-rectangle)
(org-paste-subtree arg)))
-(defsubst org-in-fixed-width-region-p ()
- "Is point in a fixed-width region?"
- (save-match-data
- (eq 'fixed-width (org-element-type (org-element-at-point)))))
-
(defun org-edit-special (&optional arg)
"Call a special editor for the element at point.
When at a table, call the formula editor with `org-table-edit-formulas'.
@@ -20992,23 +21021,22 @@ On a link, call `ffap' to visit the link at point.
Otherwise, return a user error."
(interactive "P")
(let ((element (org-element-at-point)))
- (assert (not buffer-read-only) nil
- "Buffer is read-only: %s" (buffer-name))
- (case (org-element-type element)
- (src-block
+ (barf-if-buffer-read-only)
+ (pcase (org-element-type element)
+ (`src-block
(if (not arg) (org-edit-src-code)
- (let* ((info (org-babel-get-src-block-info))
- (lang (nth 0 info))
- (params (nth 2 info))
- (session (cdr (assq :session params))))
- (if (not session) (org-edit-src-code)
- ;; At a src-block with a session and function called with
- ;; an ARG: switch to the buffer related to the inferior
- ;; process.
- (switch-to-buffer
+ (let* ((info (org-babel-get-src-block-info))
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (session (cdr (assq :session params))))
+ (if (not session) (org-edit-src-code)
+ ;; At a src-block with a session and function called with
+ ;; an ARG: switch to the buffer related to the inferior
+ ;; process.
+ (switch-to-buffer
(funcall (intern (concat "org-babel-prep-session:" lang))
session params))))))
- (keyword
+ (`keyword
(if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE"))
(org-open-link-from-string
(format "[[%s]]"
@@ -21022,23 +21050,24 @@ Otherwise, return a user error."
(match-string 0 value))
(t (user-error "No valid file specified")))))))
(user-error "No special environment to edit here")))
- (table
+ (`table
(if (eq (org-element-property :type element) 'table.el)
(org-edit-table.el)
(call-interactively 'org-table-edit-formulas)))
;; Only Org tables contain `table-row' type elements.
- (table-row (call-interactively 'org-table-edit-formulas))
- (example-block (org-edit-src-code))
- (export-block (org-edit-export-block))
- (fixed-width (org-edit-fixed-width-region))
- (otherwise
+ (`table-row (call-interactively 'org-table-edit-formulas))
+ (`example-block (org-edit-src-code))
+ (`export-block (org-edit-export-block))
+ (`fixed-width (org-edit-fixed-width-region))
+ (_
;; No notable element at point. Though, we may be at a link or
;; a footnote reference, which are objects. Thus, scan deeper.
(let ((context (org-element-context element)))
- (case (org-element-type context)
- (link (call-interactively #'ffap))
- (footnote-reference (org-edit-footnote-reference))
- (t (user-error "No special environment to edit here"))))))))
+ (pcase (org-element-type context)
+ (`footnote-reference (org-edit-footnote-reference))
+ (`inline-src-block (org-edit-inline-src-code))
+ (`link (call-interactively #'ffap))
+ (_ (user-error "No special environment to edit here"))))))))
(defvar org-table-coordinate-overlays) ; defined in org-table.el
(defun org-ctrl-c-ctrl-c (&optional arg)
@@ -21087,180 +21116,196 @@ This command does many different things, depending on context:
inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
(interactive "P")
(cond
- ((or (and (boundp 'org-clock-overlays) org-clock-overlays)
- org-occur-highlights)
- (and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
+ ((or (bound-and-true-p org-clock-overlays) org-occur-highlights)
+ (when (boundp 'org-clock-overlays) (org-clock-remove-overlays))
(org-remove-occur-highlights)
(message "Temporary highlights/overlays removed from current buffer"))
- ((and (local-variable-p 'org-finish-function (current-buffer))
+ ((and (local-variable-p 'org-finish-function)
(fboundp org-finish-function))
(funcall org-finish-function))
+ ((org-babel-hash-at-point))
((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
+ ((save-excursion (beginning-of-line) (looking-at-p "[ \t]*$"))
+ (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
+ (user-error
+ (substitute-command-keys
+ "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))
(t
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))
- (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
- (user-error "C-c C-c can do nothing useful at this location"))
- (let* ((context (org-element-context))
- (type (org-element-type context)))
- (case type
- ;; When at a link, act according to the parent instead.
- (link (setq context (org-element-property :parent context))
- (setq type (org-element-type context)))
- ;; Unsupported object types: refer to the first supported
- ;; element or object containing it.
- ((bold code entity export-snippet inline-babel-call inline-src-block
- italic latex-fragment line-break macro strike-through subscript
- superscript underline verbatim)
- (setq context
- (org-element-lineage
- context '(radio-target paragraph verse-block table-cell)))))
- ;; For convenience: at the first line of a paragraph on the
- ;; same line as an item, apply function on that item instead.
- (when (eq type 'paragraph)
- (let ((parent (org-element-property :parent context)))
- (when (and (eq (org-element-type parent) 'item)
- (= (line-beginning-position)
- (org-element-property :begin parent)))
- (setq context parent type 'item))))
- ;; Act according to type of element or object at point.
- (case type
- (clock (org-clock-update-time-maybe))
- (dynamic-block
- (save-excursion
- (goto-char (org-element-property :post-affiliated context))
- (org-update-dblock)))
- (footnote-definition
+ (let* ((context
+ (org-element-lineage
+ (org-element-context)
+ ;; Limit to supported contexts.
+ '(babel-call clock dynamic-block footnote-definition
+ footnote-reference inline-babel-call inline-src-block
+ item keyword node-property paragraph plain-list
+ property-drawer radio-target src-block
+ statistics-cookie table table-cell table-row
+ timestamp)
+ t))
+ (type (org-element-type context)))
+ ;; For convenience: at the first line of a paragraph on the same
+ ;; line as an item, apply function on that item instead.
+ (when (eq type 'paragraph)
+ (let ((parent (org-element-property :parent context)))
+ (when (and (eq (org-element-type parent) 'item)
+ (= (line-beginning-position)
+ (org-element-property :begin parent)))
+ (setq context parent)
+ (setq type 'item))))
+ ;; Act according to type of element or object at point.
+ (pcase type
+ ((or `babel-call `inline-babel-call)
+ (let ((info (org-babel-lob-get-info context)))
+ (when info (org-babel-execute-src-block nil info))))
+ (`clock (org-clock-update-time-maybe))
+ (`dynamic-block
+ (save-excursion
(goto-char (org-element-property :post-affiliated context))
- (call-interactively 'org-footnote-action))
- (footnote-reference (call-interactively 'org-footnote-action))
- ((headline inlinetask)
- (save-excursion (goto-char (org-element-property :begin context))
- (call-interactively 'org-set-tags)))
- (item
- ;; At an item: a double C-u set checkbox to "[-]"
- ;; unconditionally, whereas a single one will toggle its
- ;; presence. Without a universal argument, if the item
- ;; has a checkbox, toggle it. Otherwise repair the list.
- (let* ((box (org-element-property :checkbox context))
- (struct (org-element-property :structure context))
- (old-struct (copy-tree struct))
- (parents (org-list-parents-alist struct))
- (prevs (org-list-prevs-alist struct))
- (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
- (org-list-set-checkbox
- (org-element-property :begin context) struct
- (cond ((equal arg '(16)) "[-]")
- ((and (not box) (equal arg '(4))) "[ ]")
- ((or (not box) (equal arg '(4))) nil)
- ((eq box 'on) "[ ]")
- (t "[X]")))
- ;; Mimic `org-list-write-struct' but with grabbing
- ;; a return value from `org-list-struct-fix-box'.
- (org-list-struct-fix-ind struct parents 2)
- (org-list-struct-fix-item-end struct)
- (org-list-struct-fix-bul struct prevs)
- (org-list-struct-fix-ind struct parents)
- (let ((block-item
- (org-list-struct-fix-box struct parents prevs orderedp)))
- (if (and box (equal struct old-struct))
- (if (equal arg '(16))
- (message "Checkboxes already reset")
- (user-error "Cannot toggle this checkbox: %s"
- (if (eq box 'on)
- "all subitems checked"
- "unchecked subitems")))
- (org-list-struct-apply-struct struct old-struct)
- (org-update-checkbox-count-maybe))
- (when block-item
- (message "Checkboxes were removed due to empty box at line %d"
- (org-current-line block-item))))))
- (keyword
- (let ((org-inhibit-startup-visibility-stuff t)
- (org-startup-align-all-tables nil))
- (when (boundp 'org-table-coordinate-overlays)
- (mapc 'delete-overlay org-table-coordinate-overlays)
- (setq org-table-coordinate-overlays nil))
- (org-save-outline-visibility 'use-markers (org-mode-restart)))
- (message "Local setup has been refreshed"))
- (plain-list
- ;; At a plain list, with a double C-u argument, set
- ;; checkboxes of each item to "[-]", whereas a single one
- ;; will toggle their presence according to the state of the
- ;; first item in the list. Without an argument, repair the
- ;; list.
- (let* ((begin (org-element-property :contents-begin context))
- (beginm (move-marker (make-marker) begin))
- (struct (org-element-property :structure context))
- (old-struct (copy-tree struct))
- (first-box (save-excursion
- (goto-char begin)
- (looking-at org-list-full-item-re)
- (match-string-no-properties 3)))
- (new-box (cond ((equal arg '(16)) "[-]")
- ((equal arg '(4)) (unless first-box "[ ]"))
- ((equal first-box "[X]") "[ ]")
- (t "[X]"))))
- (cond
- (arg
- (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box))
- (org-list-get-all-items
- begin struct (org-list-prevs-alist struct))))
- ((and first-box (eq (point) begin))
- ;; For convenience, when point is at bol on the first
- ;; item of the list and no argument is provided, simply
- ;; toggle checkbox of that item, if any.
- (org-list-set-checkbox begin struct new-box)))
- (org-list-write-struct
- struct (org-list-parents-alist struct) old-struct)
- (org-update-checkbox-count-maybe)
- (save-excursion (goto-char beginm) (org-list-send-list 'maybe))))
- ((property-drawer node-property)
- (call-interactively 'org-property-action))
- ((radio-target target)
- (call-interactively 'org-update-radio-target-regexp))
- (statistics-cookie
- (call-interactively 'org-update-statistics-cookies))
- ((table table-cell table-row)
- ;; At a table, recalculate every field and align it. Also
- ;; send the table if necessary. If the table has
- ;; a `table.el' type, just give up. At a table row or
- ;; cell, maybe recalculate line but always align table.
- (if (eq (org-element-property :type context) 'table.el)
- (message "%s" (substitute-command-keys "\\<org-mode-map>\
-Use \\[org-edit-special] to edit table.el tables"))
- (let ((org-enable-table-editor t))
- (if (or (eq type 'table)
- ;; Check if point is at a TBLFM line.
- (and (eq type 'table-row)
- (= (point) (org-element-property :end context))))
- (save-excursion
- (if (org-at-TBLFM-p)
- (progn (require 'org-table)
- (org-table-calc-current-TBLFM))
- (goto-char (org-element-property :contents-begin context))
- (org-call-with-arg 'org-table-recalculate (or arg t))
- (orgtbl-send-table 'maybe)))
- (org-table-maybe-eval-formula)
- (cond (arg (call-interactively 'org-table-recalculate))
- ((org-table-maybe-recalculate-line))
- (t (org-table-align)))))))
- (timestamp (org-timestamp-change 0 'day))
- (otherwise
- (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
- (user-error
- "C-c C-c can do nothing useful at this location")))))))))
+ (org-update-dblock)))
+ (`footnote-definition
+ (goto-char (org-element-property :post-affiliated context))
+ (call-interactively 'org-footnote-action))
+ (`footnote-reference (call-interactively #'org-footnote-action))
+ ((or `headline `inlinetask)
+ (save-excursion (goto-char (org-element-property :begin context))
+ (call-interactively #'org-set-tags)))
+ ((or `inline-src-block `src-block)
+ (unless org-babel-no-eval-on-ctrl-c-ctrl-c
+ (org-babel-eval-wipe-error-buffer)
+ (org-babel-execute-src-block
+ current-prefix-arg (org-babel-get-src-block-info nil context))))
+ (`item
+ ;; At an item: `C-u C-u' sets checkbox to "[-]"
+ ;; unconditionally, whereas `C-u' will toggle its presence.
+ ;; Without a universal argument, if the item has a checkbox,
+ ;; toggle it. Otherwise repair the list.
+ (let* ((box (org-element-property :checkbox context))
+ (struct (org-element-property :structure context))
+ (old-struct (copy-tree struct))
+ (parents (org-list-parents-alist struct))
+ (prevs (org-list-prevs-alist struct))
+ (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
+ (org-list-set-checkbox
+ (org-element-property :begin context) struct
+ (cond ((equal arg '(16)) "[-]")
+ ((and (not box) (equal arg '(4))) "[ ]")
+ ((or (not box) (equal arg '(4))) nil)
+ ((eq box 'on) "[ ]")
+ (t "[X]")))
+ ;; Mimic `org-list-write-struct' but with grabbing a return
+ ;; value from `org-list-struct-fix-box'.
+ (org-list-struct-fix-ind struct parents 2)
+ (org-list-struct-fix-item-end struct)
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-fix-ind struct parents)
+ (let ((block-item
+ (org-list-struct-fix-box struct parents prevs orderedp)))
+ (if (and box (equal struct old-struct))
+ (if (equal arg '(16))
+ (message "Checkboxes already reset")
+ (user-error "Cannot toggle this checkbox: %s"
+ (if (eq box 'on)
+ "all subitems checked"
+ "unchecked subitems")))
+ (org-list-struct-apply-struct struct old-struct)
+ (org-update-checkbox-count-maybe))
+ (when block-item
+ (message "Checkboxes were removed due to empty box at line %d"
+ (org-current-line block-item))))))
+ (`keyword
+ (let ((org-inhibit-startup-visibility-stuff t)
+ (org-startup-align-all-tables nil))
+ (when (boundp 'org-table-coordinate-overlays)
+ (mapc #'delete-overlay org-table-coordinate-overlays)
+ (setq org-table-coordinate-overlays nil))
+ (org-save-outline-visibility 'use-markers (org-mode-restart)))
+ (message "Local setup has been refreshed"))
+ (`plain-list
+ ;; At a plain list, with a double C-u argument, set
+ ;; checkboxes of each item to "[-]", whereas a single one
+ ;; will toggle their presence according to the state of the
+ ;; first item in the list. Without an argument, repair the
+ ;; list.
+ (let* ((begin (org-element-property :contents-begin context))
+ (beginm (move-marker (make-marker) begin))
+ (struct (org-element-property :structure context))
+ (old-struct (copy-tree struct))
+ (first-box (save-excursion
+ (goto-char begin)
+ (looking-at org-list-full-item-re)
+ (match-string-no-properties 3)))
+ (new-box (cond ((equal arg '(16)) "[-]")
+ ((equal arg '(4)) (unless first-box "[ ]"))
+ ((equal first-box "[X]") "[ ]")
+ (t "[X]"))))
+ (cond
+ (arg
+ (dolist (pos
+ (org-list-get-all-items
+ begin struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox pos struct new-box)))
+ ((and first-box (eq (point) begin))
+ ;; For convenience, when point is at bol on the first
+ ;; item of the list and no argument is provided, simply
+ ;; toggle checkbox of that item, if any.
+ (org-list-set-checkbox begin struct new-box)))
+ (org-list-write-struct
+ struct (org-list-parents-alist struct) old-struct)
+ (org-update-checkbox-count-maybe)
+ (save-excursion (goto-char beginm) (org-list-send-list 'maybe))))
+ ((or `property-drawer `node-property)
+ (call-interactively #'org-property-action))
+ (`radio-target
+ (call-interactively #'org-update-radio-target-regexp))
+ (`statistics-cookie
+ (call-interactively #'org-update-statistics-cookies))
+ ((or `table `table-cell `table-row)
+ ;; At a table, recalculate every field and align it. Also
+ ;; send the table if necessary. If the table has
+ ;; a `table.el' type, just give up. At a table row or cell,
+ ;; maybe recalculate line but always align table.
+ (if (eq (org-element-property :type context) 'table.el)
+ (message "%s" (substitute-command-keys "\\<org-mode-map>\
+Use `\\[org-edit-special]' to edit table.el tables"))
+ (let ((org-enable-table-editor t))
+ (if (or (eq type 'table)
+ ;; Check if point is at a TBLFM line.
+ (and (eq type 'table-row)
+ (= (point) (org-element-property :end context))))
+ (save-excursion
+ (if (org-at-TBLFM-p)
+ (progn (require 'org-table)
+ (org-table-calc-current-TBLFM))
+ (goto-char (org-element-property :contents-begin context))
+ (org-call-with-arg 'org-table-recalculate (or arg t))
+ (orgtbl-send-table 'maybe)))
+ (org-table-maybe-eval-formula)
+ (cond (arg (call-interactively #'org-table-recalculate))
+ ((org-table-maybe-recalculate-line))
+ (t (org-table-align)))))))
+ (`timestamp (org-timestamp-change 0 'day))
+ ((and `nil (guard (org-at-heading-p)))
+ ;; When point is on an unsupported object type, we can miss
+ ;; the fact that it also is at a heading. Handle it here.
+ (call-interactively #'org-set-tags))
+ ((guard
+ (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)))
+ (_
+ (user-error
+ (substitute-command-keys
+ "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))))))
(defun org-mode-restart ()
(interactive)
- (let ((indent-status (org-bound-and-true-p org-indent-mode)))
+ (let ((indent-status (bound-and-true-p org-indent-mode)))
(funcall major-mode)
(hack-local-variables)
- (when (and indent-status (not (org-bound-and-true-p org-indent-mode)))
+ (when (and indent-status (not (bound-and-true-p org-indent-mode)))
(org-indent-mode -1)))
(message "%s restarted" major-mode))
(defun org-kill-note-or-show-branches ()
- "If this is a Note buffer, abort storing the note. Else call `show-branches'."
+ "Abort storing current note, or call `outline-show-branches'."
(interactive)
(if (not org-finish-function)
(progn
@@ -21269,23 +21314,23 @@ Use \\[org-edit-special] to edit table.el tables"))
(let ((org-note-abort t))
(funcall org-finish-function))))
-(defun org-delete-indentation (&optional ARG)
+(defun org-delete-indentation (&optional arg)
"Join current line to previous and fix whitespace at join.
If previous line is a headline add to headline title. Otherwise
the function calls `delete-indentation'.
-With argument, join this line to following line."
+With a non-nil optional argument, join it to the following one."
(interactive "*P")
(if (save-excursion
- (if ARG (beginning-of-line)
- (forward-line -1))
- (looking-at org-complex-heading-regexp))
+ (beginning-of-line (if arg 1 0))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp)))
;; At headline.
(let ((tags-column (when (match-beginning 5)
(save-excursion (goto-char (match-beginning 5))
(current-column))))
- (string (concat " " (progn (when ARG (forward-line 1))
+ (string (concat " " (progn (when arg (forward-line 1))
(org-trim (delete-and-extract-region
(line-beginning-position)
(line-end-position)))))))
@@ -21296,23 +21341,21 @@ With argument, join this line to following line."
(skip-chars-backward " \t")
(save-excursion (insert string))
;; Adjust alignment of tags.
- (when tags-column
- (org-align-tags-here (if org-auto-align-tags
- org-tags-column
- tags-column))))
- (delete-indentation ARG)))
+ (cond
+ ((not tags-column)) ;no tags
+ (org-auto-align-tags (org-set-tags nil t))
+ (t (org--align-tags-here tags-column)))) ;preserve tags column
+ (delete-indentation arg)))
(defun org-open-line (n)
"Insert a new row in tables, call `open-line' elsewhere.
-If `org-special-ctrl-o' is nil, just call `open-line' everywhere."
+If `org-special-ctrl-o' is nil, just call `open-line' everywhere.
+As a special case, when a document starts with a table, allow to
+call `open-line' on the very first character."
(interactive "*p")
- (cond
- ((not org-special-ctrl-o)
- (open-line n))
- ((org-at-table-p)
- (org-table-insert-row))
- (t
- (open-line n))))
+ (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p))
+ (org-table-insert-row)
+ (open-line n)))
(defun org-return (&optional indent)
"Goto next table row or insert a newline.
@@ -21338,18 +21381,19 @@ object (e.g., within a comment). In these case, you need to use
(org-element-lineage context '(table-row table-cell) t))
(org-table-justify-field-maybe)
(call-interactively #'org-table-next-row))
- ;; On a link or a timestamp, call `org-open-line' if
+ ;; On a link or a timestamp, call `org-open-at-point' if
;; `org-return-follows-link' allows it. Tolerate fuzzy
- ;; locations, e.g., in a comment, as `org-open-line'.
+ ;; locations, e.g., in a comment, as `org-open-at-point'.
((and org-return-follows-link
- (or (org-at-timestamp-p t)
- (org-at-date-range-p t)
- (org-in-regexp org-any-link-re)))
+ (or (org-in-regexp org-ts-regexp-both nil t)
+ (org-in-regexp org-tsr-regexp-both nil t)
+ (org-in-regexp org-any-link-re nil t)))
(call-interactively #'org-open-at-point))
;; Insert newline in heading, but preserve tags.
((and (not (bolp))
(save-excursion (beginning-of-line)
- (looking-at org-complex-heading-regexp)))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))))
;; At headline. Split line. However, if point is on keyword,
;; priority cookie or tags, do not break any of them: add
;; a newline after the headline instead.
@@ -21357,14 +21401,13 @@ object (e.g., within a comment). In these case, you need to use
(save-excursion (goto-char (match-beginning 5))
(current-column))))
(string
- (when (and (match-end 4)
- (>= (point)
- (or (match-end 3) (match-end 2) (1+ (match-end 1))))
- (<= (point) (match-end 4)))
+ (when (and (match-end 4) (org-point-in-group (point) 4))
(delete-and-extract-region (point) (match-end 4)))))
- (when (and tags-column string) ; Adjust tag alignment.
- (org-align-tags-here
- (if org-auto-align-tags org-tags-column tags-column)))
+ ;; Adjust tag alignment.
+ (cond
+ ((not (and tags-column string)))
+ (org-auto-align-tags (org-set-tags nil t))
+ (t (org--align-tags-here tags-column))) ;preserve tags column
(end-of-line)
(org-show-entry)
(if indent (newline-and-indent) (newline))
@@ -21414,153 +21457,11 @@ Calls `org-table-insert-hline', `org-toggle-item', or
(t
(call-interactively 'org-toggle-item))))
-(defun org-toggle-item (arg)
- "Convert headings or normal lines to items, items to normal lines.
-If there is no active region, only the current line is considered.
-
-If the first non blank line in the region is a headline, convert
-all headlines to items, shifting text accordingly.
-
-If it is an item, convert all items to normal lines.
-
-If it is normal text, change region into a list of items.
-With a prefix argument ARG, change the region in a single item."
- (interactive "P")
- (let ((shift-text
- (function
- ;; Shift text in current section to IND, from point to END.
- ;; The function leaves point to END line.
- (lambda (ind end)
- (let ((min-i 1000) (end (copy-marker end)))
- ;; First determine the minimum indentation (MIN-I) of
- ;; the text.
- (save-excursion
- (catch 'exit
- (while (< (point) end)
- (let ((i (org-get-indentation)))
- (cond
- ;; Skip blank lines and inline tasks.
- ((looking-at "^[ \t]*$"))
- ((looking-at org-outline-regexp-bol))
- ;; We can't find less than 0 indentation.
- ((zerop i) (throw 'exit (setq min-i 0)))
- ((< i min-i) (setq min-i i))))
- (forward-line))))
- ;; Then indent each line so that a line indented to
- ;; MIN-I becomes indented to IND. Ignore blank lines
- ;; and inline tasks in the process.
- (let ((delta (- ind min-i)))
- (while (< (point) end)
- (unless (or (looking-at "^[ \t]*$")
- (looking-at org-outline-regexp-bol))
- (org-indent-line-to (+ (org-get-indentation) delta)))
- (forward-line)))))))
- (skip-blanks
- (function
- ;; Return beginning of first non-blank line, starting from
- ;; line at POS.
- (lambda (pos)
- (save-excursion
- (goto-char pos)
- (skip-chars-forward " \r\t\n")
- (point-at-bol)))))
- beg end)
- ;; Determine boundaries of changes.
- (if (org-region-active-p)
- (setq beg (funcall skip-blanks (region-beginning))
- end (copy-marker (region-end)))
- (setq beg (funcall skip-blanks (point-at-bol))
- end (copy-marker (point-at-eol))))
- ;; Depending on the starting line, choose an action on the text
- ;; between BEG and END.
- (org-with-limited-levels
- (save-excursion
- (goto-char beg)
- (cond
- ;; Case 1. Start at an item: de-itemize. Note that it only
- ;; happens when a region is active: `org-ctrl-c-minus'
- ;; would call `org-cycle-list-bullet' otherwise.
- ((org-at-item-p)
- (while (< (point) end)
- (when (org-at-item-p)
- (skip-chars-forward " \t")
- (delete-region (point) (match-end 0)))
- (forward-line)))
- ;; Case 2. Start at an heading: convert to items.
- ((org-at-heading-p)
- (let* ((bul (org-list-bullet-string "-"))
- (bul-len (length bul))
- (done (org-entry-is-done-p))
- (todo (org-entry-is-todo-p))
- ;; Indentation of the first heading. It should be
- ;; relative to the indentation of its parent, if any.
- (start-ind (save-excursion
- (cond
- ((not org-adapt-indentation) 0)
- ((not (outline-previous-heading)) 0)
- (t (length (match-string 0))))))
- ;; Level of first heading. Further headings will be
- ;; compared to it to determine hierarchy in the list.
- (ref-level (org-reduced-level (org-outline-level))))
- (when (or done todo) (org-todo ""))
- (while (< (point) end)
- (let* ((level (org-reduced-level (org-outline-level)))
- (delta (max 0 (- level ref-level))))
- ;; If current headline is less indented than the first
- ;; one, set it as reference, in order to preserve
- ;; subtrees.
- (when (< level ref-level) (setq ref-level level))
- (replace-match bul t t)
- (org-indent-line-to (+ start-ind (* delta bul-len)))
- (when (or done todo)
- (let* ((struct (org-list-struct))
- (old (copy-tree struct)))
- (org-list-set-checkbox (line-beginning-position)
- struct
- (if done "[X]" "[ ]"))
- (org-list-write-struct struct
- (org-list-parents-alist struct)
- old)))
- ;; Ensure all text down to END (or SECTION-END) belongs
- ;; to the newly created item.
- (let ((section-end (save-excursion
- (or (outline-next-heading) (point)))))
- (forward-line)
- (funcall shift-text
- (+ start-ind (* (1+ delta) bul-len))
- (min end section-end)))))))
- ;; Case 3. Normal line with ARG: make the first line of region
- ;; an item, and shift indentation of others lines to
- ;; set them as item's body.
- (arg (let* ((bul (org-list-bullet-string "-"))
- (bul-len (length bul))
- (ref-ind (org-get-indentation)))
- (skip-chars-forward " \t")
- (insert bul)
- (forward-line)
- (while (< (point) end)
- ;; Ensure that lines less indented than first one
- ;; still get included in item body.
- (funcall shift-text
- (+ ref-ind bul-len)
- (min end (save-excursion (or (outline-next-heading)
- (point)))))
- (forward-line))))
- ;; Case 4. Normal line without ARG: turn each non-item line
- ;; into an item.
- (t
- (while (< (point) end)
- (unless (or (org-at-heading-p) (org-at-item-p))
- (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
- (replace-match
- (concat "\\1" (org-list-bullet-string "-") "\\2"))))
- (forward-line))))))))
-
(defun org-toggle-heading (&optional nstars)
"Convert headings to normal text, or items or text to headings.
If there is no active region, only convert the current line.
-With a \\[universal-argument] prefix, convert the whole list at
+With a `\\[universal-argument]' prefix, convert the whole list at
point into heading.
In a region:
@@ -21596,7 +21497,7 @@ number of stars to add."
;; do not consider the last line to be in the region.
(when (and current-prefix-arg (org-at-item-p))
- (if (listp current-prefix-arg) (setq current-prefix-arg 1))
+ (when (listp current-prefix-arg) (setq current-prefix-arg 1))
(org-mark-element))
(if (org-region-active-p)
@@ -21625,10 +21526,11 @@ number of stars to add."
(when (org-at-item-p)
;; Pay attention to cases when region ends before list.
(let* ((struct (org-list-struct))
- (list-end (min (org-list-get-bottom-point struct) (1+ end))))
+ (list-end
+ (min (org-list-get-bottom-point struct) (1+ end))))
(save-restriction
(narrow-to-region (point) list-end)
- (insert (org-list-to-subtree (org-list-parse-list t)))))
+ (insert (org-list-to-subtree (org-list-to-lisp t)) "\n")))
(setq toggled t))
(forward-line)))
;; Case 3. Started at normal text: make every line an heading,
@@ -21642,7 +21544,7 @@ number of stars to add."
(org-odd-levels-only "**") ; inside heading, odd
(t "*"))) ; inside heading, oddeven
(rpl (concat stars add-stars " "))
- (lend (if (listp nstars) (save-excursion (end-of-line) (point)))))
+ (lend (when (listp nstars) (save-excursion (end-of-line) (point)))))
(while (< (point) (if (equal nstars '(4)) lend end))
(when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p)))
(looking-at "\\([ \t]*\\)\\(\\S-\\)"))
@@ -21667,7 +21569,7 @@ on context. See the individual commands for more information."
(and (not (org-before-first-heading-p))
(not (org-at-table-p))))
-;; Define the Org-mode menus
+;; Define the Org mode menus
(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
'("Tbl"
["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
@@ -21714,11 +21616,11 @@ on context. See the individual commands for more information."
["Which Column?" org-table-current-column (org-at-table-p)])
["Debug Formulas"
org-table-toggle-formula-debugger
- :style toggle :selected (org-bound-and-true-p org-table-formula-debug)]
+ :style toggle :selected (bound-and-true-p org-table-formula-debug)]
["Show Col/Row Numbers"
org-table-toggle-coordinate-overlays
:style toggle
- :selected (org-bound-and-true-p org-table-overlay-coordinates)]
+ :selected (bound-and-true-p org-table-overlay-coordinates)]
"--"
["Create" org-table-create (and (not (org-at-table-p))
org-enable-table-editor)]
@@ -21842,7 +21744,7 @@ on context. See the individual commands for more information."
"--"
["Set property" org-set-property (not (org-before-first-heading-p))]
["Column view of properties" org-columns t]
- ["Insert Column View DBlock" org-insert-columns-dblock t])
+ ["Insert Column View DBlock" org-columns-insert-dblock t])
("Dates and Scheduling"
["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
@@ -21903,9 +21805,7 @@ on context. See the individual commands for more information."
["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
["Modify math symbol" org-cdlatex-math-modify
(org-inside-LaTeX-fragment-p)]
- ["Insert citation" org-reftex-citation t]
- "--"
- ["Template for BEAMER" (org-beamer-insert-options-template) t])
+ ["Insert citation" org-reftex-citation t])
"--"
("MobileOrg"
["Push Files and Views" org-mobile-push t]
@@ -21931,20 +21831,20 @@ on context. See the individual commands for more information."
))
(defun org-info (&optional node)
- "Read documentation for Org-mode in the info system.
+ "Read documentation for Org in the info system.
With optional NODE, go directly to that node."
(interactive)
(info (format "(org)%s" (or node ""))))
;;;###autoload
(defun org-submit-bug-report ()
- "Submit a bug report on Org-mode via mail.
+ "Submit a bug report on Org via mail.
Don't hesitate to report any problems or inaccurate documentation.
If you don't have setup sending mail from (X)Emacs, please copy the
output buffer into your mail program, as it gives us important
-information about your Org-mode version and configuration."
+information about your Org version and configuration."
(interactive)
(require 'reporter)
(defvar reporter-prompt-for-summary-p)
@@ -21956,12 +21856,12 @@ information about your Org-mode version and configuration."
(org-version nil 'full)
(let (list)
(save-window-excursion
- (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
+ (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
(delete-other-windows)
(erase-buffer)
- (insert "You are about to submit a bug report to the Org-mode mailing list.
+ (insert "You are about to submit a bug report to the Org mailing list.
-We would like to add your full Org-mode and Outline configuration to the
+We would like to add your full Org and Outline configuration to the
bug report. This greatly simplifies the work of the maintainer and
other experts on the mailing list.
@@ -21971,7 +21871,7 @@ appear in the form of file names, tags, todo states, or search strings.
If you answer yes to the prompt, you might want to check and remove
such private information before sending the email.")
(add-text-properties (point-min) (point-max) '(face org-warning))
- (when (yes-or-no-p "Include your Org-mode configuration ")
+ (when (yes-or-no-p "Include your Org configuration ")
(mapatoms
(lambda (v)
(and (boundp v)
@@ -21990,11 +21890,11 @@ what in fact did happen. You don't know how to make a good report? See
http://orgmode.org/manual/Feedback.html#Feedback
-Your bug report will be posted to the Org-mode mailing list.
+Your bug report will be posted to the Org mailing list.
------------------------------------------------------------------------")
(save-excursion
- (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
- (replace-match "\\1Bug: \\3 [\\2]")))))
+ (when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
+ (replace-match "\\1Bug: \\3 [\\2]")))))
(defun org-install-agenda-files-menu ()
@@ -22002,7 +21902,7 @@ Your bug report will be posted to the Org-mode mailing list.
(save-excursion
(while bl
(set-buffer (pop bl))
- (if (derived-mode-p 'org-mode) (setq bl nil)))
+ (when (derived-mode-p 'org-mode) (setq bl nil)))
(when (derived-mode-p 'org-mode)
(easy-menu-change
'("Org") "File List for Agenda"
@@ -22020,7 +21920,7 @@ Your bug report will be posted to the Org-mode mailing list.
(defun org-require-autoloaded-modules ()
(interactive)
- (mapc 'require
+ (mapc #'require
'(org-agenda org-archive org-attach org-clock org-colview org-id
org-table org-timer)))
@@ -22033,13 +21933,8 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(let* ((org-dir (org-find-library-dir "org"))
(contrib-dir (or (org-find-library-dir "org-contribdir") org-dir))
(feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?")
- (remove-re (mapconcat 'identity
- (mapcar (lambda (f) (concat "^" f "$"))
- (list (if (featurep 'xemacs)
- "org-colview"
- "org-colview-xemacs")
- "org" "org-loaddefs" "org-version"))
- "\\|"))
+ (remove-re (format "\\`%s\\'"
+ (regexp-opt '("org" "org-loaddefs" "org-version"))))
(feats (delete-dups
(mapcar 'file-name-sans-extension
(mapcar 'file-name-nondirectory
@@ -22071,9 +21966,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
't)
f))
lfeat)))
- (if load-uncore
- (message "The following feature%s found in load-path, please check if that's correct:\n%s"
- (if (> (length load-uncore) 1) "s were" " was") load-uncore))
+ (when load-uncore
+ (message "The following feature%s found in load-path, please check if that's correct:\n%s"
+ (if (> (length load-uncore) 1) "s were" " was") load-uncore))
(if load-misses
(message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s"
(if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full))
@@ -22088,7 +21983,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(customize-browse 'org))
(defun org-create-customize-menu ()
- "Create a full customization menu for Org-mode, insert it into the menu."
+ "Create a full customization menu for Org mode, insert it into the menu."
(interactive)
(org-load-modules-maybe)
(org-require-autoloaded-modules)
@@ -22111,7 +22006,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
;;; Generally useful functions
-(defsubst org-get-at-eol (property n)
+(defun org-get-at-eol (property n)
"Get text property PROPERTY at the end of line less N characters."
(get-text-property (- (point-at-eol) n) property))
@@ -22121,19 +22016,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(get-text-property (or (next-single-property-change 0 prop s) 0)
prop s)))
-(defun org-display-warning (message) ;; Copied from Emacs-Muse
+(defun org-display-warning (message)
"Display the given MESSAGE as a warning."
- (if (fboundp 'display-warning)
- (display-warning 'org message
- (if (featurep 'xemacs) 'warning :warning))
- (let ((buf (get-buffer-create "*Org warnings*")))
- (with-current-buffer buf
- (goto-char (point-max))
- (insert "Warning (Org): " message)
- (unless (bolp)
- (newline)))
- (display-buffer buf)
- (sit-for 0))))
+ (display-warning 'org message :warning))
(defun org-eval (form)
"Eval FORM and return result."
@@ -22159,14 +22044,35 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(<= (point) (match-end 4))
(member (match-string 3) '("=" "~")))))
+(defun org-overlay-display (ovl text &optional face evap)
+ "Make overlay OVL display TEXT with face FACE."
+ (overlay-put ovl 'display text)
+ (if face (overlay-put ovl 'face face))
+ (if evap (overlay-put ovl 'evaporate t)))
+
+(defun org-overlay-before-string (ovl text &optional face evap)
+ "Make overlay OVL display TEXT with face FACE."
+ (if face (org-add-props text nil 'face face))
+ (overlay-put ovl 'before-string text)
+ (if evap (overlay-put ovl 'evaporate t)))
+
+(defun org-find-overlays (prop &optional pos delete)
+ "Find all overlays specifying PROP at POS or point.
+If DELETE is non-nil, delete all those overlays."
+ (let (found)
+ (dolist (ov (overlays-at (or pos (point))) found)
+ (cond ((not (overlay-get ov prop)))
+ (delete (delete-overlay ov))
+ (t (push ov found))))))
+
(defun org-goto-marker-or-bmk (marker &optional bookmark)
"Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
(if (and marker (marker-buffer marker)
(buffer-live-p (marker-buffer marker)))
(progn
- (org-pop-to-buffer-same-window (marker-buffer marker))
- (if (or (> marker (point-max)) (< marker (point-min)))
- (widen))
+ (pop-to-buffer-same-window (marker-buffer marker))
+ (when (or (> marker (point-max)) (< marker (point-min)))
+ (widen))
(goto-char marker)
(org-show-context 'org-goto))
(if bookmark
@@ -22209,7 +22115,7 @@ upon the next fontification round."
l))
(defun org-shorten-string (s maxlength)
- "Shorten string S so tht it is no longer than MAXLENGTH characters.
+ "Shorten string S so that it is no longer than MAXLENGTH characters.
If the string is shorter or has length MAXLENGTH, just return the
original string. If it is longer, the functions finds a space in the
string, breaks this string off at that locations and adds three dots
@@ -22229,8 +22135,8 @@ if necessary."
"Get the indentation of the current line, interpreting tabs.
When LINE is given, assume it represents a line and compute its indentation."
(if line
- (if (string-match "^ *" (org-remove-tabs line))
- (match-end 0))
+ (when (string-match "^ *" (org-remove-tabs line))
+ (match-end 0))
(save-excursion
(beginning-of-line 1)
(skip-chars-forward " \t")
@@ -22267,35 +22173,45 @@ leave it alone. If it is larger than ind, set it to the target."
(let* ((l (org-remove-tabs line))
(i (org-get-indentation l))
(i1 (car ind)) (i2 (cdr ind)))
- (if (>= i i2) (setq l (substring line i2)))
+ (when (>= i i2) (setq l (substring line i2)))
(if (> i1 0)
(concat (make-string i1 ?\ ) l)
l)))
(defun org-remove-indentation (code &optional n)
- "Remove the maximum common indentation from the lines in CODE.
-N may optionally be the number of spaces to remove."
+ "Remove maximum common indentation in string CODE and return it.
+N may optionally be the number of columns to remove. Return CODE
+as-is if removal failed."
(with-temp-buffer
(insert code)
- (org-do-remove-indentation n)
- (buffer-string)))
+ (if (org-do-remove-indentation n) (buffer-string) code)))
(defun org-do-remove-indentation (&optional n)
- "Remove the maximum common indentation from the buffer."
- (untabify (point-min) (point-max))
- (let ((min 10000) re)
- (if n
- (setq min n)
- (goto-char (point-min))
- (while (re-search-forward "^ *[^ \n]" nil t)
- (setq min (min min (1- (- (match-end 0) (match-beginning 0)))))))
- (unless (or (= min 0) (= min 10000))
- (setq re (format "^ \\{%d\\}" min))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (replace-match "")
- (end-of-line 1))
- min)))
+ "Remove the maximum common indentation from the buffer.
+When optional argument N is a positive integer, remove exactly
+that much characters from indentation, if possible. Return nil
+if it fails."
+ (catch :exit
+ (goto-char (point-min))
+ ;; Find maximum common indentation, if not specified.
+ (let ((n (or n
+ (let ((min-ind (point-max)))
+ (save-excursion
+ (while (re-search-forward "^[ \t]*\\S-" nil t)
+ (let ((ind (1- (current-column))))
+ (if (zerop ind) (throw :exit nil)
+ (setq min-ind (min min-ind ind))))))
+ min-ind))))
+ (if (zerop n) (throw :exit nil)
+ ;; Remove exactly N indentation, but give up if not possible.
+ (while (not (eobp))
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (cond ((eolp) (delete-region (line-beginning-position) (point)))
+ ((< ind n) (throw :exit nil))
+ (t (indent-line-to (- ind n))))
+ (forward-line)))
+ ;; Signal success.
+ t))))
(defun org-fill-template (template alist)
"Find each %key of ALIST in TEMPLATE and replace it."
@@ -22387,7 +22303,7 @@ and end of string."
"Whether point is in a code source block.
When INSIDE is non-nil, don't consider we are within a src block
when point is at #+BEGIN_SRC or #+END_SRC."
- (let ((case-fold-search t) ov)
+ (let ((case-fold-search t))
(or (and (eq (get-char-property (point) 'src-block) t))
(and (not inside)
(save-match-data
@@ -22410,7 +22326,7 @@ contexts are:
:item on the first line of a plain list item
:item-bullet on the bullet/number of a plain list item
:checkbox on the checkbox in a plain list item
-:table in an org-mode table
+:table in an Org table
:table-special on a special filed in a table
:table-table in a table.el table
:clocktable in a clocktable
@@ -22441,8 +22357,8 @@ and :keyword."
(push (org-point-in-group p 4 :tags) clist))
(goto-char p)
(skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1))
- (if (looking-at "\\[#[A-Z0-9]\\]")
- (push (org-point-in-group p 0 :priority) clist)))
+ (when (looking-at "\\[#[A-Z0-9]\\]")
+ (push (org-point-in-group p 0 :priority) clist)))
((org-at-item-p)
(push (org-point-in-group p 2 :item-bullet) clist)
@@ -22454,10 +22370,10 @@ and :keyword."
((org-at-table-p)
(push (list :table (org-table-begin) (org-table-end)) clist)
- (if (memq 'org-formula faces)
- (push (list :table-special
- (previous-single-property-change p 'face)
- (next-single-property-change p 'face)) clist)))
+ (when (memq 'org-formula faces)
+ (push (list :table-special
+ (previous-single-property-change p 'face)
+ (next-single-property-change p 'face)) clist)))
((org-at-table-p 'any)
(push (list :table-table) clist)))
(goto-char p)
@@ -22495,13 +22411,12 @@ and :keyword."
((org-at-target-p)
(push (org-point-in-group p 0 :target) clist)
(goto-char (1- (match-beginning 0)))
- (if (looking-at org-radio-target-regexp)
- (push (org-point-in-group p 0 :radio-target) clist))
+ (when (looking-at org-radio-target-regexp)
+ (push (org-point-in-group p 0 :radio-target) clist))
(goto-char p))
- ((setq o (org-some
+ ((setq o (cl-some
(lambda (o)
- (and (eq (overlay-get o 'org-overlay-type)
- 'org-latex-overlay)
+ (and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)
o))
(overlays-at (point))))
(push (list :latex-fragment
@@ -22515,25 +22430,27 @@ and :keyword."
(setq clist (nreverse (delq nil clist)))
clist))
-(defun org-in-regexp (re &optional nlines visually)
- "Check if point is inside a match of RE.
+(defun org-in-regexp (regexp &optional nlines visually)
+ "Check if point is inside a match of REGEXP.
Normally only the current line is checked, but you can include
-NLINES extra lines after point into the search. If VISUALLY is
+NLINES extra lines around point into the search. If VISUALLY is
set, require that the cursor is not after the match but really
-on, so that the block visually is on the match."
- (catch 'exit
+on, so that the block visually is on the match.
+
+Return nil or a cons cell (BEG . END) where BEG and END are,
+respectively, the positions at the beginning and the end of the
+match."
+ (catch :exit
(let ((pos (point))
- (eol (point-at-eol (+ 1 (or nlines 0))))
- (inc (if visually 1 0)))
+ (eol (line-end-position (if nlines (1+ nlines) 1))))
(save-excursion
(beginning-of-line (- 1 (or nlines 0)))
- (while (re-search-forward re eol t)
- (if (and (<= (match-beginning 0) pos)
- (>= (+ inc (match-end 0)) pos))
- (throw 'exit (cons (match-beginning 0) (match-end 0)))))))))
-(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp
- "Org mode 8.3")
+ (while (and (re-search-forward regexp eol t)
+ (<= (match-beginning 0) pos))
+ (let ((end (match-end 0)))
+ (when (or (> end pos) (and (= end pos) (not visually)))
+ (throw :exit (cons (match-beginning 0) (match-end 0))))))))))
(defun org-between-regexps-p (start-re end-re &optional lim-up lim-down)
"Non-nil when point is between matches of START-RE and END-RE.
@@ -22580,14 +22497,13 @@ block from point."
(let ((case-fold-search t)
(lim-up (save-excursion (outline-previous-heading)))
(lim-down (save-excursion (outline-next-heading))))
- (mapc (lambda (name)
- (let ((n (regexp-quote name)))
- (when (org-between-regexps-p
- (concat "^[ \t]*#\\+begin_" n)
- (concat "^[ \t]*#\\+end_" n)
- lim-up lim-down)
- (throw 'exit n))))
- names))
+ (dolist (name names)
+ (let ((n (regexp-quote name)))
+ (when (org-between-regexps-p
+ (concat "^[ \t]*#\\+begin_" n)
+ (concat "^[ \t]*#\\+end_" n)
+ lim-up lim-down)
+ (throw 'exit n)))))
nil)))
(defun org-occur-in-agenda-files (regexp &optional _nlines)
@@ -22614,27 +22530,8 @@ block from point."
files)
regexp)))
-(if (boundp 'occur-mode-find-occurrence-hook)
- ;; Emacs 23
- (add-hook 'occur-mode-find-occurrence-hook
- (lambda ()
- (when (derived-mode-p 'org-mode)
- (org-reveal))))
- ;; Emacs 22
- (defadvice occur-mode-goto-occurrence
- (after org-occur-reveal activate)
- (and (derived-mode-p 'org-mode) (org-reveal)))
- (defadvice occur-mode-goto-occurrence-other-window
- (after org-occur-reveal activate)
- (and (derived-mode-p 'org-mode) (org-reveal)))
- (defadvice occur-mode-display-occurrence
- (after org-occur-reveal activate)
- (when (derived-mode-p 'org-mode)
- (let ((pos (occur-mode-find-occurrence)))
- (with-current-buffer (marker-buffer pos)
- (save-excursion
- (goto-char pos)
- (org-reveal)))))))
+(add-hook 'occur-mode-find-occurrence-hook
+ (lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
(defun org-occur-link-in-agenda-files ()
"Create a link and search for it in the agendas.
@@ -22664,81 +22561,27 @@ merge (a 1) and (a 3) into (a 1 3).
The function returns the new ALIST."
(let (rtn)
- (mapc
- (lambda (e)
- (let (n)
- (if (not (assoc (car e) rtn))
- (push e rtn)
- (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
- (setq rtn (assq-delete-all (car e) rtn))
- (push n rtn))))
- alist)
- rtn))
+ (dolist (e alist rtn)
+ (let (n)
+ (if (not (assoc (car e) rtn))
+ (push e rtn)
+ (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
+ (setq rtn (assq-delete-all (car e) rtn))
+ (push n rtn))))))
(defun org-delete-all (elts list)
- "Remove all elements in ELTS from LIST."
+ "Remove all elements in ELTS from LIST.
+Comparison is done with `equal'. It is a destructive operation
+that may remove elements by altering the list structure."
(while elts
(setq list (delete (pop elts) list)))
list)
-(defun org-count (cl-item cl-seq)
- "Count the number of occurrences of ITEM in SEQ.
-Taken from `count' in cl-seq.el with all keyword arguments removed."
- (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x)
- (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
- (while (< cl-start cl-end)
- (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
- (if (equal cl-item cl-x) (setq cl-count (1+ cl-count)))
- (setq cl-start (1+ cl-start)))
- cl-count))
-
-(defun org-remove-if (predicate seq)
- "Remove everything from SEQ that fulfills PREDICATE."
- (let (res e)
- (while seq
- (setq e (pop seq))
- (if (not (funcall predicate e)) (push e res)))
- (nreverse res)))
-
-(defun org-remove-if-not (predicate seq)
- "Remove everything from SEQ that does not fulfill PREDICATE."
- (let (res e)
- (while seq
- (setq e (pop seq))
- (if (funcall predicate e) (push e res)))
- (nreverse res)))
-
-(defun org-reduce (cl-func cl-seq &rest cl-keys)
- "Reduce two-argument FUNCTION across SEQ.
-Taken from `reduce' in cl-seq.el with all keyword arguments but
-\":initial-value\" removed."
- (let ((cl-accum (cond ((memq :initial-value cl-keys)
- (cadr (memq :initial-value cl-keys)))
- (cl-seq (pop cl-seq))
- (t (funcall cl-func)))))
- (while cl-seq
- (setq cl-accum (funcall cl-func cl-accum (pop cl-seq))))
- cl-accum))
-
-(defun org-every (pred seq)
- "Return true if PREDICATE is true of every element of SEQ.
-Adapted from `every' in cl.el."
- (catch 'org-every
- (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq)
- t))
-
-(defun org-some (pred seq)
- "Return true if PREDICATE is true of any element of SEQ.
-Adapted from `some' in cl.el."
- (catch 'org-some
- (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq)
- nil))
-
(defun org-back-over-empty-lines ()
"Move backwards over whitespace, to the beginning of the first empty line.
Returns the number of empty lines passed."
(let ((pos (point)))
- (if (cdr (assoc 'heading org-blank-before-new-entry))
+ (if (cdr (assq 'heading org-blank-before-new-entry))
(skip-chars-backward " \t\n\r")
(unless (eobp)
(forward-line -1)))
@@ -22791,7 +22634,7 @@ so values can contain further %-escapes if they are define later in TABLE."
(let ((tbl (copy-alist table))
(case-fold-search nil)
(pchg 0)
- e re rpl)
+ re rpl)
(dolist (e tbl)
(setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
(when (and (cdr e) (string-match re (cdr e)))
@@ -22809,16 +22652,6 @@ so values can contain further %-escapes if they are define later in TABLE."
(setq string (replace-match sref t t string)))))
string))
-(defun org-sublist (list start end)
- "Return a section of LIST, from START to END.
-Counting starts at 1."
- (let (rtn (c start))
- (setq list (nthcdr (1- start) list))
- (while (and list (<= c end))
- (push (pop list) rtn)
- (setq c (1+ c)))
- (nreverse rtn)))
-
(defun org-find-base-buffer-visiting (file)
"Like `find-buffer-visiting' but always return the base buffer and
not an indirect buffer."
@@ -22828,26 +22661,12 @@ not an indirect buffer."
(or (buffer-base-buffer buf) buf)
nil)))
-(defun org-image-file-name-regexp (&optional extensions)
- "Return regexp matching the file names of images.
-If EXTENSIONS is given, only match these."
- (if (and (not extensions) (fboundp 'image-file-name-regexp))
- (image-file-name-regexp)
- (let ((image-file-name-extensions
- (or extensions
- '("png" "jpeg" "jpg" "gif" "tiff" "tif"
- "xbm" "xpm" "pbm" "pgm" "ppm"))))
- (concat "\\."
- (regexp-opt (nconc (mapcar 'upcase
- image-file-name-extensions)
- image-file-name-extensions)
- t)
- "\\'"))))
-
-(defun org-file-image-p (file &optional extensions)
+;;; TODO: Only called once, from ox-odt which should probably use
+;;; org-export-inline-image-p or something.
+(defun org-file-image-p (file)
"Return non-nil if FILE is an image."
(save-match-data
- (string-match (org-image-file-name-regexp extensions) file)))
+ (string-match (image-file-name-regexp) file)))
(defun org-get-cursor-date (&optional with-time)
"Return the date at cursor in as a time.
@@ -22871,10 +22690,10 @@ the agenda) or the current time of the day."
(nth 1 date) (nth 0 date) (nth 2 date))))
((eq major-mode 'org-agenda-mode)
(setq day (get-text-property (point) 'day))
- (if day
- (setq date (calendar-gregorian-from-absolute day)
- defd (encode-time 0 (or mod 0) (or hod 0)
- (nth 1 date) (nth 0 date) (nth 2 date))))))
+ (when day
+ (setq date (calendar-gregorian-from-absolute day)
+ defd (encode-time 0 (or mod 0) (or hod 0)
+ (nth 1 date) (nth 0 date) (nth 2 date))))))
(or defd (current-time))))
(defun org-mark-subtree (&optional up)
@@ -22887,11 +22706,77 @@ hierarchy of headlines by UP levels before marking the subtree."
(cond ((org-at-heading-p) (beginning-of-line))
((org-before-first-heading-p) (user-error "Not in a subtree"))
(t (outline-previous-visible-heading 1))))
- (when up (while (and (> up 0) (org-up-heading-safe)) (decf up)))
- (if (org-called-interactively-p 'any)
+ (when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up)))
+ (if (called-interactively-p 'any)
(call-interactively 'org-mark-element)
(org-mark-element)))
+(defun org-file-newer-than-p (file time)
+ "Non-nil if FILE is newer than TIME.
+FILE is a filename, as a string, TIME is a list of integers, as
+returned by, e.g., `current-time'."
+ (and (file-exists-p file)
+ ;; Only compare times up to whole seconds as some file-systems
+ ;; (e.g. HFS+) do not retain any finer granularity. As
+ ;; a consequence, make sure we return non-nil when the two
+ ;; times are equal.
+ (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2)
+ (cl-subseq time 0 2)))))
+
+(defun org-compile-file (source process ext &optional err-msg log-buf spec)
+ "Compile a SOURCE file using PROCESS.
+
+PROCESS is either a function or a list of shell commands, as
+strings. EXT is a file extension, without the leading dot, as
+a string. It is used to check if the process actually succeeded.
+
+PROCESS must create a file with the same base name and directory
+as SOURCE, but ending with EXT. The function then returns its
+filename. Otherwise, it raises an error. The error message can
+then be refined by providing string ERR-MSG, which is appended to
+the standard message.
+
+If PROCESS is a function, it is called with a single argument:
+the SOURCE file.
+
+If it is a list of commands, each of them is called using
+`shell-command'. By default, in each command, %b, %f, %F and %o
+are replaced with, respectively, SOURCE base name, name, full
+name and directory. It is possible, however, to use more
+place-holders by specifying them in optional argument SPEC, as an
+alist following the pattern (CHARACTER . REPLACEMENT-STRING).
+
+When PROCESS is a list of commands, optional argument LOG-BUF can
+be set to a buffer or a buffer name. `shell-command' then uses
+it for output.
+
+`default-directory' is set to SOURCE directory during the whole
+process."
+ (let* ((source-name (file-name-nondirectory source))
+ (base-name (file-name-sans-extension source-name))
+ (full-name (file-truename source))
+ (out-dir (file-name-directory source))
+ (time (current-time))
+ (err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
+ (save-window-excursion
+ (let ((default-directory (file-name-directory full-name)))
+ (pcase process
+ ((pred functionp) (funcall process (shell-quote-argument source)))
+ ((pred consp)
+ (let ((log-buf (and log-buf (get-buffer-create log-buf)))
+ (spec (append spec
+ `((?b . ,(shell-quote-argument base-name))
+ (?f . ,(shell-quote-argument source-name))
+ (?F . ,(shell-quote-argument full-name))
+ (?o . ,(shell-quote-argument out-dir))))))
+ (dolist (command process)
+ (shell-command (format-spec command spec) log-buf))))
+ (_ (error "No valid command to process %S%s" source err-msg)))))
+ ;; Check for process failure.
+ (let ((output (concat out-dir base-name "." ext)))
+ (unless (org-file-newer-than-p output time)
+ (error (format "File %S wasn't produced%s" output err-msg)))
+ output)))
;;; Indentation
@@ -22906,7 +22791,7 @@ ELEMENT."
(org-with-wide-buffer
(cond
(contentsp
- (case type
+ (cl-case type
((diary-sexp footnote-definition) 0)
((headline inlinetask nil)
(if (not org-adapt-indentation) 0
@@ -22984,16 +22869,15 @@ ELEMENT."
;;
;; As a special case, if point is at the end of a footnote
;; definition or an item, indent like the very last element
- ;; within.
+ ;; within. If that last element is an item, indent like its
+ ;; contents.
((and (not (eq type 'paragraph))
(let ((cend (org-element-property :contents-end element)))
(and cend (<= cend pos))))
(if (memq type '(footnote-definition item plain-list))
(let ((last (org-element-at-point)))
(org--get-expected-indentation
- last
- (memq (org-element-type last)
- '(footnote-definition item plain-list))))
+ last (eq (org-element-type last) 'item)))
(goto-char start)
(org-get-indentation)))
;; In any other case, indent like the current line.
@@ -23052,15 +22936,15 @@ Indentation is done according to the following rules:
- Otherwise, indent like the first non-blank line above.
The function doesn't indent an item as it could break the whole
-list structure. Instead, use \\<org-mode-map>\\[org-shiftmetaleft] or \
-\\[org-shiftmetaright].
+list structure. Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \
+`\\[org-shiftmetaright]'.
Also align node properties according to `org-property-format'."
(interactive)
(cond
(orgstruct-is-++
(let ((indent-line-function
- (cadadr (assq 'indent-line-function org-fb-vars))))
+ (cl-cadadr (assq 'indent-line-function org-fb-vars))))
(indent-according-to-mode)))
((org-at-heading-p) 'noindent)
(t
@@ -23084,8 +22968,8 @@ Also align node properties according to `org-property-format'."
(let ((column (org--get-expected-indentation element nil)))
;; Preserve current column.
(if (<= (current-column) (current-indentation))
- (org-indent-line-to column)
- (save-excursion (org-indent-line-to column))))
+ (indent-line-to column)
+ (save-excursion (indent-line-to column))))
;; Align node property. Also preserve current column.
(when (eq type 'node-property)
(let ((column (current-column)))
@@ -23106,16 +22990,16 @@ assumed to be significant there."
(let ((indent-to
(lambda (ind pos)
;; Set IND as indentation for all lines between point and
- ;; POS or END, whichever comes first. Blank lines are
- ;; ignored. Leave point after POS once done.
- (let ((limit (copy-marker (min end pos))))
+ ;; POS. Blank lines are ignored. Leave point after POS
+ ;; once done.
+ (let ((limit (copy-marker pos)))
(while (< (point) limit)
- (unless (org-looking-at-p "[ \t]*$") (org-indent-line-to ind))
+ (unless (looking-at-p "[ \t]*$") (indent-line-to ind))
(forward-line))
(set-marker limit nil))))
(end (copy-marker end)))
(while (< (point) end)
- (if (or (org-looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line)
+ (if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line)
(let* ((element (org-element-at-point))
(type (org-element-type element))
(element-end (copy-marker (org-element-property :end element)))
@@ -23130,7 +23014,7 @@ assumed to be significant there."
(when (eq type 'node-property)
(org--align-node-property)
(beginning-of-line))
- (funcall indent-to ind element-end))
+ (funcall indent-to ind (min element-end end)))
(t
;; Elements in this category consist of three parts:
;; before the contents, the contents, and after the
@@ -23178,9 +23062,9 @@ assumed to be significant there."
offset))
(goto-char cbeg)))
((eq type 'item) (goto-char cbeg))
- (t (funcall indent-to ind cbeg)))
+ (t (funcall indent-to ind (min cbeg end))))
(when (< (point) end)
- (case type
+ (cl-case type
((example-block export-block verse-block))
(src-block
;; In a source block, indent source code
@@ -23192,7 +23076,8 @@ assumed to be significant there."
(indent-region (point-min) (point-max))))))
(t (org-indent-region (point) (min cend end))))
(goto-char (min cend end))
- (when (< (point) end) (funcall indent-to ind element-end)))
+ (when (< (point) end)
+ (funcall indent-to ind (min element-end end))))
(set-marker post nil)
(set-marker cbeg nil)
(set-marker cend nil))))
@@ -23204,7 +23089,7 @@ assumed to be significant there."
(interactive)
(unless (save-excursion
(beginning-of-line)
- (org-looking-at-p org-drawer-regexp))
+ (looking-at-p org-drawer-regexp))
(user-error "Not at a drawer"))
(let ((element (org-element-at-point)))
(unless (memq (org-element-type element) '(drawer property-drawer))
@@ -23220,7 +23105,7 @@ assumed to be significant there."
(unless (save-excursion
(beginning-of-line)
(let ((case-fold-search t))
- (org-looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
+ (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
(user-error "Not at a block"))
(let ((element (org-element-at-point)))
(unless (memq (org-element-type element)
@@ -23255,20 +23140,20 @@ assumed to be significant there."
(require 'org-element)
;; Prevent auto-fill from inserting unwanted new items.
(when (boundp 'fill-nobreak-predicate)
- (org-set-local
- 'fill-nobreak-predicate
+ (setq-local
+ fill-nobreak-predicate
(org-uniquify
(append fill-nobreak-predicate
'(org-fill-line-break-nobreak-p
org-fill-paragraph-with-timestamp-nobreak-p)))))
(let ((paragraph-ending (substring org-element-paragraph-separate 1)))
- (org-set-local 'paragraph-start paragraph-ending)
- (org-set-local 'paragraph-separate paragraph-ending))
- (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
- (org-set-local 'auto-fill-inhibit-regexp nil)
- (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function)
- (org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
- (org-set-local 'comment-line-break-function 'org-comment-line-break-function))
+ (setq-local paragraph-start paragraph-ending)
+ (setq-local paragraph-separate paragraph-ending))
+ (setq-local fill-paragraph-function 'org-fill-paragraph)
+ (setq-local auto-fill-inhibit-regexp nil)
+ (setq-local adaptive-fill-function 'org-adaptive-fill-function)
+ (setq-local normal-auto-fill-function 'org-auto-fill-function)
+ (setq-local comment-line-break-function 'org-comment-line-break-function))
(defun org-fill-line-break-nobreak-p ()
"Non-nil when a new line at point would create an Org line break."
@@ -23294,7 +23179,7 @@ matches in paragraphs or comments, use it."
(save-excursion
(beginning-of-line)
(cond ((not (message-in-body-p)) (throw 'exit nil))
- ((org-looking-at-p org-table-line-regexp) (throw 'exit nil))
+ ((looking-at-p org-table-line-regexp) (throw 'exit nil))
((looking-at message-cite-prefix-regexp)
(throw 'exit (match-string-no-properties 0)))
((looking-at org-outline-regexp)
@@ -23308,7 +23193,7 @@ matches in paragraphs or comments, use it."
(type (org-element-type element))
(post-affiliated (org-element-property :post-affiliated element)))
(unless (< p post-affiliated)
- (case type
+ (cl-case type
(comment
(save-excursion
(beginning-of-line)
@@ -23376,11 +23261,11 @@ a footnote definition, try to fill the first paragraph within."
(looking-at message-cite-prefix-regexp))))
;; First ensure filling is correct in message-mode.
(let ((fill-paragraph-function
- (cadadr (assoc 'fill-paragraph-function org-fb-vars)))
- (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars)))
- (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars)))
+ (cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
+ (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
+ (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
(paragraph-separate
- (cadadr (assoc 'paragraph-separate org-fb-vars))))
+ (cl-cadadr (assq 'paragraph-separate org-fb-vars))))
(fill-paragraph nil))
(with-syntax-table org-mode-transpose-word-syntax-table
;; Move to end of line in order to get the first paragraph
@@ -23392,7 +23277,7 @@ a footnote definition, try to fill the first paragraph within."
(line-number-at-pos (point)))))))
;; First check if point is in a blank line at the beginning of
;; the buffer. In that case, ignore filling.
- (case (org-element-type element)
+ (cl-case (org-element-type element)
;; Use major mode filling function is src blocks.
(src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
;; Align Org tables, leave table.el tables as-is.
@@ -23552,7 +23437,7 @@ region only contains such lines."
(<= (org-element-property :post-affiliated element) (point)))
(skip-chars-forward " \t")
(insert ": "))
- ((and (org-looking-at-p "[ \t]*$")
+ ((and (looking-at-p "[ \t]*$")
(or (eq type 'inlinetask)
(save-excursion
(skip-chars-forward " \r\t\n")
@@ -23601,7 +23486,7 @@ region only contains such lines."
(setq min-ind 0)
(catch 'zerop
(while (< (point) end)
- (unless (org-looking-at-p "[ \t]*$")
+ (unless (looking-at-p "[ \t]*$")
(let ((ind (org-get-indentation)))
(setq min-ind (min min-ind ind))
(when (zerop ind) (throw 'zerop t))))
@@ -23615,10 +23500,10 @@ region only contains such lines."
((org-at-heading-p)
(insert ": ")
(forward-line)
- (while (and (< (point) end) (org-looking-at-p "[ \t]*$"))
+ (while (and (< (point) end) (looking-at-p "[ \t]*$"))
(insert ":")
(forward-line)))
- ((org-looking-at-p "[ \t]*:\\( \\|$\\)")
+ ((looking-at-p "[ \t]*:\\( \\|$\\)")
(let* ((element (org-element-at-point))
(element-end (org-element-property :end element)))
(if (eq (org-element-type element) 'fixed-width)
@@ -23657,12 +23542,12 @@ region only contains such lines."
(defun org-setup-comments-handling ()
(interactive)
- (org-set-local 'comment-use-syntax nil)
- (org-set-local 'comment-start "# ")
- (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)")
- (org-set-local 'comment-insert-comment-function 'org-insert-comment)
- (org-set-local 'comment-region-function 'org-comment-or-uncomment-region)
- (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region))
+ (setq-local comment-use-syntax nil)
+ (setq-local comment-start "# ")
+ (setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)")
+ (setq-local comment-insert-comment-function 'org-insert-comment)
+ (setq-local comment-region-function 'org-comment-or-uncomment-region)
+ (setq-local uncomment-region-function 'org-comment-or-uncomment-region))
(defun org-insert-comment ()
"Insert an empty comment above current line.
@@ -23704,7 +23589,13 @@ strictly within a source block, use appropriate comment syntax."
(skip-chars-backward " \r\t\n")
(line-beginning-position))
end)))
- (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
+ ;; Translate region boundaries for the Org buffer to the source
+ ;; buffer.
+ (let ((offset (- end beg)))
+ (save-excursion
+ (goto-char beg)
+ (org-babel-do-in-edit-buffer
+ (comment-or-uncomment-region (point) (+ offset (point))))))
(save-restriction
;; Restrict region
(narrow-to-region (save-excursion (goto-char beg)
@@ -23754,7 +23645,7 @@ strictly within a source block, use appropriate comment syntax."
(insert comment-start))
(forward-line)))))))))
-(defun org-comment-dwim (arg)
+(defun org-comment-dwim (_arg)
"Call `comment-dwim' within a source edit buffer if needed."
(interactive "*P")
(if (org-in-src-block-p)
@@ -23794,7 +23685,8 @@ time-range, if possible.
When optional argument UTC is non-nil, time will be expressed as
Universal Time."
(format-time-string
- format (org-timestamp--to-internal-time timestamp end) utc))
+ format (org-timestamp--to-internal-time timestamp end)
+ (and utc t)))
(defun org-timestamp-split-range (timestamp &optional end)
"Extract a TIMESTAMP object from a date or time range.
@@ -23856,7 +23748,6 @@ it has a `diary' type."
;;; Other stuff.
(defvar reftex-docstruct-symbol)
-(defvar reftex-cite-format)
(defvar org--rds)
(defun org-reftex-citation ()
@@ -23874,131 +23765,137 @@ Export of such citations to both LaTeX and HTML is handled by the contributed
package ox-bibtex by Taru Karttunen."
(interactive)
(let ((reftex-docstruct-symbol 'org--rds)
- (reftex-cite-format "\\cite{%l}")
org--rds bib)
- (save-excursion
- (save-restriction
- (widen)
- (let ((case-fold-search t)
- (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)"))
- (if (not (save-excursion
- (or (re-search-forward re nil t)
- (re-search-backward re nil t))))
- (user-error "No bibliography defined in file")
- (setq bib (concat (match-string 1) ".bib")
- org--rds (list (list 'bib bib)))))))
+ (org-with-wide-buffer
+ (let ((case-fold-search t)
+ (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)"))
+ (if (not (save-excursion
+ (or (re-search-forward re nil t)
+ (re-search-backward re nil t))))
+ (user-error "No bibliography defined in file")
+ (setq bib (concat (match-string 1) ".bib")
+ org--rds (list (list 'bib bib))))))
(call-interactively 'reftex-citation)))
;;;; Functions extending outline functionality
-(defun org-beginning-of-line (&optional arg)
- "Go to the beginning of the current line. If that is invisible, continue
-to a visible line beginning. This makes the function of C-a more intuitive.
-If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
-first attempt, and only move to after the tags when the cursor is already
-beyond the end of the headline."
- (interactive "P")
- (let ((pos (point))
- (special (if (consp org-special-ctrl-a/e)
- (car org-special-ctrl-a/e)
- org-special-ctrl-a/e))
- deactivate-mark refpos)
- (if (org-bound-and-true-p visual-line-mode)
- (beginning-of-visual-line 1)
- (beginning-of-line 1))
- (if (and arg (fboundp 'move-beginning-of-line))
- (call-interactively 'move-beginning-of-line)
- (if (bobp)
- nil
- (backward-char 1)
- (if (org-truely-invisible-p)
- (while (and (not (bobp)) (org-truely-invisible-p))
- (backward-char 1)
- (beginning-of-line 1))
- (forward-char 1))))
- (when special
- (cond
- ((and (looking-at org-complex-heading-regexp)
- (eq (char-after (match-end 1)) ?\s))
- (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
- (point-at-eol)))
- (goto-char
- (if (eq special t)
- (cond ((> pos refpos) refpos)
- ((= pos (point)) refpos)
- (t (point)))
- (cond ((> pos (point)) (point))
- ((not (eq last-command this-command)) (point))
- (t refpos)))))
- ((org-at-item-p)
- ;; Being at an item and not looking at an the item means point
- ;; was previously moved to beginning of a visual line, which
- ;; doesn't contain the item. Therefore, do nothing special,
- ;; just stay here.
- (when (looking-at org-list-full-item-re)
- ;; Set special position at first white space character after
- ;; bullet, and check-box, if any.
- (let ((after-bullet
- (let ((box (match-end 3)))
- (if (not box) (match-end 1)
- (let ((after (char-after box)))
- (if (and after (= after ? )) (1+ box) box))))))
- ;; Special case: Move point to special position when
- ;; currently after it or at beginning of line.
- (if (eq special t)
- (when (or (> pos after-bullet) (= (point) pos))
- (goto-char after-bullet))
- ;; Reversed case: Move point to special position when
- ;; point was already at beginning of line and command is
- ;; repeated.
- (when (and (= (point) pos) (eq last-command this-command))
- (goto-char after-bullet))))))))
- (org-no-warnings
- (and (featurep 'xemacs) (setq zmacs-region-stays t))))
- (setq disable-point-adjustment
- (or (not (invisible-p (point)))
- (not (invisible-p (max (point-min) (1- (point))))))))
-
-(defun org-end-of-line (&optional arg)
- "Go to the end of the line.
+(defun org-beginning-of-line (&optional n)
+ "Go to the beginning of the current visible line.
+
If this is a headline, and `org-special-ctrl-a/e' is set, ignore
tags on the first attempt, and only move to after the tags when
-the cursor is already beyond the end of the headline."
- (interactive "P")
- (let ((special (if (consp org-special-ctrl-a/e) (cdr org-special-ctrl-a/e)
- org-special-ctrl-a/e))
- (move-fun (cond ((org-bound-and-true-p visual-line-mode)
- 'end-of-visual-line)
- ((fboundp 'move-end-of-line) 'move-end-of-line)
- (t 'end-of-line)))
+the cursor is already beyond the end of the headline.
+
+With argument N not nil or 1, move forward N - 1 lines first."
+ (interactive "^p")
+ (let ((origin (point))
+ (special (pcase org-special-ctrl-a/e
+ (`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e)))
deactivate-mark)
- (if (or (not special) arg) (call-interactively move-fun)
- (let* ((element (save-excursion (beginning-of-line)
- (org-element-at-point)))
- (type (org-element-type element)))
- (cond
- ((memq type '(headline inlinetask))
- (let ((pos (point)))
- (beginning-of-line 1)
- (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$"))
- (if (eq special t)
- (if (or (< pos (match-beginning 1)) (= pos (match-end 0)))
- (goto-char (match-beginning 1))
- (goto-char (match-end 0)))
- (if (or (< pos (match-end 0))
- (not (eq this-command last-command)))
- (goto-char (match-end 0))
- (goto-char (match-beginning 1))))
- (call-interactively move-fun))))
- ((outline-invisible-p (line-end-position))
- ;; If element is hidden, `move-end-of-line' would put point
- ;; after it. Use `end-of-line' to stay on current line.
- (call-interactively 'end-of-line))
- (t (call-interactively move-fun)))))
- (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))
- (setq disable-point-adjustment
- (or (not (invisible-p (point)))
- (not (invisible-p (max (point-min) (1- (point))))))))
+ ;; First move to a visible line.
+ (if (bound-and-true-p visual-line-mode)
+ (beginning-of-visual-line n)
+ (move-beginning-of-line n)
+ ;; `move-beginning-of-line' may leave point after invisible
+ ;; characters if line starts with such of these (e.g., with
+ ;; a link at column 0). Really move to the beginning of the
+ ;; current visible line.
+ (beginning-of-line))
+ (cond
+ ;; No special behavior. Point is already at the beginning of
+ ;; a line, logical or visual.
+ ((not special))
+ ;; `beginning-of-visual-line' left point before logical beginning
+ ;; of line: point is at the beginning of a visual line. Bail
+ ;; out.
+ ((and (bound-and-true-p visual-line-mode) (not (bolp))))
+ ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp))
+ ;; At a headline, special position is before the title, but
+ ;; after any TODO keyword or priority cookie.
+ (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
+ (line-end-position)))
+ (bol (point)))
+ (if (eq special 'reversed)
+ (when (and (= origin bol) (eq last-command this-command))
+ (goto-char refpos))
+ (when (or (> origin refpos) (= origin bol))
+ (goto-char refpos)))))
+ ((and (looking-at org-list-full-item-re)
+ (memq (org-element-type (save-match-data (org-element-at-point)))
+ '(item plain-list)))
+ ;; Set special position at first white space character after
+ ;; bullet, and check-box, if any.
+ (let ((after-bullet
+ (let ((box (match-end 3)))
+ (cond ((not box) (match-end 1))
+ ((eq (char-after box) ?\s) (1+ box))
+ (t box)))))
+ (if (eq special 'reversed)
+ (when (and (= (point) origin) (eq last-command this-command))
+ (goto-char after-bullet))
+ (when (or (> origin after-bullet) (= (point) origin))
+ (goto-char after-bullet)))))
+ ;; No special context. Point is already at beginning of line.
+ (t nil))))
+
+(defun org-end-of-line (&optional n)
+ "Go to the end of the line, but before ellipsis, if any.
+
+If this is a headline, and `org-special-ctrl-a/e' is set, ignore
+tags on the first attempt, and only move to after the tags when
+the cursor is already beyond the end of the headline.
+
+With argument N not nil or 1, move forward N - 1 lines first."
+ (interactive "^p")
+ (let ((origin (point))
+ (special (pcase org-special-ctrl-a/e
+ (`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e)))
+ deactivate-mark)
+ ;; First move to a visible line.
+ (if (bound-and-true-p visual-line-mode)
+ (beginning-of-visual-line n)
+ (move-beginning-of-line n))
+ (cond
+ ;; At a headline, with tags.
+ ((and special
+ (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp)))
+ (match-end 5))
+ (let ((tags (save-excursion
+ (goto-char (match-beginning 5))
+ (skip-chars-backward " \t")
+ (point)))
+ (visual-end (and (bound-and-true-p visual-line-mode)
+ (save-excursion
+ (end-of-visual-line)
+ (point)))))
+ ;; If `end-of-visual-line' brings us before end of line or
+ ;; even tags, i.e., the headline spans over multiple visual
+ ;; lines, move there.
+ (cond ((and visual-end
+ (< visual-end tags)
+ (<= origin visual-end))
+ (goto-char visual-end))
+ ((eq special 'reversed)
+ (if (and (= origin (line-end-position))
+ (eq this-command last-command))
+ (goto-char tags)
+ (end-of-line)))
+ (t
+ (if (or (< origin tags) (= origin (line-end-position)))
+ (goto-char tags)
+ (end-of-line))))))
+ ((bound-and-true-p visual-line-mode)
+ (let ((bol (line-beginning-position)))
+ (end-of-visual-line)
+ ;; If `end-of-visual-line' gets us past the ellipsis at the
+ ;; end of a line, backtrack and use `end-of-line' instead.
+ (when (/= bol (line-beginning-position))
+ (goto-char bol)
+ (end-of-line))))
+ (t (end-of-line)))))
(define-key org-mode-map "\C-a" 'org-beginning-of-line)
(define-key org-mode-map "\C-e" 'org-end-of-line)
@@ -24056,14 +23953,14 @@ depending on context."
((or (not org-special-ctrl-k)
(bolp)
(not (org-at-heading-p)))
- (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
- org-ctrl-k-protect-subtree)
- (if (or (eq org-ctrl-k-protect-subtree 'error)
- (not (y-or-n-p "Kill hidden subtree along with headline? ")))
- (user-error "C-k aborted as it would kill a hidden subtree")))
+ (when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
+ org-ctrl-k-protect-subtree
+ (or (eq org-ctrl-k-protect-subtree 'error)
+ (not (y-or-n-p "Kill hidden subtree along with headline? "))))
+ (user-error "C-k aborted as it would kill a hidden subtree"))
(call-interactively
- (if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
- ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))
+ (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
+ ((looking-at ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")
(kill-region (point) (match-beginning 1))
(org-set-tags nil t))
(t (kill-region (point) (point-at-eol)))))
@@ -24076,20 +23973,21 @@ This command will look at the current kill and check if is a single
subtree, or a series of subtrees[1]. If it passes the test, and if the
cursor is at the beginning of a line or after the stars of a currently
empty headline, then the yank is handled specially. How exactly depends
-on the value of the following variables, both set by default.
+on the value of the following variables.
`org-yank-folded-subtrees'
- When set, the subtree(s) will be folded after insertion, but only
- if doing so would now swallow text after the yanked text.
+ By default, this variable is non-nil, which results in
+ subtree(s) being folded after insertion, except if doing so
+ would swallow text after the yanked text.
`org-yank-adjusted-subtrees'
- When set, the subtree will be promoted or demoted in order to
- fit into the local outline tree structure, which means that the
- level will be adjusted so that it becomes the smaller one of the
- two *visible* surrounding headings.
+ When non-nil (the default value is nil), the subtree will be
+ promoted or demoted in order to fit into the local outline tree
+ structure, which means that the level will be adjusted so that it
+ becomes the smaller one of the two *visible* surrounding headings.
Any prefix to this command will cause `yank' to be called directly with
-no special treatment. In particular, a simple \\[universal-argument] prefix \
+no special treatment. In particular, a simple `\\[universal-argument]' prefix \
will just
plainly yank the text as it is.
@@ -24167,11 +24065,9 @@ interactive command with similar behavior."
(setq level (org-outline-level)))
(goto-char end)
(skip-chars-forward " \t\r\n\v\f")
- (if (or (eobp)
- (and (bolp) (looking-at org-outline-regexp)
- (<= (org-outline-level) level)))
- nil ; Nothing would be swallowed
- t))))) ; something would swallow
+ (not (or (eobp)
+ (and (bolp) (looking-at-p org-outline-regexp)
+ (<= (org-outline-level) level))))))))
(define-key org-mode-map "\C-y" 'org-yank)
@@ -24180,14 +24076,13 @@ interactive command with similar behavior."
This version does not only check the character property, but also
`visible-mode'."
;; Early versions of noutline don't have `outline-invisible-p'.
- (if (org-bound-and-true-p visible-mode)
- nil
+ (unless (bound-and-true-p visible-mode)
(outline-invisible-p)))
(defun org-invisible-p2 ()
"Check if point is at a character currently not visible."
(save-excursion
- (if (and (eolp) (not (bobp))) (backward-char 1))
+ (when (and (eolp) (not (bobp))) (backward-char 1))
;; Early versions of noutline don't have `outline-invisible-p'.
(outline-invisible-p)))
@@ -24206,8 +24101,6 @@ This version does not only check the character property, but also
(defun org-at-heading-p (&optional ignored)
(outline-on-heading-p t))
-;; Compatibility alias with Org versions < 7.8.03
-(defalias 'org-on-heading-p 'org-at-heading-p)
(defun org-in-commented-heading-p (&optional no-inheritance)
"Non-nil if point is under a commented heading.
@@ -24218,8 +24111,8 @@ unless optional argument NO-INHERITANCE is non-nil."
((let ((headline (nth 4 (org-heading-components))))
(and headline
(let ((case-fold-search nil))
- (org-string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
- headline)))))
+ (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
+ headline)))))
(no-inheritance nil)
(t
(save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
@@ -24268,9 +24161,7 @@ empty."
"Move to the heading line of which the present line is a subheading.
This function considers both visible and invisible heading lines.
With argument, move up ARG levels."
- (if (fboundp 'outline-up-heading-all)
- (outline-up-heading-all arg) ; emacs 21 version of outline.el
- (outline-up-heading arg t))) ; emacs 22 version of outline.el
+ (outline-up-heading arg t))
(defun org-up-heading-safe ()
"Move to the heading line of which the present line is a subheading.
@@ -24369,8 +24260,7 @@ This is like outline-next-sibling, but invisible headings are ok."
(outline-next-heading)
(while (and (not (eobp)) (> (funcall outline-level) level))
(outline-next-heading))
- (if (or (eobp) (< (funcall outline-level) level))
- nil
+ (unless (or (eobp) (< (funcall outline-level) level))
(point))))
(defun org-get-last-sibling ()
@@ -24383,8 +24273,7 @@ If there is no such heading, return nil."
(while (and (> (funcall outline-level) level)
(not (bobp)))
(outline-previous-heading))
- (if (< (funcall outline-level) level)
- nil
+ (unless (< (funcall outline-level) level)
(point)))))
(defun org-end-of-subtree (&optional invisible-ok to-heading)
@@ -24400,7 +24289,7 @@ If there is no such heading, return nil."
(let ((first t)
(level (funcall outline-level)))
(if (and (derived-mode-p 'org-mode) (< level 1000))
- ;; A true heading (not a plain list item), in Org-mode
+ ;; A true heading (not a plain list item), in Org
;; This means we can easily find the end by looking
;; only for the right number of stars. Using a regexp to do
;; this is so much faster than using a Lisp loop.
@@ -24413,13 +24302,12 @@ If there is no such heading, return nil."
(setq first nil)
(outline-next-heading)))
(unless to-heading
- (if (memq (preceding-char) '(?\n ?\^M))
- (progn
- ;; Go to end of line before heading
- (forward-char -1)
- (if (memq (preceding-char) '(?\n ?\^M))
- ;; leave blank line before heading
- (forward-char -1))))))
+ (when (memq (preceding-char) '(?\n ?\^M))
+ ;; Go to end of line before heading
+ (forward-char -1)
+ (when (memq (preceding-char) '(?\n ?\^M))
+ ;; leave blank line before heading
+ (forward-char -1)))))
(point))
(defun org-end-of-meta-data (&optional full)
@@ -24429,7 +24317,7 @@ clocking lines and regular drawers at the beginning of the
entry."
(org-back-to-heading t)
(forward-line)
- (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at-p org-planning-line-re) (forward-line))
(when (looking-at org-property-drawer-re)
(goto-char (match-end 0))
(forward-line))
@@ -24438,11 +24326,11 @@ entry."
(let ((end (save-excursion (outline-next-heading) (point)))
(re (concat "[ \t]*$" "\\|" org-clock-line-re)))
(while (not (eobp))
- (cond ((org-looking-at-p org-drawer-regexp)
+ (cond ((looking-at-p org-drawer-regexp)
(if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
(forward-line)
(throw 'exit t)))
- ((org-looking-at-p re) (forward-line))
+ ((looking-at-p re) (forward-line))
(t (throw 'exit t))))))))
(defun org-forward-heading-same-level (arg &optional invisible-ok)
@@ -24536,7 +24424,7 @@ Throw an error if no block is found."
(<= (match-beginning 0)
(org-element-property :post-affiliated element)))
(setq last-element element)
- (decf count))))
+ (cl-decf count))))
(if (= count 0)
(prog1 (goto-char (org-element-property :post-affiliated last-element))
(save-match-data (org-show-context)))
@@ -24608,7 +24496,7 @@ item, etc. It also provides some special moves for convenience:
((not contents-begin) (goto-char end))
;; If contents are invisible, skip the element altogether.
((outline-invisible-p (line-end-position))
- (case type
+ (cl-case type
(headline
(org-with-limited-levels (outline-next-visible-heading 1)))
;; At a plain list, make sure we move to the next item
@@ -24619,7 +24507,7 @@ item, etc. It also provides some special moves for convenience:
((>= (point) contents-end) (goto-char end))
((>= (point) contents-begin)
;; This can only happen on paragraphs and plain lists.
- (case type
+ (cl-case type
(paragraph (goto-char end))
;; At a plain list, try to move to second element in
;; first item, if possible.
@@ -24840,7 +24728,7 @@ Move to the previous element at the same level, when possible."
(defun org-drag-line-forward (arg)
"Drag the line at point ARG lines forward."
(interactive "p")
- (dotimes (n (abs arg))
+ (dotimes (_ (abs arg))
(let ((c (current-column)))
(if (< 0 arg)
(progn
@@ -24864,7 +24752,7 @@ mode) if the mark is active, it marks the next element after the
ones already marked."
(interactive)
(let (deactivate-mark)
- (if (and (org-called-interactively-p 'any)
+ (if (and (called-interactively-p 'any)
(or (and (eq last-command this-command) (mark t))
(and transient-mark-mode mark-active)))
(set-mark
@@ -24910,13 +24798,10 @@ modified."
(interactive)
(unless (eq major-mode 'org-mode)
(user-error "Cannot un-indent a buffer not in Org mode"))
- (let* ((parse-tree (org-element-parse-buffer 'greater-element))
- unindent-tree ; For byte-compiler.
- (unindent-tree
- (function
- (lambda (contents)
- (mapc
- (lambda (element)
+ (letrec ((parse-tree (org-element-parse-buffer 'greater-element))
+ (unindent-tree
+ (lambda (contents)
+ (dolist (element (reverse contents))
(if (memq (org-element-type element) '(headline section))
(funcall unindent-tree (org-element-contents element))
(save-excursion
@@ -24924,10 +24809,49 @@ modified."
(narrow-to-region
(org-element-property :begin element)
(org-element-property :end element))
- (org-do-remove-indentation)))))
- (reverse contents))))))
+ (org-do-remove-indentation))))))))
(funcall unindent-tree (org-element-contents parse-tree))))
+(defun org-show-children (&optional level)
+ "Show all direct subheadings of this heading.
+Prefix arg LEVEL is how many levels below the current level
+should be shown. Default is enough to cause the following
+heading to appear."
+ (interactive "p")
+ ;; If `orgstruct-mode' is active, use the slower version.
+ (if orgstruct-mode (call-interactively #'outline-show-children)
+ (save-excursion
+ (org-back-to-heading t)
+ (let* ((current-level (funcall outline-level))
+ (max-level (org-get-valid-level
+ current-level
+ (if level (prefix-numeric-value level) 1)))
+ (end (save-excursion (org-end-of-subtree t t)))
+ (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
+ (past-first-child nil)
+ ;; Make sure to skip inlinetasks.
+ (re (format regexp-fmt
+ current-level
+ (cond
+ ((not (featurep 'org-inlinetask)) "")
+ (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
+ 3))
+ (t (1- org-inlinetask-min-level))))))
+ ;; Display parent heading.
+ (outline-flag-region (line-end-position 0) (line-end-position) nil)
+ (forward-line)
+ ;; Display children. First child may be deeper than expected
+ ;; MAX-LEVEL. Since we want to display it anyway, adjust
+ ;; MAX-LEVEL accordingly.
+ (while (re-search-forward re end t)
+ (unless past-first-child
+ (setq re (format regexp-fmt
+ current-level
+ (max (funcall outline-level) max-level)))
+ (setq past-first-child t))
+ (outline-flag-region
+ (line-end-position 0) (line-end-position) nil))))))
+
(defun org-show-subtree ()
"Show everything after this heading at deeper levels."
(interactive)
@@ -24963,36 +24887,12 @@ when non-nil, is a regexp matching keywords names."
(and extra (concat (and kwds "\\|") extra))
"\\):[ \t]*\\(.*\\)"))
-;; Make isearch reveal the necessary context
-(defun org-isearch-end ()
- "Reveal context after isearch exits."
- (when isearch-success ; only if search was successful
- (if (featurep 'xemacs)
- ;; Under XEmacs, the hook is run in the correct place,
- ;; we directly show the context.
- (org-show-context 'isearch)
- ;; In Emacs the hook runs *before* restoring the overlays.
- ;; So we have to use a one-time post-command-hook to do this.
- ;; (Emacs 22 has a special variable, see function `org-mode')
- (unless (and (boundp 'isearch-mode-end-hook-quit)
- isearch-mode-end-hook-quit)
- ;; Only when the isearch was not quitted.
- (org-add-hook 'post-command-hook 'org-isearch-post-command
- 'append 'local)))))
-
-(defun org-isearch-post-command ()
- "Remove self from hook, and show context."
- (remove-hook 'post-command-hook 'org-isearch-post-command 'local)
- (org-show-context 'isearch))
-
-
;;;; Integration with and fixes for other packages
;;; Imenu support
-(defvar org-imenu-markers nil
+(defvar-local org-imenu-markers nil
"All markers currently used by Imenu.")
-(make-variable-buffer-local 'org-imenu-markers)
(defun org-imenu-new-marker (&optional pos)
"Return a new marker for use by Imenu, and remember the marker."
@@ -25003,50 +24903,48 @@ when non-nil, is a regexp matching keywords names."
(defun org-imenu-get-tree ()
"Produce the index for Imenu."
- (mapc (lambda (x) (move-marker x nil)) org-imenu-markers)
+ (dolist (x org-imenu-markers) (move-marker x nil))
(setq org-imenu-markers nil)
- (let* ((n org-imenu-depth)
+ (let* ((case-fold-search nil)
+ (n org-imenu-depth)
(re (concat "^" (org-get-limited-outline-regexp)))
(subs (make-vector (1+ n) nil))
(last-level 0)
m level head0 head)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-max))
- (while (re-search-backward re nil t)
- (setq level (org-reduced-level (funcall outline-level)))
- (when (and (<= level n)
- (looking-at org-complex-heading-regexp)
- (setq head0 (org-match-string-no-properties 4)))
- (setq head (org-link-display-format head0)
- m (org-imenu-new-marker))
- (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
- (if (>= level last-level)
- (push (cons head m) (aref subs level))
- (push (cons head (aref subs (1+ level))) (aref subs level))
- (loop for i from (1+ level) to n do (aset subs i nil)))
- (setq last-level level)))))
+ (org-with-wide-buffer
+ (goto-char (point-max))
+ (while (re-search-backward re nil t)
+ (setq level (org-reduced-level (funcall outline-level)))
+ (when (and (<= level n)
+ (looking-at org-complex-heading-regexp)
+ (setq head0 (match-string-no-properties 4)))
+ (setq head (org-link-display-format head0)
+ m (org-imenu-new-marker))
+ (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
+ (if (>= level last-level)
+ (push (cons head m) (aref subs level))
+ (push (cons head (aref subs (1+ level))) (aref subs level))
+ (cl-loop for i from (1+ level) to n do (aset subs i nil)))
+ (setq last-level level))))
(aref subs 1)))
(eval-after-load "imenu"
'(progn
(add-hook 'imenu-after-jump-hook
(lambda ()
- (if (derived-mode-p 'org-mode)
- (org-show-context 'org-goto))))))
+ (when (derived-mode-p 'org-mode)
+ (org-show-context 'org-goto))))))
-(defun org-link-display-format (link)
- "Replace a link with its the description.
+(defun org-link-display-format (s)
+ "Replace links in string S with their description.
If there is no description, use the link target."
(save-match-data
- (if (string-match org-bracket-link-analytic-regexp link)
- (replace-match (if (match-end 5)
- (match-string 5 link)
- (concat (match-string 1 link)
- (match-string 3 link)))
- nil t link)
- link)))
+ (replace-regexp-in-string
+ org-bracket-link-analytic-regexp
+ (lambda (m)
+ (if (match-end 5) (match-string 5 m)
+ (concat (match-string 1 m) (match-string 3 m))))
+ s nil t)))
(defun org-toggle-link-display ()
"Toggle the literal or descriptive display of links."
@@ -25067,11 +24965,11 @@ If there is no description, use the link target."
'face 'org-agenda-restriction-lock)
(overlay-put org-speedbar-restriction-lock-overlay
'help-echo "Agendas are currently limited to this item.")
-(org-detach-overlay org-speedbar-restriction-lock-overlay)
+(delete-overlay org-speedbar-restriction-lock-overlay)
(defun org-speedbar-set-agenda-restriction ()
"Restrict future agenda commands to the location at point in speedbar.
-To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
+To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
(interactive)
(require 'org-agenda)
(let (p m tp np dir txt)
@@ -25095,9 +24993,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(let ((default-directory dir))
(expand-file-name txt)))
(unless (derived-mode-p 'org-mode)
- (user-error "Cannot restrict to non-Org-mode file"))
+ (user-error "Cannot restrict to non-Org mode file"))
(org-agenda-set-restriction-lock 'file)))
- (t (user-error "Don't know how to restrict Org-mode's agenda")))
+ (t (user-error "Don't know how to restrict Org mode agenda")))
(move-overlay org-speedbar-restriction-lock-overlay
(point-at-bol) (point-at-eol))
(setq current-prefix-arg nil)
@@ -25121,9 +25019,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
"Non-nil when Flyspell can check object at point.
ELEMENT is the element at point."
(let ((object (save-excursion
- (when (org-looking-at-p "\\>") (backward-char))
+ (when (looking-at-p "\\>") (backward-char))
(org-element-context element))))
- (case (org-element-type object)
+ (cl-case (org-element-type object)
;; Prevent checks in links due to keybinding conflict with
;; Flyspell.
((code entity export-snippet inline-babel-call
@@ -25146,8 +25044,9 @@ ELEMENT is the element at point."
;; faster than relying on `org-element-at-point'.
(and (save-excursion (beginning-of-line)
(and (let ((case-fold-search t))
- (not (looking-at "\\*+ END[ \t]*$")))
- (looking-at org-complex-heading-regexp)))
+ (not (looking-at-p "\\*+ END[ \t]*$")))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))))
(match-beginning 4)
(>= (point) (match-beginning 4))
(or (not (match-beginning 5))
@@ -25173,7 +25072,7 @@ ELEMENT is the element at point."
t)))))
nil)
(t
- (case (org-element-type element)
+ (cl-case (org-element-type element)
((comment quote-section) t)
(comment-block
;; Allow checks between block markers, not on them.
@@ -25201,7 +25100,7 @@ ELEMENT is the element at point."
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
- (and (org-bound-and-true-p flyspell-mode)
+ (and (bound-and-true-p flyspell-mode)
(fboundp 'flyspell-delete-region-overlays)
(flyspell-delete-region-overlays beg end)))
@@ -25229,8 +25128,8 @@ ELEMENT is the element at point."
(eval-after-load "ecb"
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
"Make hierarchy visible when jumping into location from ECB tree buffer."
- (if (derived-mode-p 'org-mode)
- (org-show-context))))
+ (when (derived-mode-p 'org-mode)
+ (org-show-context))))
(defun org-bookmark-jump-unhide ()
"Unhide the current position, to show the bookmark location."
diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el
index aa12d9e..43808aa 100644
--- a/lisp/ox-ascii.el
+++ b/lisp/ox-ascii.el
@@ -1,4 +1,4 @@
-;;; ox-ascii.el --- ASCII Back-End for Org Export Engine
+;;; ox-ascii.el --- ASCII Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@@ -27,9 +27,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'ox)
(require 'ox-publish)
+(require 'cl-lib)
(declare-function aa2u "ext:ascii-art-to-unicode" ())
@@ -93,7 +93,6 @@
(underline . org-ascii-underline)
(verbatim . org-ascii-verbatim)
(verse-block . org-ascii-verse-block))
- :export-block "ASCII"
:menu-entry
'(?t "Export to Plain Text"
((?A "As ASCII buffer"
@@ -189,7 +188,7 @@ This margin is applied on both sides of the text."
This margin applies to top level list only, not to its
sub-lists."
:group 'org-export-ascii
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'integer)
@@ -370,7 +369,7 @@ Otherwise, place it right after it."
:type 'string)
(defcustom org-ascii-format-drawer-function
- (lambda (name contents width) contents)
+ (lambda (_name contents _width) contents)
"Function called to format a drawer in ASCII.
The function must accept three parameters:
@@ -512,7 +511,7 @@ that is according to the widest non blank line in CONTENTS."
;; possible.
(save-excursion
(while (not (eobp))
- (unless (org-looking-at-p "[ \t]*$")
+ (unless (looking-at-p "[ \t]*$")
(end-of-line)
(let ((column (current-column)))
(cond
@@ -525,8 +524,8 @@ that is according to the widest non blank line in CONTENTS."
(if (eq how 'right) 1 2))))
(if (zerop offset) (throw 'exit contents)
(while (not (eobp))
- (unless (org-looking-at-p "[ \t]*$")
- (org-indent-to-column offset))
+ (unless (looking-at-p "[ \t]*$")
+ (indent-to-column offset))
(forward-line)))))
(buffer-string))))))))
@@ -550,23 +549,24 @@ INFO is a plist used as a communication channel."
(defun org-ascii--current-text-width (element info)
"Return maximum text width for ELEMENT's contents.
INFO is a plist used as a communication channel."
- (case (org-element-type element)
+ (pcase (org-element-type element)
;; Elements with an absolute width: `headline' and `inlinetask'.
- (inlinetask (plist-get info :ascii-inlinetask-width))
- (headline
+ (`inlinetask (plist-get info :ascii-inlinetask-width))
+ (`headline
(- (plist-get info :ascii-text-width)
(let ((low-level-rank (org-export-low-level-p element info)))
(if low-level-rank (* low-level-rank 2)
(plist-get info :ascii-global-margin)))))
;; Elements with a relative width: store maximum text width in
;; TOTAL-WIDTH.
- (otherwise
+ (_
(let* ((genealogy (org-element-lineage element nil t))
;; Total width is determined by the presence, or not, of an
;; inline task among ELEMENT parents.
(total-width
- (if (loop for parent in genealogy
- thereis (eq (org-element-type parent) 'inlinetask))
+ (if (cl-some (lambda (parent)
+ (eq (org-element-type parent) 'inlinetask))
+ genealogy)
(plist-get info :ascii-inlinetask-width)
;; No inlinetask: Remove global margin from text width.
(- (plist-get info :ascii-text-width)
@@ -585,19 +585,20 @@ INFO is a plist used as a communication channel."
(- total-width
;; Each `quote-block' and `verse-block' above narrows text
;; width by twice the standard margin size.
- (+ (* (loop for parent in genealogy
- when (memq (org-element-type parent)
- '(quote-block verse-block))
- count parent)
- 2 (plist-get info :ascii-quote-margin))
+ (+ (* (cl-count-if (lambda (parent)
+ (memq (org-element-type parent)
+ '(quote-block verse-block)))
+ genealogy)
+ 2
+ (plist-get info :ascii-quote-margin))
;; Apply list margin once per "top-level" plain-list
;; containing current line
- (* (let ((count 0))
- (dolist (e genealogy count)
- (and (eq (org-element-type e) 'plain-list)
- (not (eq (org-element-type (org-export-get-parent e))
- 'item))
- (incf count))))
+ (* (cl-count-if
+ (lambda (e)
+ (and (eq (org-element-type e) 'plain-list)
+ (not (eq (org-element-type (org-export-get-parent e))
+ 'item))))
+ genealogy)
(plist-get info :ascii-list-margin))
;; Text width within a plain-list is restricted by
;; indentation of current item. If that's the case,
@@ -605,9 +606,9 @@ INFO is a plist used as a communication channel."
;; parent item, if any.
(let ((item
(if (eq (org-element-type element) 'item) element
- (loop for parent in genealogy
- when (eq (org-element-type parent) 'item)
- return parent))))
+ (cl-find-if (lambda (parent)
+ (eq (org-element-type parent) 'item))
+ genealogy))))
(if (not item) 0
;; Compute indentation offset of the current item,
;; that is the sum of the difference between its
@@ -634,9 +635,9 @@ Return value is a symbol among `left', `center', `right' and
(let (justification)
(while (and (not justification)
(setq element (org-element-property :parent element)))
- (case (org-element-type element)
- (center-block (setq justification 'center))
- (special-block
+ (pcase (org-element-type element)
+ (`center-block (setq justification 'center))
+ (`special-block
(let ((name (org-element-property :type element)))
(cond ((string= name "JUSTIFYRIGHT") (setq justification 'right))
((string= name "JUSTIFYLEFT") (setq justification 'left)))))))
@@ -712,7 +713,7 @@ possible. It doesn't apply to `inlinetask' elements."
(char-width under-char))
under-char))))))))
-(defun org-ascii--has-caption-p (element info)
+(defun org-ascii--has-caption-p (element _info)
"Non-nil when ELEMENT has a caption affiliated keyword.
INFO is a plist used as a communication channel. This function
is meant to be used as a predicate for `org-export-get-ordinal'."
@@ -734,9 +735,9 @@ caption keyword."
(org-export-get-ordinal
element info nil 'org-ascii--has-caption-p))
(title-fmt (org-ascii--translate
- (case (org-element-type element)
- (table "Table %d:")
- (src-block "Listing %d:"))
+ (pcase (org-element-type element)
+ (`table "Table %d:")
+ (`src-block "Listing %d:"))
info)))
(org-ascii--fill-string
(concat (format title-fmt reference)
@@ -807,7 +808,7 @@ generation. INFO is a plist used as a communication channel."
;; filling (like contents of a description list item).
(let* ((initial-text
(format (org-ascii--translate "Listing %d:" info)
- (incf count)))
+ (cl-incf count)))
(initial-width (string-width initial-text)))
(concat
initial-text " "
@@ -847,7 +848,7 @@ generation. INFO is a plist used as a communication channel."
;; filling (like contents of a description list item).
(let* ((initial-text
(format (org-ascii--translate "Table %d:" info)
- (incf count)))
+ (cl-incf count)))
(initial-width (string-width initial-text)))
(concat
initial-text " "
@@ -868,34 +869,32 @@ ELEMENT is either a headline element or a section element. INFO
is a plist used as a communication channel."
(let* (seen
(unique-link-p
- (function
- ;; Return LINK if it wasn't referenced so far, or nil.
- ;; Update SEEN links along the way.
- (lambda (link)
- (let ((footprint
- ;; Normalize description in footprints.
- (cons (org-element-property :raw-link link)
- (let ((contents (org-element-contents link)))
- (and contents
- (replace-regexp-in-string
- "[ \r\t\n]+" " "
- (org-trim
- (org-element-interpret-data contents))))))))
- ;; Ignore LINK if it hasn't been translated already.
- ;; It can happen if it is located in an affiliated
- ;; keyword that was ignored.
- (when (and (org-string-nw-p
- (gethash link (plist-get info :exported-data)))
- (not (member footprint seen)))
- (push footprint seen) link)))))
- ;; If at a section, find parent headline, if any, in order to
- ;; count links that might be in the title.
- (headline
- (if (eq (org-element-type element) 'headline) element
- (or (org-export-get-parent-headline element) element))))
- ;; Get all links in HEADLINE.
- (org-element-map headline 'link
- (lambda (l) (funcall unique-link-p l)) info nil nil t)))
+ ;; Return LINK if it wasn't referenced so far, or nil.
+ ;; Update SEEN links along the way.
+ (lambda (link)
+ (let ((footprint
+ ;; Normalize description in footprints.
+ (cons (org-element-property :raw-link link)
+ (let ((contents (org-element-contents link)))
+ (and contents
+ (replace-regexp-in-string
+ "[ \r\t\n]+" " "
+ (org-trim
+ (org-element-interpret-data contents))))))))
+ ;; Ignore LINK if it hasn't been translated already. It
+ ;; can happen if it is located in an affiliated keyword
+ ;; that was ignored.
+ (when (and (org-string-nw-p
+ (gethash link (plist-get info :exported-data)))
+ (not (member footprint seen)))
+ (push footprint seen) link)))))
+ (org-element-map (if (eq (org-element-type element) 'section)
+ element
+ ;; In a headline, only retrieve links in title
+ ;; and relative section, not in children.
+ (list (org-element-property :title element)
+ (car (org-element-contents element))))
+ 'link unique-link-p info nil 'headline t)))
(defun org-ascii--describe-links (links width info)
"Return a string describing a list of links.
@@ -938,11 +937,7 @@ channel."
((not (org-element-contents link)) nil)
;; Do not add a link already handled by custom export
;; functions.
- ((let ((protocol (nth 2 (assoc type org-link-protocols)))
- (path (org-element-property :path link)))
- (and (functionp protocol)
- (funcall protocol (org-link-unescape path) anchor 'ascii)))
- nil)
+ ((org-export-custom-protocol-maybe link anchor 'ascii) nil)
(t
(concat
(org-ascii--fill-string
@@ -955,10 +950,10 @@ channel."
"Return checkbox string for ITEM or nil.
INFO is a plist used as a communication channel."
(let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
- (case (org-element-property :checkbox item)
- (on (if utf8p "☑ " "[X] "))
- (off (if utf8p "☐ " "[ ] "))
- (trans (if utf8p "☒ " "[-] ")))))
+ (pcase (org-element-property :checkbox item)
+ (`on (if utf8p "☑ " "[X] "))
+ (`off (if utf8p "☐ " "[ ] "))
+ (`trans (if utf8p "☒ " "[-] ")))))
@@ -1081,7 +1076,8 @@ holding export options."
;; full-fledged definitions.
(org-trim
(let ((def (nth 2 ref)))
- (if (eq (org-element-type def) 'org-data)
+ (if (org-element-map def org-element-all-elements
+ #'identity info 'first-match)
;; Full-fledged definition: footnote ID is
;; inserted inside the first parsed
;; paragraph (FIRST), if any, to be sure
@@ -1141,7 +1137,7 @@ INFO is a plist used as a communication channel."
;;;; Bold
-(defun org-ascii-bold (bold contents info)
+(defun org-ascii-bold (_bold contents _info)
"Transcode BOLD from Org to ASCII.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -1150,7 +1146,7 @@ contextual information."
;;;; Center Block
-(defun org-ascii-center-block (center-block contents info)
+(defun org-ascii-center-block (_center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -1161,7 +1157,7 @@ holding contextual information."
;;;; Clock
-(defun org-ascii-clock (clock contents info)
+(defun org-ascii-clock (clock _contents info)
"Transcode a CLOCK object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1179,7 +1175,7 @@ information."
;;;; Code
-(defun org-ascii-code (code contents info)
+(defun org-ascii-code (code _contents info)
"Return a CODE object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1201,7 +1197,7 @@ holding contextual information."
;;;; Dynamic Block
-(defun org-ascii-dynamic-block (dynamic-block contents info)
+(defun org-ascii-dynamic-block (_dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -1210,7 +1206,7 @@ holding contextual information."
;;;; Entity
-(defun org-ascii-entity (entity contents info)
+(defun org-ascii-entity (entity _contents info)
"Transcode an ENTITY object from Org to ASCII.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -1221,7 +1217,7 @@ contextual information."
;;;; Example Block
-(defun org-ascii-example-block (example-block contents info)
+(defun org-ascii-example-block (example-block _contents info)
"Transcode a EXAMPLE-BLOCK element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-ascii--justify-element
@@ -1232,7 +1228,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Snippet
-(defun org-ascii-export-snippet (export-snippet contents info)
+(defun org-ascii-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'ascii)
@@ -1241,7 +1237,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Block
-(defun org-ascii-export-block (export-block contents info)
+(defun org-ascii-export-block (export-block _contents info)
"Transcode a EXPORT-BLOCK element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "ASCII")
@@ -1251,7 +1247,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-ascii-fixed-width (fixed-width contents info)
+(defun org-ascii-fixed-width (fixed-width _contents info)
"Transcode a FIXED-WIDTH element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-ascii--justify-element
@@ -1269,7 +1265,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Reference
-(defun org-ascii-footnote-reference (footnote-reference contents info)
+(defun org-ascii-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(format "[%s]" (org-export-get-footnote-number footnote-reference info)))
@@ -1284,51 +1280,55 @@ holding contextual information."
;; Don't export footnote section, which will be handled at the end
;; of the template.
(unless (org-element-property :footnote-section-p headline)
- (let* ((low-level-rank (org-export-low-level-p headline info))
+ (let* ((low-level (org-export-low-level-p headline info))
(width (org-ascii--current-text-width headline info))
+ ;; Export title early so that any link in it can be
+ ;; exported and seen in `org-ascii--unique-links'.
+ (title (org-ascii--build-title headline info width (not low-level)))
;; Blank lines between headline and its contents.
;; `org-ascii-headline-spacing', when set, overwrites
;; original buffer's spacing.
(pre-blanks
- (make-string
- (or (car (plist-get info :ascii-headline-spacing))
- (org-element-property :pre-blank headline))
- ?\n))
- ;; Even if HEADLINE has no section, there might be some
- ;; links in its title that we shouldn't forget to describe.
- (links
- (unless (or (eq (caar (org-element-contents headline)) 'section))
- (let ((title (org-element-property :title headline)))
- (when (consp title)
- (org-ascii--describe-links
- (org-ascii--unique-links title info) width info))))))
+ (make-string (or (car (plist-get info :ascii-headline-spacing))
+ (org-element-property :pre-blank headline)
+ 0)
+ ?\n))
+ (links (and (plist-get info :ascii-links-to-notes)
+ (org-ascii--describe-links
+ (org-ascii--unique-links headline info) width info)))
+ ;; Re-build contents, inserting section links at the right
+ ;; place. The cost is low since build results are cached.
+ (body
+ (if (not (org-string-nw-p links)) contents
+ (let* ((contents (org-element-contents headline))
+ (section (let ((first (car contents)))
+ (and (eq (org-element-type first) 'section)
+ first))))
+ (concat (and section
+ (concat (org-element-normalize-string
+ (org-export-data section info))
+ "\n\n"))
+ links
+ (mapconcat (lambda (e) (org-export-data e info))
+ (if section (cdr contents) contents)
+ ""))))))
;; Deep subtree: export it as a list item.
- (if low-level-rank
- (concat
- ;; Bullet.
- (let ((bullets (cdr (assq (plist-get info :ascii-charset)
- (plist-get info :ascii-bullets)))))
- (char-to-string
- (nth (mod (1- low-level-rank) (length bullets)) bullets)))
- " "
- ;; Title.
- (org-ascii--build-title headline info width) "\n"
- ;; Contents, indented by length of bullet.
- pre-blanks
- (org-ascii--indent-string
- (concat contents
- (when (org-string-nw-p links) (concat "\n\n" links)))
- 2))
+ (if low-level
+ (let* ((bullets (cdr (assq (plist-get info :ascii-charset)
+ (plist-get info :ascii-bullets))))
+ (bullet
+ (format "%c "
+ (nth (mod (1- low-level) (length bullets)) bullets))))
+ (concat bullet title "\n" pre-blanks
+ ;; Contents, indented by length of bullet.
+ (org-ascii--indent-string body (length bullet))))
;; Else: Standard headline.
- (concat
- (org-ascii--build-title headline info width 'underline)
- "\n" pre-blanks
- (concat (when (org-string-nw-p links) links) contents))))))
+ (concat title "\n" pre-blanks body)))))
;;;; Horizontal Rule
-(defun org-ascii-horizontal-rule (horizontal-rule contents info)
+(defun org-ascii-horizontal-rule (horizontal-rule _contents info)
"Transcode an HORIZONTAL-RULE object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1345,7 +1345,7 @@ information."
;;;; Inline Src Block
-(defun org-ascii-inline-src-block (inline-src-block contents info)
+(defun org-ascii-inline-src-block (inline-src-block _contents info)
"Transcode an INLINE-SRC-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
@@ -1356,7 +1356,7 @@ contextual information."
;;;; Inlinetask
(defun org-ascii-format-inlinetask-default
- (todo type priority name tags contents width inlinetask info)
+ (_todo _type _priority _name _tags contents width inlinetask info)
"Format an inline task element for ASCII export.
See `org-ascii-format-inlinetask-function' for a description
of the parameters."
@@ -1411,7 +1411,7 @@ holding contextual information."
;;;; Italic
-(defun org-ascii-italic (italic contents info)
+(defun org-ascii-italic (_italic contents _info)
"Transcode italic from Org to ASCII.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -1431,12 +1431,12 @@ contextual information."
;; First parent of ITEM is always the plain-list. Get
;; `:type' property from it.
(org-list-bullet-string
- (case list-type
- (descriptive
+ (pcase list-type
+ (`descriptive
(concat checkbox
(org-export-data (org-element-property :tag item) info)
": "))
- (ordered
+ (`ordered
;; Return correct number for ITEM, paying attention to
;; counters.
(let* ((struct (org-element-property :structure item))
@@ -1448,7 +1448,7 @@ contextual information."
(org-list-prevs-alist struct)
(org-list-parents-alist struct)))))))
(replace-regexp-in-string "[0-9]+" num bul)))
- (t (let ((bul (org-element-property :bullet item)))
+ (_ (let ((bul (org-element-property :bullet item)))
;; Change bullets into more visible form if UTF-8 is active.
(if (not utf8p) bul
(replace-regexp-in-string
@@ -1470,7 +1470,7 @@ contextual information."
;;;; Keyword
-(defun org-ascii-keyword (keyword contents info)
+(defun org-ascii-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1482,21 +1482,21 @@ information."
(org-ascii--justify-element
(let ((case-fold-search t))
(cond
- ((org-string-match-p "\\<headlines\\>" value)
+ ((string-match-p "\\<headlines\\>" value)
(let ((depth (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value))))
- (localp (org-string-match-p "\\<local\\>" value)))
+ (localp (string-match-p "\\<local\\>" value)))
(org-ascii--build-toc info depth keyword localp)))
- ((org-string-match-p "\\<tables\\>" value)
+ ((string-match-p "\\<tables\\>" value)
(org-ascii--list-tables keyword info))
- ((org-string-match-p "\\<listings\\>" value)
+ ((string-match-p "\\<listings\\>" value)
(org-ascii--list-listings keyword info))))
keyword info)))))
;;;; Latex Environment
-(defun org-ascii-latex-environment (latex-environment contents info)
+(defun org-ascii-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1508,7 +1508,7 @@ information."
;;;; Latex Fragment
-(defun org-ascii-latex-fragment (latex-fragment contents info)
+(defun org-ascii-latex-fragment (latex-fragment _contents info)
"Transcode a LATEX-FRAGMENT object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1518,7 +1518,7 @@ information."
;;;; Line Break
-(defun org-ascii-line-break (line-break contents info)
+(defun org-ascii-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information." hard-newline)
@@ -1569,7 +1569,7 @@ INFO is a plist holding contextual information."
;;;; Node Properties
-(defun org-ascii-node-property (node-property contents info)
+(defun org-ascii-node-property (node-property _contents _info)
"Transcode a NODE-PROPERTY element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1632,7 +1632,7 @@ INFO is a plist used as a communication channel."
;;;; Planning
-(defun org-ascii-planning (planning contents info)
+(defun org-ascii-planning (planning _contents info)
"Transcode a PLANNING element from Org to ASCII.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -1668,7 +1668,7 @@ holding contextual information."
;;;; Quote Block
-(defun org-ascii-quote-block (quote-block contents info)
+(defun org-ascii-quote-block (_quote-block contents info)
"Transcode a QUOTE-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -1677,7 +1677,7 @@ holding contextual information."
;;;; Radio Target
-(defun org-ascii-radio-target (radio-target contents info)
+(defun org-ascii-radio-target (_radio-target contents _info)
"Transcode a RADIO-TARGET object from Org to ASCII.
CONTENTS is the contents of the target. INFO is a plist holding
contextual information."
@@ -1690,25 +1690,26 @@ contextual information."
"Transcode a SECTION element from Org to ASCII.
CONTENTS is the contents of the section. INFO is a plist holding
contextual information."
- (org-ascii--indent-string
- (concat
- contents
- (when (plist-get info :ascii-links-to-notes)
- ;; Add list of links at the end of SECTION.
- (let ((links (org-ascii--describe-links
- (org-ascii--unique-links section info)
- (org-ascii--current-text-width section info) info)))
- ;; Separate list of links and section contents.
- (when (org-string-nw-p links) (concat "\n\n" links)))))
- ;; Do not apply inner margin if parent headline is low level.
- (let ((headline (org-export-get-parent-headline section)))
- (if (or (not headline) (org-export-low-level-p headline info)) 0
- (plist-get info :ascii-inner-margin)))))
+ (let ((links
+ (and (plist-get info :ascii-links-to-notes)
+ ;; Take care of links in first section of the document.
+ (not (org-element-lineage section '(headline)))
+ (org-ascii--describe-links
+ (org-ascii--unique-links section info)
+ (org-ascii--current-text-width section info)
+ info))))
+ (org-ascii--indent-string
+ (if (not (org-string-nw-p links)) contents
+ (concat (org-element-normalize-string contents) "\n\n" links))
+ ;; Do not apply inner margin if parent headline is low level.
+ (let ((headline (org-export-get-parent-headline section)))
+ (if (or (not headline) (org-export-low-level-p headline info)) 0
+ (plist-get info :ascii-inner-margin))))))
;;;; Special Block
-(defun org-ascii-special-block (special-block contents info)
+(defun org-ascii-special-block (_special-block contents _info)
"Transcode a SPECIAL-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -1720,7 +1721,7 @@ holding contextual information."
;;;; Src Block
-(defun org-ascii-src-block (src-block contents info)
+(defun org-ascii-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
@@ -1738,7 +1739,7 @@ contextual information."
;;;; Statistics Cookie
-(defun org-ascii-statistics-cookie (statistics-cookie contents info)
+(defun org-ascii-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-element-property :value statistics-cookie))
@@ -1746,7 +1747,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Subscript
-(defun org-ascii-subscript (subscript contents info)
+(defun org-ascii-subscript (subscript contents _info)
"Transcode a SUBSCRIPT object from Org to ASCII.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1757,7 +1758,7 @@ contextual information."
;;;; Superscript
-(defun org-ascii-superscript (superscript contents info)
+(defun org-ascii-superscript (superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to ASCII.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1768,7 +1769,7 @@ contextual information."
;;;; Strike-through
-(defun org-ascii-strike-through (strike-through contents info)
+(defun org-ascii-strike-through (_strike-through contents _info)
"Transcode STRIKE-THROUGH from Org to ASCII.
CONTENTS is text with strike-through markup. INFO is a plist
holding contextual information."
@@ -1938,7 +1939,7 @@ a communication channel."
;;;; Timestamp
-(defun org-ascii-timestamp (timestamp contents info)
+(defun org-ascii-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-ascii-plain-text (org-timestamp-translate timestamp) info))
@@ -1946,7 +1947,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Underline
-(defun org-ascii-underline (underline contents info)
+(defun org-ascii-underline (_underline contents _info)
"Transcode UNDERLINE from Org to ASCII.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -1955,7 +1956,7 @@ holding contextual information."
;;;; Verbatim
-(defun org-ascii-verbatim (verbatim contents info)
+(defun org-ascii-verbatim (verbatim _contents info)
"Return a VERBATIM object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(format (plist-get info :ascii-verbatim-format)
@@ -1968,21 +1969,20 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a VERSE-BLOCK element from Org to ASCII.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
- (let ((verse-width (org-ascii--current-text-width verse-block info)))
- (org-ascii--indent-string
- (org-ascii--justify-element contents verse-block info)
- (plist-get info :ascii-quote-margin))))
+ (org-ascii--indent-string
+ (org-ascii--justify-element contents verse-block info)
+ (plist-get info :ascii-quote-margin)))
;;; Filters
-(defun org-ascii-filter-headline-blank-lines (headline back-end info)
+(defun org-ascii-filter-headline-blank-lines (headline _backend info)
"Filter controlling number of blank lines after a headline.
-HEADLINE is a string representing a transcoded headline.
-BACK-END is symbol specifying back-end used for export. INFO is
-plist containing the communication channel.
+HEADLINE is a string representing a transcoded headline. BACKEND
+is symbol specifying back-end used for export. INFO is plist
+containing the communication channel.
This function only applies to `ascii' back-end. See
`org-ascii-headline-spacing' for information."
@@ -1991,10 +1991,10 @@ This function only applies to `ascii' back-end. See
(let ((blanks (make-string (1+ (cdr headline-spacing)) ?\n)))
(replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))))
-(defun org-ascii-filter-paragraph-spacing (tree back-end info)
+(defun org-ascii-filter-paragraph-spacing (tree _backend info)
"Filter controlling number of blank lines between paragraphs.
-TREE is the parse tree. BACK-END is the symbol specifying
+TREE is the parse tree. BACKEND is the symbol specifying
back-end used for export. INFO is a plist used as
a communication channel.
@@ -2008,9 +2008,9 @@ See `org-ascii-paragraph-spacing' for information."
(org-element-put-property p :post-blank paragraph-spacing))))))
tree)
-(defun org-ascii-filter-comment-spacing (tree backend info)
+(defun org-ascii-filter-comment-spacing (tree _backend info)
"Filter removing blank lines between comments.
-TREE is the parse tree. BACK-END is the symbol specifying
+TREE is the parse tree. BACKEND is the symbol specifying
back-end used for export. INFO is a plist used as
a communication channel."
(org-element-map tree '(comment comment-block)
diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el
index 7afe390..c254c0b 100644
--- a/lisp/ox-beamer.el
+++ b/lisp/ox-beamer.el
@@ -1,4 +1,4 @@
-;;; ox-beamer.el --- Beamer Back-End for Org Export Engine
+;;; ox-beamer.el --- Beamer Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
@@ -29,7 +29,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox-latex)
;; Install a default set-up for Beamer export.
@@ -140,7 +140,7 @@ You might want to put e.g. \"allowframebreaks=0.9\" here."
The format string should have at most one \"%s\"-expression,
which is replaced with the subtitle."
:group 'org-export-beamer
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(string :tag "Format string"))
@@ -202,19 +202,14 @@ TYPE is a symbol among the following:
`defaction' Return ARGUMENT within both square and angular brackets.
`option' Return ARGUMENT within square brackets."
(if (not (string-match "\\S-" argument)) ""
- (case type
- (action (if (string-match "\\`<.*>\\'" argument) argument
- (format "<%s>" argument)))
- (defaction (cond
- ((string-match "\\`\\[<.*>\\]\\'" argument) argument)
- ((string-match "\\`<.*>\\'" argument)
- (format "[%s]" argument))
- ((string-match "\\`\\[\\(.*\\)\\]\\'" argument)
- (format "[<%s>]" (match-string 1 argument)))
- (t (format "[<%s>]" argument))))
- (option (if (string-match "\\`\\[.*\\]\\'" argument) argument
- (format "[%s]" argument)))
- (otherwise argument))))
+ (cl-case type
+ (action (format "<%s>" (org-unbracket-string "<" ">" argument)))
+ (defaction
+ (format "[<%s>]"
+ (org-unbracket-string "<" ">" (org-unbracket-string "[" "]" argument))))
+ (option (format "[%s]" (org-unbracket-string "[" "]" argument)))
+ (otherwise (error "Invalid `type' argument to `org-beamer--normalize-argument': %s"
+ type)))))
(defun org-beamer--element-has-overlay-p (element)
"Non-nil when ELEMENT has an overlay specified.
@@ -224,14 +219,14 @@ Return overlay specification, as a string, or nil."
(let ((first-object (car (org-element-contents element))))
(when (eq (org-element-type first-object) 'export-snippet)
(let ((value (org-element-property :value first-object)))
- (and (string-match "\\`<.*>\\'" value) value)))))
+ (and (string-prefix-p "<" value) (string-suffix-p ">" value)
+ value)))))
;;; Define Back-End
(org-export-define-derived-backend 'beamer 'latex
- :export-block "BEAMER"
:menu-entry
'(?l 1
((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex)
@@ -274,7 +269,7 @@ Return overlay specification, as a string, or nil."
;;;; Bold
-(defun org-beamer-bold (bold contents info)
+(defun org-beamer-bold (bold contents _info)
"Transcode BLOCK object into Beamer code.
CONTENTS is the text being bold. INFO is a plist used as
a communication channel."
@@ -285,7 +280,7 @@ a communication channel."
;;;; Export Block
-(defun org-beamer-export-block (export-block contents info)
+(defun org-beamer-export-block (export-block _contents _info)
"Transcode an EXPORT-BLOCK element into Beamer code.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -295,7 +290,7 @@ channel."
;;;; Export Snippet
-(defun org-beamer-export-snippet (export-snippet contents info)
+(defun org-beamer-export-snippet (export-snippet _contents info)
"Transcode an EXPORT-SNIPPET object into Beamer code.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -331,17 +326,21 @@ channel."
INFO is a plist used as a communication channel.
The value is either the label specified in \"BEAMER_opt\"
-property, or a unique internal label. This function assumes
-HEADLINE will be treated as a frame."
- (let ((opt (org-element-property :BEAMER_OPT headline)))
- (if (and (stringp opt)
- (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt))
- (let ((label (match-string 1 opt)))
- ;; Strip protective braces, if any.
- (if (org-string-match-p "\\`{.*}\\'" label)
- (substring label 1 -1)
- label))
- (format "sec:%s" (org-export-get-reference headline info)))))
+property, the custom ID, if there is one and
+`:latex-prefer-user-labels' property has a non nil value, or
+a unique internal label. This function assumes HEADLINE will be
+treated as a frame."
+ (cond
+ ((let ((opt (org-element-property :BEAMER_OPT headline)))
+ (and (stringp opt)
+ (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)
+ (let ((label (match-string 1 opt)))
+ (if (string-match-p "\\`{.*}\\'" label)
+ (substring label 1 -1)
+ label)))))
+ ((and (plist-get info :latex-prefer-user-labels)
+ (org-element-property :CUSTOM_ID headline)))
+ (t (format "sec:%s" (org-export-get-reference headline info)))))
(defun org-beamer--frame-level (headline info)
"Return frame level in subtree containing HEADLINE.
@@ -448,7 +447,7 @@ used as a communication channel."
(let ((label (org-beamer--get-label headline info)))
;; Labels containing colons need to be
;; wrapped within braces.
- (format (if (org-string-match-p ":" label)
+ (format (if (string-match-p ":" label)
"label={%s}"
"label=%s")
label)))))))
@@ -560,7 +559,8 @@ used as a communication channel."
(let ((action (org-element-property :BEAMER_ACT headline)))
(cond
((not action) (list (cons "a" "") (cons "A" "") (cons "R" "")))
- ((string-match "\\`\\[.*\\]\\'" action)
+ ((and (string-prefix-p "[" action)
+ (string-suffix-p "]" action))
(list
(cons "A" (org-beamer--normalize-argument action 'defaction))
(cons "a" "")
@@ -676,7 +676,7 @@ contextual information."
(list
(cons
'item
- (lambda (item c i)
+ (lambda (item _c _i)
(let ((action
(let ((first (car (org-element-contents item))))
(and (eq (org-element-type first) 'paragraph)
@@ -720,8 +720,7 @@ channel."
"Transcode a LINK object into Beamer code.
CONTENTS is the description part of the link. INFO is a plist
used as a communication channel."
- (let ((type (org-element-property :type link))
- (path (org-element-property :path link)))
+ (let ((type (org-element-property :type link)))
(cond
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link contents 'beamer))
@@ -737,7 +736,7 @@ used as a communication channel."
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
+ (cl-case (org-element-type destination)
(headline
(let ((label
(format "sec-%s"
@@ -813,7 +812,7 @@ contextual information."
;;;; Target
-(defun org-beamer-target (target contents info)
+(defun org-beamer-target (target _contents info)
"Transcode a TARGET object into Beamer code.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -832,34 +831,14 @@ holding export options."
(let ((title (org-export-data (plist-get info :title) info))
(subtitle (org-export-data (plist-get info :subtitle) info)))
(concat
- ;; 1. Time-stamp.
+ ;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
- ;; 2. Document class and packages.
- (let* ((class (plist-get info :latex-class))
- (class-options (plist-get info :latex-class-options))
- (header (nth 1 (assoc class org-latex-classes)))
- (document-class-string
- (and (stringp header)
- (if (not class-options) header
- (replace-regexp-in-string
- "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
- class-options header t nil 1)))))
- (if (not document-class-string)
- (user-error "Unknown LaTeX class `%s'" class)
- (org-latex-guess-babel-language
- (org-latex-guess-inputenc
- (org-element-normalize-string
- (org-splice-latex-header
- document-class-string
- org-latex-default-packages-alist
- org-latex-packages-alist nil
- (concat (org-element-normalize-string
- (plist-get info :latex-header))
- (org-element-normalize-string
- (plist-get info :latex-header-extra))))))
- info)))
- ;; 3. Insert themes.
+ ;; LaTeX compiler
+ (org-latex--insert-compiler info)
+ ;; Document class and packages.
+ (org-latex--make-preamble info)
+ ;; Insert themes.
(let ((format-theme
(function
(lambda (prop command)
@@ -879,11 +858,11 @@ holding export options."
(:beamer-inner-theme "\\useinnertheme")
(:beamer-outer-theme "\\useoutertheme"))
""))
- ;; 4. Possibly limit depth for headline numbering.
+ ;; Possibly limit depth for headline numbering.
(let ((sec-num (plist-get info :section-numbers)))
(when (integerp sec-num)
(format "\\setcounter{secnumdepth}{%d}\n" sec-num)))
- ;; 5. Author.
+ ;; Author.
(let ((author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
@@ -892,14 +871,14 @@ holding export options."
(cond ((and author email (not (string= "" email)))
(format "\\author{%s\\thanks{%s}}\n" author email))
((or author email) (format "\\author{%s}\n" (or author email)))))
- ;; 6. Date.
+ ;; Date.
(let ((date (and (plist-get info :with-date) (org-export-get-date info))))
(format "\\date{%s}\n" (org-export-data date info)))
- ;; 7. Title
+ ;; Title
(format "\\title{%s}\n" title)
(when (org-string-nw-p subtitle)
(concat (format (plist-get info :beamer-subtitle-format) subtitle) "\n"))
- ;; 8. Beamer-header
+ ;; Beamer-header
(let ((beamer-header (plist-get info :beamer-header)))
(when beamer-header
(format "%s\n" (plist-get info :beamer-header))))
@@ -907,9 +886,9 @@ holding export options."
(let ((template (plist-get info :latex-hyperref-template)))
(and (stringp template)
(format-spec template (org-latex--format-spec info))))
- ;; 10. Document start.
+ ;; Document start.
"\\begin{document}\n\n"
- ;; 11. Title command.
+ ;; Title command.
(org-element-normalize-string
(cond ((not (plist-get info :with-title)) nil)
((string= "" title) nil)
@@ -918,7 +897,7 @@ holding export options."
org-latex-title-command)
(format org-latex-title-command title))
(t org-latex-title-command)))
- ;; 12. Table of contents.
+ ;; Table of contents.
(let ((depth (plist-get info :with-toc)))
(when depth
(concat
@@ -930,13 +909,13 @@ holding export options."
(format "\\setcounter{tocdepth}{%d}\n" depth))
"\\tableofcontents\n"
"\\end{frame}\n\n")))
- ;; 13. Document's body.
+ ;; Document's body.
contents
- ;; 14. Creator.
+ ;; Creator.
(if (plist-get info :with-creator)
(concat (plist-get info :creator) "\n")
"")
- ;; 15. Document end.
+ ;; Document end.
"\\end{document}")))
@@ -972,7 +951,7 @@ value."
(save-excursion
(org-back-to-heading t)
;; Filter out Beamer-related tags and install environment tag.
- (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x))
+ (let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x))
(org-get-tags)))
(env-tag (and (org-string-nw-p value) (concat "B_" value))))
(org-set-tags-to (if env-tag (cons env-tag tags) tags))
@@ -1124,7 +1103,7 @@ aid, but the tag does not have any semantic meaning."
(let* ((envs (append org-beamer-environments-special
org-beamer-environments-extra
org-beamer-environments-default))
- (org-tag-alist
+ (org-current-tag-alist
(append '((:startgroup))
(mapcar (lambda (e) (cons (concat "B_" (car e))
(string-to-char (nth 1 e))))
diff --git a/lisp/ox-html.el b/lisp/ox-html.el
index de2e5d9..404b62f 100644
--- a/lisp/ox-html.el
+++ b/lisp/ox-html.el
@@ -1,4 +1,4 @@
-;;; ox-html.el --- HTML Back-End for Org Export Engine
+;;; ox-html.el --- HTML Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@@ -30,20 +30,24 @@
;;; Dependencies
+(require 'cl-lib)
+(require 'format-spec)
(require 'ox)
(require 'ox-publish)
-(require 'format-spec)
-(eval-when-compile (require 'cl) (require 'table nil 'noerror))
+(require 'table)
;;; Function Declarations
(declare-function org-id-find-id-file "org-id" (id))
(declare-function htmlize-region "ext:htmlize" (beg end))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
(declare-function mm-url-decode-entities "mm-url" ())
+(defvar htmlize-css-name-prefix)
+(defvar htmlize-output-type)
+(defvar htmlize-output-type)
+(defvar htmlize-css-name-prefix)
+
;;; Define Back-End
(org-export-define-backend 'html
@@ -96,7 +100,6 @@
(underline . org-html-underline)
(verbatim . org-html-verbatim)
(verse-block . org-html-verse-block))
- :export-block "HTML"
:filters-alist '((:filter-options . org-html-infojs-install-script)
(:filter-final-output . org-html-final-function))
:menu-entry
@@ -117,7 +120,6 @@
(:html-link-home "HTML_LINK_HOME" nil org-html-link-home)
(:html-link-up "HTML_LINK_UP" nil org-html-link-up)
(:html-mathjax "HTML_MATHJAX" nil "" space)
- (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url)
(:html-postamble nil "html-postamble" org-html-postamble)
(:html-preamble nil "html-preamble" org-html-preamble)
(:html-head "HTML_HEAD" nil org-html-head newline)
@@ -165,7 +167,8 @@
(:html-viewport nil nil org-html-viewport)
(:html-inline-images nil nil org-html-inline-images)
(:html-table-attributes nil nil org-html-table-default-attributes)
- (:html-table-row-tags nil nil org-html-table-row-tags)
+ (:html-table-row-open-tag nil nil org-html-table-row-open-tag)
+ (:html-table-row-close-tag nil nil org-html-table-row-close-tag)
(:html-xml-declaration nil nil org-html-xml-declaration)
(:infojs-opt "INFOJS_OPT" nil nil)
;; Redefine regular options.
@@ -314,13 +317,97 @@ for the JavaScript code in this tag.
border: 1px solid black;
}
pre.src:hover:before { display: inline;}
- pre.src-sh:before { content: 'sh'; }
- pre.src-bash:before { content: 'sh'; }
+ /* Languages per Org manual */
+ pre.src-asymptote:before { content: 'Asymptote'; }
+ pre.src-awk:before { content: 'Awk'; }
+ pre.src-C:before { content: 'C'; }
+ /* pre.src-C++ doesn't work in CSS */
+ pre.src-clojure:before { content: 'Clojure'; }
+ pre.src-css:before { content: 'CSS'; }
+ pre.src-D:before { content: 'D'; }
+ pre.src-ditaa:before { content: 'ditaa'; }
+ pre.src-dot:before { content: 'Graphviz'; }
+ pre.src-calc:before { content: 'Emacs Calc'; }
pre.src-emacs-lisp:before { content: 'Emacs Lisp'; }
- pre.src-R:before { content: 'R'; }
- pre.src-perl:before { content: 'Perl'; }
- pre.src-java:before { content: 'Java'; }
- pre.src-sql:before { content: 'SQL'; }
+ pre.src-fortran:before { content: 'Fortran'; }
+ pre.src-gnuplot:before { content: 'gnuplot'; }
+ pre.src-haskell:before { content: 'Haskell'; }
+ pre.src-java:before { content: 'Java'; }
+ pre.src-js:before { content: 'Javascript'; }
+ pre.src-latex:before { content: 'LaTeX'; }
+ pre.src-ledger:before { content: 'Ledger'; }
+ pre.src-lisp:before { content: 'Lisp'; }
+ pre.src-lilypond:before { content: 'Lilypond'; }
+ pre.src-lua:before { content: 'Lua'; }
+ pre.src-matlab:before { content: 'MATLAB'; }
+ pre.src-mscgen:before { content: 'Mscgen'; }
+ pre.src-ocaml:before { content: 'Objective Caml'; }
+ pre.src-octave:before { content: 'Octave'; }
+ pre.src-org:before { content: 'Org mode'; }
+ pre.src-oz:before { content: 'OZ'; }
+ pre.src-plantuml:before { content: 'Plantuml'; }
+ pre.src-processing:before { content: 'Processing.js'; }
+ pre.src-python:before { content: 'Python'; }
+ pre.src-R:before { content: 'R'; }
+ pre.src-ruby:before { content: 'Ruby'; }
+ pre.src-sass:before { content: 'Sass'; }
+ pre.src-scheme:before { content: 'Scheme'; }
+ pre.src-screen:before { content: 'Gnu Screen'; }
+ pre.src-sed:before { content: 'Sed'; }
+ pre.src-sh:before { content: 'shell'; }
+ pre.src-sql:before { content: 'SQL'; }
+ pre.src-sqlite:before { content: 'SQLite'; }
+ /* additional languages in org.el's org-babel-load-languages alist */
+ pre.src-forth:before { content: 'Forth'; }
+ pre.src-io:before { content: 'IO'; }
+ pre.src-J:before { content: 'J'; }
+ pre.src-makefile:before { content: 'Makefile'; }
+ pre.src-maxima:before { content: 'Maxima'; }
+ pre.src-perl:before { content: 'Perl'; }
+ pre.src-picolisp:before { content: 'Pico Lisp'; }
+ pre.src-scala:before { content: 'Scala'; }
+ pre.src-shell:before { content: 'Shell Script'; }
+ pre.src-ebnf2ps:before { content: 'ebfn2ps'; }
+ /* additional language identifiers per \"defun org-babel-execute\"
+ in ob-*.el */
+ pre.src-cpp:before { content: 'C++'; }
+ pre.src-abc:before { content: 'ABC'; }
+ pre.src-coq:before { content: 'Coq'; }
+ pre.src-groovy:before { content: 'Groovy'; }
+ /* additional language identifiers from org-babel-shell-names in
+ ob-shell.el: ob-shell is the only babel language using a lambda to put
+ the execution function name together. */
+ pre.src-bash:before { content: 'bash'; }
+ pre.src-csh:before { content: 'csh'; }
+ pre.src-ash:before { content: 'ash'; }
+ pre.src-dash:before { content: 'dash'; }
+ pre.src-ksh:before { content: 'ksh'; }
+ pre.src-mksh:before { content: 'mksh'; }
+ pre.src-posh:before { content: 'posh'; }
+ /* Additional Emacs modes also supported by the LaTeX listings package */
+ pre.src-ada:before { content: 'Ada'; }
+ pre.src-asm:before { content: 'Assembler'; }
+ pre.src-caml:before { content: 'Caml'; }
+ pre.src-delphi:before { content: 'Delphi'; }
+ pre.src-html:before { content: 'HTML'; }
+ pre.src-idl:before { content: 'IDL'; }
+ pre.src-mercury:before { content: 'Mercury'; }
+ pre.src-metapost:before { content: 'MetaPost'; }
+ pre.src-modula-2:before { content: 'Modula-2'; }
+ pre.src-pascal:before { content: 'Pascal'; }
+ pre.src-ps:before { content: 'PostScript'; }
+ pre.src-prolog:before { content: 'Prolog'; }
+ pre.src-simula:before { content: 'Simula'; }
+ pre.src-tcl:before { content: 'tcl'; }
+ pre.src-tex:before { content: 'TeX'; }
+ pre.src-plain-tex:before { content: 'Plain TeX'; }
+ pre.src-verilog:before { content: 'Verilog'; }
+ pre.src-vhdl:before { content: 'VHDL'; }
+ pre.src-xml:before { content: 'XML'; }
+ pre.src-nxml:before { content: 'XML'; }
+ /* add a generic configuration mode; LaTeX export needs an additional
+ (add-to-list 'org-latex-listings-langs '(conf \" \")) in .emacs */
+ pre.src-conf:before { content: 'Configuration File'; }
table { border-collapse:collapse; }
caption.t-above { caption-side: top; }
@@ -353,6 +440,7 @@ for the JavaScript code in this tag.
{ font-size: 10px; font-weight: bold; white-space: nowrap; }
.org-info-js_search-highlight
{ background-color: #ffff00; color: #000000; font-weight: bold; }
+ .org-svg { width: 90%; }
/*]]>*/-->
</style>"
"The default style specification for exported HTML files.
@@ -492,7 +580,7 @@ Option settings will replace the %MANAGER-OPTIONS cookie."
:package-version '(Org . "8.0")
:type 'string)
-(defun org-html-infojs-install-script (exp-plist backend)
+(defun org-html-infojs-install-script (exp-plist _backend)
"Install script in export options when appropriate.
EXP-PLIST is a plist containing export options. BACKEND is the
export back-end currently used."
@@ -529,21 +617,21 @@ export back-end currently used."
options))
(match-string 1 options)
default)))
- (case opt
- (path (setq template
- (replace-regexp-in-string
- "%SCRIPT_PATH" val template t t)))
- (sdepth (when (integerp (read val))
- (setq sdepth (min (read val) sdepth))))
- (tdepth (when (integerp (read val))
- (setq tdepth (min (read val) tdepth))))
- (otherwise (setq val
- (cond
- ((or (eq val t) (equal val "t")) "1")
- ((or (eq val nil) (equal val "nil")) "0")
- ((stringp val) val)
- (t (format "%s" val))))
- (push (cons var val) style)))))
+ (pcase opt
+ (`path (setq template
+ (replace-regexp-in-string
+ "%SCRIPT_PATH" val template t t)))
+ (`sdepth (when (integerp (read val))
+ (setq sdepth (min (read val) sdepth))))
+ (`tdepth (when (integerp (read val))
+ (setq tdepth (min (read val) tdepth))))
+ (_ (setq val
+ (cond
+ ((or (eq val t) (equal val "t")) "1")
+ ((or (eq val nil) (equal val "nil")) "0")
+ ((stringp val) val)
+ (t (format "%s" val))))
+ (push (cons var val) style)))))
;; Now we set the depth of the *generated* TOC to SDEPTH,
;; because the toc will actually determine the splitting. How
;; much of the toc will actually be displayed is governed by the
@@ -609,7 +697,7 @@ Warning: non-nil may break indentation of source code blocks."
;;;; Drawers
-(defcustom org-html-format-drawer-function (lambda (name contents) contents)
+(defcustom org-html-format-drawer-function (lambda (_name contents) contents)
"Function called to format a drawer in HTML code.
The function must accept two parameters:
@@ -680,7 +768,7 @@ INFO the export options (plist).
The function result will be used in the section format string."
:group 'org-export-html
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'function)
@@ -712,7 +800,7 @@ The function must accept seven parameters:
The function should return the string to be exported."
:group 'org-export-html
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'function)
@@ -727,24 +815,20 @@ fragments.
This option can also be set with the +OPTIONS line,
e.g. \"tex:mathjax\". Allowed values are:
-nil Ignore math snippets.
-`verbatim' Keep everything in verbatim
-`dvipng' Process the LaTeX fragments to images. This will also
- include processing of non-math environments.
-`imagemagick' Convert the LaTeX fragments to pdf files and use
- imagemagick to convert pdf files to png files.
-`mathjax' Do MathJax preprocessing and arrange for MathJax.js to
- be loaded.
-t Synonym for `mathjax'."
+ nil Ignore math snippets.
+ `verbatim' Keep everything in verbatim
+ `mathjax', t Do MathJax preprocessing and arrange for MathJax.js to
+ be loaded.
+ SYMBOL Any symbol defined in `org-preview-latex-process-alist',
+ e.g., `dvipng'."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(const :tag "Do not process math in any way" nil)
- (const :tag "Use dvipng to make images" dvipng)
- (const :tag "Use imagemagick to make images" imagemagick)
+ (const :tag "Leave math verbatim" verbatim)
(const :tag "Use MathJax to display math" mathjax)
- (const :tag "Leave math verbatim" verbatim)))
+ (symbol :tag "Convert to image to display math" :value dvipng)))
;;;; Links :: Generic
@@ -752,11 +836,11 @@ t Synonym for `mathjax'."
"Non-nil means make file links to `file.org' point to `file.html'.
When `org-mode' is exporting an `org-mode' file to HTML, links to
non-html files are directly put into a href tag in HTML.
-However, links to other Org-mode files (recognized by the
-extension `.org') should become links to the corresponding html
+However, links to other Org files (recognized by the extension
+\".org\") should become links to the corresponding HTML
file, assuming that the linked `org-mode' file will also be
converted to HTML.
-When nil, the links still point to the plain `.org' file."
+When nil, the links still point to the plain \".org\" file."
:group 'org-export-html
:type 'boolean)
@@ -811,7 +895,7 @@ a style file to define the look of these classes.
To get a start for your css file, start Emacs session and make sure that
all the faces you are interested in are defined, for example by loading files
in all modes you want. Then, use the command
-\\[org-html-htmlize-generate-css] to extract class definitions."
+`\\[org-html-htmlize-generate-css]' to extract class definitions."
:group 'org-export-html
:type '(choice (const css) (const inline-css) (const nil)))
@@ -854,43 +938,50 @@ See also the variable `org-html-table-align-individual-fields'."
:group 'org-export-html
:type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
-(defcustom org-html-table-row-tags '("<tr>" . "</tr>")
- "The opening and ending tags for table rows.
+(defcustom org-html-table-row-open-tag "<tr>"
+ "The opening tag for table rows.
This is customizable so that alignment options can be specified.
-Instead of strings, these can be Lisp forms that will be
+Instead of strings, these can be a Lisp function that will be
evaluated for each row in order to construct the table row tags.
-During evaluation, these variables will be dynamically bound so that
-you can reuse them:
+The function will be called with these arguments:
- `row-number': row number (0 is the first row)
- `rowgroup-number': group number of current row
- `start-rowgroup-p': non-nil means the row starts a group
- `end-rowgroup-p': non-nil means the row ends a group
- `top-row-p': non-nil means this is the top row
- `bottom-row-p': non-nil means this is the bottom row
+ `number': row number (0 is the first row)
+ `group-number': group number of current row
+ `start-group?': non-nil means the row starts a group
+ `end-group?': non-nil means the row ends a group
+ `top?': non-nil means this is the top row
+ `bottom?': non-nil means this is the bottom row
For example:
-\(setq org-html-table-row-tags
- (cons \\='(cond (top-row-p \"<tr class=\\\"tr-top\\\">\")
- (bottom-row-p \"<tr class=\\\"tr-bottom\\\">\")
- (t (if (= (mod row-number 2) 1)
- \"<tr class=\\\"tr-odd\\\">\"
- \"<tr class=\\\"tr-even\\\">\")))
- \"</tr>\"))
+ (setq org-html-table-row-open-tag
+ (lambda (number group-number start-group? end-group-p top? bottom?)
+ (cond (top? \"<tr class=\\\"tr-top\\\">\")
+ (bottom? \"<tr class=\\\"tr-bottom\\\">\")
+ (t (if (= (mod number 2) 1)
+ \"<tr class=\\\"tr-odd\\\">\"
+ \"<tr class=\\\"tr-even\\\">\")))))
will use the \"tr-top\" and \"tr-bottom\" classes for the top row
and the bottom row, and otherwise alternate between \"tr-odd\" and
\"tr-even\" for odd and even rows."
:group 'org-export-html
- :type '(cons
- (choice :tag "Opening tag"
- (string :tag "Specify")
- (sexp))
- (choice :tag "Closing tag"
- (string :tag "Specify")
- (sexp))))
+ :type '(choice :tag "Opening tag"
+ (string :tag "Specify")
+ (function)))
+
+(defcustom org-html-table-row-close-tag "</tr>"
+ "The closing tag for table rows.
+This is customizable so that alignment options can be specified.
+Instead of strings, this can be a Lisp function that will be
+evaluated for each row in order to construct the table row tags.
+
+See documentation of `org-html-table-row-open-tag'."
+ :group 'org-export-html
+ :type '(choice :tag "Closing tag"
+ (string :tag "Specify")
+ (function)))
(defcustom org-html-table-align-individual-fields t
"Non-nil means attach style attributes for alignment to each table field.
@@ -1326,8 +1417,6 @@ ignored."
;;;; Template :: Scripts
-(define-obsolete-variable-alias
- 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4")
(defcustom org-html-head-include-scripts t
"Non-nil means include the JavaScript snippets in exported HTML files.
The actual script is defined in `org-html-scripts' and should
@@ -1339,8 +1428,6 @@ not be modified."
;;;; Template :: Styles
-(define-obsolete-variable-alias
- 'org-html-style-include-default 'org-html-head-include-default-style "24.4")
(defcustom org-html-head-include-default-style t
"Non-nil means include the default style in exported HTML files.
The actual style is defined in `org-html-style-default' and
@@ -1353,7 +1440,6 @@ style information."
;;;###autoload
(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
-(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
(defcustom org-html-head ""
"Org-wide head definitions for exported HTML files.
@@ -1425,7 +1511,7 @@ The viewport meta tag is inserted if this variable is non-nil.
See the following site for a reference:
https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag"
:group 'org-export-html
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(choice (const :tag "Disable" nil)
(list :tag "Enable"
@@ -1543,21 +1629,27 @@ a communication channel."
info)))
(defun org-html--svg-image (source attributes info)
- "Return \"object\" appropriate for embedding svg file SOURCE
-with assoicated ATTRIBUTES. INFO is a plist used as a
-communication channel.
+ "Return \"object\" embedding svg file SOURCE with given ATTRIBUTES.
+INFO is a plist used as a communication channel.
-The special attribute \"fallback\" can be used to specify a fallback
-image file to use if the object embedding is not supported."
+The special attribute \"fallback\" can be used to specify a
+fallback image file to use if the object embedding is not
+supported. CSS class \"org-svg\" is assigned as the class of the
+object unless a different class is specified with an attribute."
(let ((fallback (plist-get attributes :fallback))
(attrs (org-html--make-attribute-string
- (plist-put attributes :fallback nil))))
- (format "<object type=\"image/svg+xml\" data=\"%s\" %s>\n%s</object>"
- source attrs
- (if fallback
- (org-html-close-tag
- "img" (format "src=\"%s\" %s" fallback attrs) info)
- "Sorry, your browser does not support SVG."))))
+ (org-combine-plists
+ ;; Remove fallback attribute, which is not meant to
+ ;; appear directly in the attributes string, and
+ ;; provide a default class if none is set.
+ '(:class "org-svg") attributes '(:fallback nil)))))
+ (format "<object type=\"image/svg+xml\" data=\"%s\" %s>\n%s</object>"
+ source
+ attrs
+ (if fallback
+ (org-html-close-tag
+ "img" (format "src=\"%s\" %s" fallback attrs) info)
+ "Sorry, your browser does not support SVG."))))
(defun org-html--textarea-block (element)
"Transcode ELEMENT into a textarea block.
@@ -1569,7 +1661,7 @@ ELEMENT is either a src block or an example block."
(or (plist-get attr :height) (org-count-lines code))
code)))
-(defun org-html--has-caption-p (element &optional info)
+(defun org-html--has-caption-p (element &optional _info)
"Non-nil when ELEMENT has a caption affiliated keyword.
INFO is a plist used as a communication channel. This function
is meant to be used as a predicate for `org-export-get-ordinal' or
@@ -1616,7 +1708,7 @@ produce code that uses these same face definitions."
(when (and (symbolp f) (or (not i) (not (listp i))))
(insert (org-add-props (copy-sequence "1") nil 'face f))))
(htmlize-region (point-min) (point-max))))
- (org-pop-to-buffer-same-window "*html*")
+ (pop-to-buffer-same-window "*html*")
(goto-char (point-min))
(if (re-search-forward "<style" nil t)
(delete-region (point-min) (match-beginning 0)))
@@ -1628,26 +1720,23 @@ produce code that uses these same face definitions."
(defun org-html--make-string (n string)
"Build a string by concatenating N times STRING."
- (let (out) (dotimes (i n out) (setq out (concat string out)))))
+ (let (out) (dotimes (_ n out) (setq out (concat string out)))))
(defun org-html-fix-class-name (kwd) ; audit callers of this function
"Turn todo keyword KWD into a valid class name.
Replaces invalid characters with \"_\"."
- (save-match-data
- (while (string-match "[^a-zA-Z0-9_]" kwd)
- (setq kwd (replace-match "_" t t kwd))))
- kwd)
+ (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" kwd nil t))
(defun org-html-footnote-section (info)
"Format the footnote section.
INFO is a plist used as a communication channel."
(let* ((fn-alist (org-export-collect-footnote-definitions info))
(fn-alist
- (loop for (n type raw) in fn-alist collect
- (cons n (if (eq (org-element-type raw) 'org-data)
- (org-trim (org-export-data raw info))
- (format "<div class=\"footpara\">%s</div>"
- (org-trim (org-export-data raw info))))))))
+ (cl-loop for (n _type raw) in fn-alist collect
+ (cons n (if (eq (org-element-type raw) 'org-data)
+ (org-trim (org-export-data raw info))
+ (format "<div class=\"footpara\">%s</div>"
+ (org-trim (org-export-data raw info))))))))
(when fn-alist
(format
(plist-get info :html-footnotes-section)
@@ -1705,45 +1794,45 @@ INFO is a plist used as a communication channel."
" -->\n")))
(format
(if (org-html-html5-p info)
- (org-html-close-tag "meta" " charset=\"%s\"" info)
+ (org-html-close-tag "meta" "charset=\"%s\"" info)
(org-html-close-tag
- "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\""
+ "meta" "http-equiv=\"Content-Type\" content=\"text/html;charset=%s\""
info))
charset) "\n"
(let ((viewport-options
- (org-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell)))
+ (cl-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell)))
(plist-get info :html-viewport))))
(and viewport-options
(concat
(org-html-close-tag
"meta"
- (format " name=\"viewport\" content=\"%s\""
+ (format "name=\"viewport\" content=\"%s\""
(mapconcat
(lambda (elm) (format "%s=%s" (car elm) (cadr elm)))
viewport-options ", "))
info)
"\n")))
(format "<title>%s</title>\n" title)
- (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info)
+ (org-html-close-tag "meta" "name=\"generator\" content=\"Org mode\"" info)
"\n"
(and (org-string-nw-p author)
(concat
(org-html-close-tag "meta"
- (format " name=\"author\" content=\"%s\""
+ (format "name=\"author\" content=\"%s\""
(funcall protect-string author))
info)
"\n"))
(and (org-string-nw-p description)
(concat
(org-html-close-tag "meta"
- (format " name=\"description\" content=\"%s\"\n"
+ (format "name=\"description\" content=\"%s\"\n"
(funcall protect-string description))
info)
"\n"))
(and (org-string-nw-p keywords)
(concat
(org-html-close-tag "meta"
- (format " name=\"keywords\" content=\"%s\""
+ (format "name=\"keywords\" content=\"%s\""
(funcall protect-string keywords))
info)
"\n")))))
@@ -1760,7 +1849,7 @@ INFO is a plist used as a communication channel."
(when (and (plist-get info :html-htmlized-css-url)
(eq org-html-htmlize-output-type 'css))
(org-html-close-tag "link"
- (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\""
+ (format "rel=\"stylesheet\" href=\"%s\" type=\"text/css\""
(plist-get info :html-htmlized-css-url))
info))
(when (plist-get info :html-head-include-scripts) org-html-scripts))))
@@ -1773,20 +1862,17 @@ INFO is a plist used as a communication channel."
'(latex-fragment latex-environment) 'identity info t))
(let ((template (plist-get info :html-mathjax-template))
(options (plist-get info :html-mathjax-options))
- (in-buffer (or (plist-get info :html-mathjax) ""))
- name val x)
- (mapc
- (lambda (e)
- (setq name (car e) val (nth 1 e))
- (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
- (setq val (car (read-from-string
- (substring in-buffer (match-end 0))))))
- (if (not (stringp val)) (setq val (format "%s" val)))
- (while (string-match (concat "%" (upcase (symbol-name name))) template)
- (setq template (replace-match val t t template))))
- options)
- ;; Return the modified template.
- (org-element-normalize-string template))))
+ (in-buffer (or (plist-get info :html-mathjax) "")))
+ (dolist (e options (org-element-normalize-string template))
+ (let ((name (car e))
+ (val (nth 1 e)))
+ (when (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
+ (setq val
+ (car (read-from-string (substring in-buffer (match-end 0))))))
+ (unless (stringp val) (setq val (format "%s" val)))
+ (while (string-match (concat "%" (upcase (symbol-name name)))
+ template)
+ (setq template (replace-match val t t template))))))))
(defun org-html-format-spec (info)
"Return format specification for elements that can be
@@ -1825,7 +1911,6 @@ communication channel."
(author (cdr (assq ?a spec)))
(email (cdr (assq ?e spec)))
(creator (cdr (assq ?c spec)))
- (timestamp (cdr (assq ?T spec)))
(validation-link (cdr (assq ?v spec))))
(concat
(when (and (plist-get info :with-date)
@@ -1854,15 +1939,17 @@ communication channel."
(format "<p class=\"validation\">%s</p>\n"
validation-link))))
(t (format-spec
- (or (cadr (assoc
+ (or (cadr (assoc-string
(plist-get info :language)
(eval (intern
- (format "org-html-%s-format" type)))))
+ (format "org-html-%s-format" type)))
+ t))
(cadr
- (assoc
+ (assoc-string
"en"
(eval
- (intern (format "org-html-%s-format" type))))))
+ (intern (format "org-html-%s-format" type)))
+ t)))
spec))))))
(let ((div (assq type (plist-get info :html-divs))))
(when (org-string-nw-p section-contents)
@@ -1909,10 +1996,12 @@ holding export options."
(org-html-doctype info)
"\n"
(concat "<html"
- (when (org-html-xhtml-p info)
- (format
- " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\""
- (plist-get info :language) (plist-get info :language)))
+ (cond ((org-html-xhtml-p info)
+ (format
+ " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\""
+ (plist-get info :language) (plist-get info :language)))
+ ((org-html-html5-p info)
+ (format " lang=\"%s\"" (plist-get info :language))))
">\n")
"<head>\n"
(org-html--build-meta-info info)
@@ -1984,7 +2073,7 @@ INFO is a plist used as a communication channel."
;;;; Priority
-(defun org-html--priority (priority info)
+(defun org-html--priority (priority _info)
"Format a priority into HTML.
PRIORITY is the character code of the priority or nil. INFO is
a plist containing export options."
@@ -2115,9 +2204,7 @@ a plist used as a communication channel."
;; Does the src block contain labels?
(retain-labels (org-element-property :retain-labels element))
;; Does it have line numbers?
- (num-start (case (org-element-property :number-lines element)
- (continued (org-export-get-loc element info))
- (new 0))))
+ (num-start (org-export-get-loc element info)))
(org-html-do-format-code code lang refs retain-labels num-start)))
@@ -2164,8 +2251,7 @@ and value is its relative level, as an integer."
(level (cdr entry)))
(concat
(let* ((cnt (- level prev-level))
- (times (if (> cnt 0) (1- cnt) (- cnt)))
- rtn)
+ (times (if (> cnt 0) (1- cnt) (- cnt))))
(setq prev-level level)
(concat
(org-html--make-string
@@ -2241,10 +2327,12 @@ of listings as a string, or nil if it is empty."
(concat
"<li>"
(if (not label)
- (concat (format initial-fmt (incf count)) " " title)
+ (concat (format initial-fmt (cl-incf count))
+ " "
+ title)
(format "<a href=\"#%s\">%s %s</a>"
label
- (format initial-fmt (incf count))
+ (format initial-fmt (cl-incf count))
title))
"</li>")))
lol-entries "\n"))
@@ -2278,10 +2366,12 @@ of tables as a string, or nil if it is empty."
(concat
"<li>"
(if (not label)
- (concat (format initial-fmt (incf count)) " " title)
+ (concat (format initial-fmt (cl-incf count))
+ " "
+ title)
(format "<a href=\"#%s\">%s %s</a>"
label
- (format initial-fmt (incf count))
+ (format initial-fmt (cl-incf count))
title))
"</li>")))
lol-entries "\n"))
@@ -2292,7 +2382,7 @@ of tables as a string, or nil if it is empty."
;;;; Bold
-(defun org-html-bold (bold contents info)
+(defun org-html-bold (_bold contents info)
"Transcode BOLD from Org to HTML.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -2301,7 +2391,7 @@ contextual information."
;;;; Center Block
-(defun org-html-center-block (center-block contents info)
+(defun org-html-center-block (_center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -2309,7 +2399,7 @@ holding contextual information."
;;;; Clock
-(defun org-html-clock (clock contents info)
+(defun org-html-clock (clock _contents _info)
"Transcode a CLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -2325,7 +2415,7 @@ channel."
;;;; Code
-(defun org-html-code (code contents info)
+(defun org-html-code (code _contents info)
"Transcode CODE from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -2344,7 +2434,7 @@ holding contextual information."
;;;; Dynamic Block
-(defun org-html-dynamic-block (dynamic-block contents info)
+(defun org-html-dynamic-block (_dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
@@ -2352,7 +2442,7 @@ holding contextual information. See `org-export-data'."
;;;; Entity
-(defun org-html-entity (entity contents info)
+(defun org-html-entity (entity _contents _info)
"Transcode an ENTITY object from Org to HTML.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -2360,18 +2450,25 @@ contextual information."
;;;; Example Block
-(defun org-html-example-block (example-block contents info)
+(defun org-html-example-block (example-block _contents info)
"Transcode a EXAMPLE-BLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (if (org-export-read-attribute :attr_html example-block :textarea)
- (org-html--textarea-block example-block)
- (format "<pre class=\"example\">\n%s</pre>"
- (org-html-format-code example-block info))))
+ (let ((attributes (org-export-read-attribute :attr_html example-block)))
+ (if (plist-get attributes :textarea)
+ (org-html--textarea-block example-block)
+ (format "<pre class=\"example\"%s>\n%s</pre>"
+ (let* ((name (org-element-property :name example-block))
+ (a (org-html--make-attribute-string
+ (if (or (not name) (plist-member attributes :id))
+ attributes
+ (plist-put attributes :id name)))))
+ (if (org-string-nw-p a) (concat " " a) ""))
+ (org-html-format-code example-block info)))))
;;;; Export Snippet
-(defun org-html-export-snippet (export-snippet contents info)
+(defun org-html-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -2380,7 +2477,7 @@ information."
;;;; Export Block
-(defun org-html-export-block (export-block contents info)
+(defun org-html-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "HTML")
@@ -2388,7 +2485,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-html-fixed-width (fixed-width contents info)
+(defun org-html-fixed-width (fixed-width _contents _info)
"Transcode a FIXED-WIDTH element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(format "<pre class=\"example\">\n%s</pre>"
@@ -2398,7 +2495,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Reference
-(defun org-html-footnote-reference (footnote-reference contents info)
+(defun org-html-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(concat
@@ -2427,8 +2524,6 @@ holding contextual information."
(unless (org-element-property :footnote-section-p headline)
(let* ((numberedp (org-export-numbered-headline-p headline info))
(numbers (org-export-get-headline-number headline info))
- (section-number (and numbers
- (mapconcat #'number-to-string numbers "-")))
(level (+ (org-export-get-relative-level headline info)
(1- (plist-get info :html-toplevel-hlevel))))
(todo (and (plist-get info :with-todo-keywords)
@@ -2500,7 +2595,7 @@ holding contextual information."
(org-html--container headline info)))))))
(defun org-html-format-headline-default-function
- (todo todo-type priority text tags info)
+ (todo _todo-type priority text tags info)
"Default format function for a headline.
See `org-html-format-headline-function' for details."
(let ((todo (org-html--todo todo info))
@@ -2519,19 +2614,19 @@ See `org-html-format-headline-function' for details."
;;;; Horizontal Rule
-(defun org-html-horizontal-rule (horizontal-rule contents info)
+(defun org-html-horizontal-rule (_horizontal-rule _contents info)
"Transcode an HORIZONTAL-RULE object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-html-close-tag "hr" nil info))
;;;; Inline Src Block
-(defun org-html-inline-src-block (inline-src-block contents info)
+(defun org-html-inline-src-block (inline-src-block _contents info)
"Transcode an INLINE-SRC-BLOCK element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let ((lang (org-element-property :language inline-src-block))
- (code (org-html-format-code inline-src-block info))
+ (code (org-element-property :value inline-src-block))
(label
(let ((lbl (and (org-element-property :name inline-src-block)
(org-export-get-reference inline-src-block info))))
@@ -2568,7 +2663,7 @@ See `org-html-format-inlinetask-function' for details."
;;;; Italic
-(defun org-html-italic (italic contents info)
+(defun org-html-italic (_italic contents info)
"Transcode ITALIC from Org to HTML.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -2587,8 +2682,8 @@ INFO is a plist holding contextual information. See
org-html-checkbox-types)))))
(defun org-html-format-list-item (contents type checkbox info
- &optional term-counter-id
- headline)
+ &optional term-counter-id
+ headline)
"Format a list item into HTML."
(let ((class (if checkbox
(format " class=\"%s\""
@@ -2597,20 +2692,20 @@ INFO is a plist holding contextual information. See
(and checkbox " ")))
(br (org-html-close-tag "br" nil info)))
(concat
- (case type
- (ordered
+ (pcase type
+ (`ordered
(let* ((counter term-counter-id)
(extra (if counter (format " value=\"%s\"" counter) "")))
(concat
(format "<li%s%s>" class extra)
(when headline (concat headline br)))))
- (unordered
+ (`unordered
(let* ((id term-counter-id)
(extra (if id (format " id=\"%s\"" id) "")))
(concat
(format "<li%s%s>" class extra)
(when headline (concat headline br)))))
- (descriptive
+ (`descriptive
(let* ((term term-counter-id))
(setq term (or term "(no term)"))
;; Check-boxes in descriptive lists are associated to tag.
@@ -2619,10 +2714,10 @@ INFO is a plist holding contextual information. See
"<dd>"))))
(unless (eq type 'descriptive) checkbox)
(and contents (org-trim contents))
- (case type
- (ordered "</li>")
- (unordered "</li>")
- (descriptive "</dd>")))))
+ (pcase type
+ (`ordered "</li>")
+ (`unordered "</li>")
+ (`descriptive "</dd>")))))
(defun org-html-item (item contents info)
"Transcode an ITEM element from Org to HTML.
@@ -2639,7 +2734,7 @@ contextual information."
;;;; Keyword
-(defun org-html-keyword (keyword contents info)
+(defun org-html-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((key (org-element-property :key keyword))
@@ -2652,7 +2747,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string-match "\\<headlines\\>" value)
(let ((depth (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value))))
- (localp (org-string-match-p "\\<local\\>" value)))
+ (localp (string-match-p "\\<local\\>" value)))
(org-html-toc depth info (and localp keyword))))
((string= "listings" value) (org-html-list-of-listings info))
((string= "tables" value) (org-html-list-of-tables info))))))))
@@ -2661,10 +2756,11 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-html-format-latex (latex-frag processing-type info)
"Format a LaTeX fragment LATEX-FRAG into HTML.
-PROCESSING-TYPE designates the tool used for conversion. It is
-a symbol among `mathjax', `dvipng', `imagemagick', `verbatim' nil
-and t. See `org-html-with-latex' for more information. INFO is
-a plist containing export properties."
+PROCESSING-TYPE designates the tool used for conversion. It can
+be `mathjax', `verbatim', nil, t or symbols in
+`org-preview-latex-process-alist', e.g., `dvipng', `dvisvgm' or
+`imagemagick'. See `org-html-with-latex' for more information.
+INFO is a plist containing export properties."
(let ((cache-relpath "") (cache-dir ""))
(unless (eq processing-type 'mathjax)
(let ((bfn (or (buffer-file-name)
@@ -2679,7 +2775,7 @@ a plist containing export properties."
"\n")
"\n")))))
(setq cache-relpath
- (concat "ltxpng/"
+ (concat (file-name-as-directory org-preview-latex-image-directory)
(file-name-sans-extension
(file-name-nondirectory bfn)))
cache-dir (file-name-directory bfn))
@@ -2689,51 +2785,51 @@ a plist containing export properties."
(setq latex-frag (concat latex-header latex-frag))))
(with-temp-buffer
(insert latex-frag)
- (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..."
- nil processing-type)
+ (org-format-latex cache-relpath nil nil cache-dir nil
+ "Creating LaTeX Image..." nil processing-type)
(buffer-string))))
-(defun org-html-latex-environment (latex-environment contents info)
+(defun org-html-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((processing-type (plist-get info :with-latex))
(latex-frag (org-remove-indentation
(org-element-property :value latex-environment)))
(attributes (org-export-read-attribute :attr_html latex-environment)))
- (case processing-type
- ((t mathjax)
- (org-html-format-latex latex-frag 'mathjax info))
- ((dvipng imagemagick)
- (let ((formula-link
- (org-html-format-latex latex-frag processing-type info)))
- (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
- ;; Do not provide a caption or a name to be consistent with
- ;; `mathjax' handling.
- (org-html--wrap-image
- (org-html--format-image
- (match-string 1 formula-link) attributes info) info))))
- (t latex-frag))))
+ (cond
+ ((memq processing-type '(t mathjax))
+ (org-html-format-latex latex-frag 'mathjax info))
+ ((assq processing-type org-preview-latex-process-alist)
+ (let ((formula-link
+ (org-html-format-latex latex-frag processing-type info)))
+ (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+ ;; Do not provide a caption or a name to be consistent with
+ ;; `mathjax' handling.
+ (org-html--wrap-image
+ (org-html--format-image
+ (match-string 1 formula-link) attributes info) info))))
+ (t latex-frag))))
;;;; Latex Fragment
-(defun org-html-latex-fragment (latex-fragment contents info)
+(defun org-html-latex-fragment (latex-fragment _contents info)
"Transcode a LATEX-FRAGMENT object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((latex-frag (org-element-property :value latex-fragment))
(processing-type (plist-get info :with-latex)))
- (case processing-type
- ((t mathjax)
- (org-html-format-latex latex-frag 'mathjax info))
- ((dvipng imagemagick)
- (let ((formula-link
- (org-html-format-latex latex-frag processing-type info)))
- (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
- (org-html--format-image (match-string 1 formula-link) nil info))))
- (t latex-frag))))
+ (cond
+ ((memq processing-type '(t mathjax))
+ (org-html-format-latex latex-frag 'mathjax info))
+ ((assq processing-type org-preview-latex-process-alist)
+ (let ((formula-link
+ (org-html-format-latex latex-frag processing-type info)))
+ (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+ (org-html--format-image (match-string 1 formula-link) nil info))))
+ (t latex-frag))))
;;;; Line Break
-(defun org-html-line-break (line-break contents info)
+(defun org-html-line-break (_line-break _contents info)
"Transcode a LINE-BREAK object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(concat (org-html-close-tag "br" nil info) "\n"))
@@ -2754,13 +2850,13 @@ if its description is a single link targeting an image file."
(org-element-map (org-element-contents link)
(cons 'plain-text org-element-all-objects)
(lambda (obj)
- (case (org-element-type obj)
- (plain-text (org-string-nw-p obj))
- (link (if (= link-count 1) t
- (incf link-count)
- (not (org-export-inline-image-p
- obj (plist-get info :html-inline-image-rules)))))
- (otherwise t)))
+ (pcase (org-element-type obj)
+ (`plain-text (org-string-nw-p obj))
+ (`link (if (= link-count 1) t
+ (cl-incf link-count)
+ (not (org-export-inline-image-p
+ obj (plist-get info :html-inline-image-rules)))))
+ (_ t)))
info t)))))
(defvar org-html-standalone-image-predicate)
@@ -2782,9 +2878,9 @@ further. For example, to check for only captioned standalone
images, set it to:
(lambda (paragraph) (org-element-property :caption paragraph))"
- (let ((paragraph (case (org-element-type element)
- (paragraph element)
- (link (org-export-get-parent element)))))
+ (let ((paragraph (pcase (org-element-type element)
+ (`paragraph element)
+ (`link (org-export-get-parent element)))))
(and (eq (org-element-type paragraph) 'paragraph)
(or (not (fboundp 'org-html-standalone-image-predicate))
(funcall org-html-standalone-image-predicate paragraph))
@@ -2792,13 +2888,13 @@ images, set it to:
(let ((link-count 0))
(org-element-map (org-element-contents paragraph)
(cons 'plain-text org-element-all-objects)
- #'(lambda (obj)
- (when (case (org-element-type obj)
- (plain-text (org-string-nw-p obj))
- (link (or (> (incf link-count) 1)
- (not (org-html-inline-image-p obj info))))
- (otherwise t))
- (throw 'exit nil)))
+ (lambda (obj)
+ (when (pcase (org-element-type obj)
+ (`plain-text (org-string-nw-p obj))
+ (`link (or (> (cl-incf link-count) 1)
+ (not (org-html-inline-image-p obj info))))
+ (_ t))
+ (throw 'exit nil)))
info nil 'link)
(= link-count 1))))))
@@ -2827,9 +2923,8 @@ INFO is a plist holding contextual information. See
(desc (org-string-nw-p desc))
(path
(cond
- ((member type '("http" "https" "ftp" "mailto"))
- (org-link-escape-browser
- (org-link-unescape (concat type ":" raw-path))))
+ ((member type '("http" "https" "ftp" "mailto" "news"))
+ (url-encode-url (org-link-unescape (concat type ":" raw-path))))
((string= type "file")
;; Treat links to ".org" files as ".html", if needed.
(setq raw-path
@@ -2842,15 +2937,19 @@ INFO is a plist holding contextual information. See
((and home use-abs-url)
(setq raw-path (concat (file-name-as-directory home) raw-path))))
;; Add search option, if any. A search option can be
- ;; relative to a custom-id, a headline title a name,
- ;; a target or a radio-target.
+ ;; relative to a custom-id, a headline title, a name or
+ ;; a target.
(let ((option (org-element-property :search-option link)))
- (if (not option) raw-path
- (concat raw-path
- "#"
- (org-publish-resolve-external-link
- option
- (org-element-property :path link))))))
+ (cond ((not option) raw-path)
+ ;; Since HTML back-end use custom-id value as-is,
+ ;; resolving is them is trivial.
+ ((eq (string-to-char option) ?#) (concat raw-path option))
+ (t
+ (concat raw-path
+ "#"
+ (org-publish-resolve-external-link
+ option
+ (org-element-property :path link)))))))
(t raw-path)))
;; Extract attributes from parent's paragraph. HACK: Only do
;; this for the first link in parent (inner image link for
@@ -2891,9 +2990,9 @@ INFO is a plist holding contextual information. See
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
+ (pcase (org-element-type destination)
;; ID link points to an external file.
- (plain-text
+ (`plain-text
(let ((fragment (concat "ID-" path))
;; Treat links to ".org" files as ".html", if needed.
(path (funcall link-org-files-as-html-maybe
@@ -2901,13 +3000,13 @@ INFO is a plist holding contextual information. See
(format "<a href=\"%s#%s\"%s>%s</a>"
path fragment attributes (or desc destination))))
;; Fuzzy link points nowhere.
- ((nil)
+ (`nil
(format "<i>%s</i>"
(or desc
(org-export-data
(org-element-property :raw-link link) info))))
;; Link points to a headline.
- (headline
+ (`headline
(let ((href (or (org-element-property :CUSTOM_ID destination)
(org-export-get-reference destination info)))
;; What description to use?
@@ -2927,7 +3026,7 @@ INFO is a plist holding contextual information. See
(org-element-property :title destination) info)))))
(format "<a href=\"#%s\"%s>%s</a>" href attributes desc)))
;; Fuzzy link points to a target or an element.
- (t
+ (_
(let* ((ref (org-export-get-reference destination info))
(org-html-standalone-image-predicate
#'org-html--has-caption-p)
@@ -2964,13 +3063,16 @@ INFO is a plist holding contextual information. See
desc))
;; External link without a description part.
(path (let ((path (org-html-encode-plain-text path)))
- (format "<a href=\"%s\"%s>%s</a>" path attributes path)))
+ (format "<a href=\"%s\"%s>%s</a>"
+ path
+ attributes
+ (org-link-unescape path))))
;; No path, only description. Try to do something useful.
(t (format "<i>%s</i>" desc)))))
;;;; Node Property
-(defun org-html-node-property (node-property contents info)
+(defun org-html-node-property (node-property _contents _info)
"Transcode a NODE-PROPERTY element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -3007,16 +3109,16 @@ the plist used as a communication channel."
(let ((raw (org-export-data
(org-export-get-caption paragraph) info))
(org-html-standalone-image-predicate
- 'org-html--has-caption-p))
+ #'org-html--has-caption-p))
(if (not (org-string-nw-p raw)) raw
- (concat
- "<span class=\"figure-number\">"
- (format (org-html--translate "Figure %d:" info)
- (org-export-get-ordinal
- (org-element-map paragraph 'link
- 'identity info t)
- info nil 'org-html-standalone-image-p))
- "</span> " raw))))
+ (concat "<span class=\"figure-number\">"
+ (format (org-html--translate "Figure %d:" info)
+ (org-export-get-ordinal
+ (org-element-map paragraph 'link
+ #'identity info t)
+ info nil #'org-html-standalone-image-p))
+ " </span>"
+ raw))))
(label (and (org-element-property :name paragraph)
(org-export-get-reference paragraph info))))
(org-html--wrap-image contents info caption label)))
@@ -3034,26 +3136,25 @@ the plist used as a communication channel."
"Insert the beginning of the HTML list depending on TYPE.
When ARG1 is a string, use it as the start parameter for ordered
lists."
- (case type
- (ordered
+ (pcase type
+ (`ordered
(format "<ol class=\"org-ol\"%s>"
(if arg1 (format " start=\"%d\"" arg1) "")))
- (unordered "<ul class=\"org-ul\">")
- (descriptive "<dl class=\"org-dl\">")))
+ (`unordered "<ul class=\"org-ul\">")
+ (`descriptive "<dl class=\"org-dl\">")))
(defun org-html-end-plain-list (type)
"Insert the end of the HTML list depending on TYPE."
- (case type
- (ordered "</ol>")
- (unordered "</ul>")
- (descriptive "</dl>")))
+ (pcase type
+ (`ordered "</ol>")
+ (`unordered "</ul>")
+ (`descriptive "</dl>")))
-(defun org-html-plain-list (plain-list contents info)
+(defun org-html-plain-list (plain-list contents _info)
"Transcode a PLAIN-LIST element from Org to HTML.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
- (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item
- (type (org-element-property :type plain-list)))
+ (let ((type (org-element-property :type plain-list)))
(format "%s\n%s%s"
(org-html-begin-plain-list type)
contents (org-html-end-plain-list type))))
@@ -3062,13 +3163,10 @@ contextual information."
(defun org-html-convert-special-strings (string)
"Convert special characters in STRING to HTML."
- (let ((all org-html-special-string-regexps)
- e a re rpl start)
- (while (setq a (pop all))
- (setq re (car a) rpl (cdr a) start 0)
- (while (string-match re string start)
- (setq string (replace-match rpl t nil string))))
- string))
+ (dolist (a org-html-special-string-regexps string)
+ (let ((re (car a))
+ (rpl (cdr a)))
+ (setq string (replace-regexp-in-string re rpl string t)))))
(defun org-html-encode-plain-text (text)
"Convert plain text characters from TEXT to HTML equivalent.
@@ -3102,34 +3200,31 @@ contextual information."
;; Planning
-(defun org-html-planning (planning contents info)
+(defun org-html-planning (planning _contents info)
"Transcode a PLANNING element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (let ((span-fmt "<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>"))
- (format
- "<p><span class=\"timestamp-wrapper\">%s</span></p>"
- (mapconcat
- 'identity
- (delq nil
- (list
- (let ((closed (org-element-property :closed planning)))
- (when closed
- (format span-fmt org-closed-string
- (org-timestamp-translate closed))))
- (let ((deadline (org-element-property :deadline planning)))
- (when deadline
- (format span-fmt org-deadline-string
- (org-timestamp-translate deadline))))
- (let ((scheduled (org-element-property :scheduled planning)))
- (when scheduled
- (format span-fmt org-scheduled-string
- (org-timestamp-translate scheduled))))))
- " "))))
+ (format
+ "<p><span class=\"timestamp-wrapper\">%s</span></p>"
+ (org-trim
+ (mapconcat
+ (lambda (pair)
+ (let ((timestamp (cdr pair)))
+ (when timestamp
+ (let ((string (car pair)))
+ (format "<span class=\"timestamp-kwd\">%s</span> \
+<span class=\"timestamp\">%s</span> "
+ string
+ (org-html-plain-text (org-timestamp-translate timestamp)
+ info))))))
+ `((,org-closed-string . ,(org-element-property :closed planning))
+ (,org-deadline-string . ,(org-element-property :deadline planning))
+ (,org-scheduled-string . ,(org-element-property :scheduled planning)))
+ ""))))
;;;; Property Drawer
-(defun org-html-property-drawer (property-drawer contents info)
+(defun org-html-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element from Org to HTML.
CONTENTS holds the contents of the drawer. INFO is a plist
holding contextual information."
@@ -3138,11 +3233,19 @@ holding contextual information."
;;;; Quote Block
-(defun org-html-quote-block (quote-block contents info)
+(defun org-html-quote-block (quote-block contents _info)
"Transcode a QUOTE-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (format "<blockquote>\n%s</blockquote>" contents))
+ (format "<blockquote%s>\n%s</blockquote>"
+ (let* ((name (org-element-property :name quote-block))
+ (attributes (org-export-read-attribute :attr_html quote-block))
+ (a (org-html--make-attribute-string
+ (if (or (not name) (plist-member attributes :id))
+ attributes
+ (plist-put attributes :id name)))))
+ (if (org-string-nw-p a) (concat " " a) ""))
+ contents))
;;;; Section
@@ -3185,48 +3288,60 @@ contextual information."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((block-type (org-element-property :type special-block))
- (contents (or contents ""))
- (html5-fancy (and (org-html--html5-fancy-p info)
- (member block-type org-html-html5-elements)))
- (attributes (org-export-read-attribute :attr_html special-block)))
+ (html5-fancy (and (org-html--html5-fancy-p info)
+ (member block-type org-html-html5-elements)))
+ (attributes (org-export-read-attribute :attr_html special-block)))
(unless html5-fancy
(let ((class (plist-get attributes :class)))
- (setq attributes (plist-put attributes :class
- (if class (concat class " " block-type)
- block-type)))))
- (setq attributes (org-html--make-attribute-string attributes))
- (when (not (equal attributes ""))
- (setq attributes (concat " " attributes)))
- (if html5-fancy
- (format "<%s%s>\n%s</%s>" block-type attributes
- contents block-type)
- (format "<div%s>\n%s\n</div>" attributes contents))))
+ (setq attributes (plist-put attributes :class
+ (if class (concat class " " block-type)
+ block-type)))))
+ (let* ((contents (or contents ""))
+ (name (org-element-property :name special-block))
+ (a (org-html--make-attribute-string
+ (if (or (not name) (plist-member attributes :id))
+ attributes
+ (plist-put attributes :id name))))
+ (str (if (org-string-nw-p a) (concat " " a) "")))
+ (if html5-fancy
+ (format "<%s%s>\n%s</%s>" block-type str contents block-type)
+ (format "<div%s>\n%s\n</div>" str contents)))))
;;;; Src Block
-(defun org-html-src-block (src-block contents info)
+(defun org-html-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(if (org-export-read-attribute :attr_html src-block :textarea)
(org-html--textarea-block src-block)
(let ((lang (org-element-property :language src-block))
- (caption (org-export-get-caption src-block))
(code (org-html-format-code src-block info))
(label (let ((lbl (and (org-element-property :name src-block)
(org-export-get-reference src-block info))))
(if lbl (format " id=\"%s\"" lbl) ""))))
(if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
- (format
- "<div class=\"org-src-container\">\n%s%s\n</div>"
- (if (not caption) ""
- (format "<label class=\"org-src-name\">%s</label>"
- (org-export-data caption info)))
- (format "\n<pre class=\"src src-%s\"%s>%s</pre>" lang label code))))))
+ (format "<div class=\"org-src-container\">\n%s%s\n</div>"
+ ;; Build caption.
+ (let ((caption (org-export-get-caption src-block)))
+ (if (not caption) ""
+ (let ((listing-number
+ (format
+ "<span class=\"listing-number\">%s </span>"
+ (format
+ (org-html--translate "Listing %d:" info)
+ (org-export-get-ordinal
+ src-block info nil #'org-html--has-caption-p)))))
+ (format "<label class=\"org-src-name\">%s%s</label>"
+ listing-number
+ (org-trim (org-export-data caption info))))))
+ ;; Contents.
+ (format "<pre class=\"src src-%s\"%s>%s</pre>"
+ lang label code))))))
;;;; Statistics Cookie
-(defun org-html-statistics-cookie (statistics-cookie contents info)
+(defun org-html-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((cookie-value (org-element-property :value statistics-cookie)))
@@ -3234,7 +3349,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Strike-Through
-(defun org-html-strike-through (strike-through contents info)
+(defun org-html-strike-through (_strike-through contents info)
"Transcode STRIKE-THROUGH from Org to HTML.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
@@ -3245,7 +3360,7 @@ holding contextual information."
;;;; Subscript
-(defun org-html-subscript (subscript contents info)
+(defun org-html-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to HTML.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -3253,7 +3368,7 @@ contextual information."
;;;; Superscript
-(defun org-html-superscript (superscript contents info)
+(defun org-html-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to HTML.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -3302,40 +3417,45 @@ communication channel."
;; Rules are ignored since table separators are deduced from
;; borders of the current row.
(when (eq (org-element-property :type table-row) 'standard)
- (let* ((rowgroup-number (org-export-table-row-group table-row info))
- (row-number (org-export-table-row-number table-row info))
- (start-rowgroup-p
+ (let* ((group (org-export-table-row-group table-row info))
+ (number (org-export-table-row-number table-row info))
+ (start-group-p
(org-export-table-row-starts-rowgroup-p table-row info))
- (end-rowgroup-p
+ (end-group-p
(org-export-table-row-ends-rowgroup-p table-row info))
- ;; `top-row-p' and `end-rowgroup-p' are not used directly
- ;; but should be set so that `org-html-table-row-tags' can
- ;; use them (see the docstring of this variable.)
- (top-row-p (and (equal start-rowgroup-p '(top))
- (equal end-rowgroup-p '(below top))))
- (bottom-row-p (and (equal start-rowgroup-p '(above))
- (equal end-rowgroup-p '(bottom above))))
- (rowgroup-tags
+ (topp (and (equal start-group-p '(top))
+ (equal end-group-p '(below top))))
+ (bottomp (and (equal start-group-p '(above))
+ (equal end-group-p '(bottom above))))
+ (row-open-tag
+ (pcase (plist-get info :html-table-row-open-tag)
+ ((and accessor (pred functionp))
+ (funcall accessor
+ number group start-group-p end-group-p topp bottomp))
+ (accessor accessor)))
+ (row-close-tag
+ (pcase (plist-get info :html-table-row-close-tag)
+ ((and accessor (pred functionp))
+ (funcall accessor
+ number group start-group-p end-group-p topp bottomp))
+ (accessor accessor)))
+ (group-tags
(cond
- ;; Case 1: Row belongs to second or subsequent rowgroups.
- ((not (= 1 rowgroup-number))
- '("<tbody>" . "\n</tbody>"))
- ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups.
+ ;; Row belongs to second or subsequent groups.
+ ((not (= 1 group)) '("<tbody>" . "\n</tbody>"))
+ ;; Row is from first group. Table has >=1 groups.
((org-export-table-has-header-p
(org-export-get-parent-table table-row) info)
'("<thead>" . "\n</thead>"))
- ;; Case 2: Row is from first and only row group.
+ ;; Row is from first and only group.
(t '("<tbody>" . "\n</tbody>")))))
- (concat
- ;; Begin a rowgroup?
- (when start-rowgroup-p (car rowgroup-tags))
- ;; Actual table row
- (concat "\n" (eval (car (plist-get info :html-table-row-tags)))
- contents
- "\n"
- (eval (cdr (plist-get info :html-table-row-tags))))
- ;; End a rowgroup?
- (when end-rowgroup-p (cdr rowgroup-tags))))))
+ (concat (and start-group-p (car group-tags))
+ (concat "\n"
+ row-open-tag
+ contents
+ "\n"
+ row-close-tag)
+ (and end-group-p (cdr group-tags))))))
;;;; Table
@@ -3351,7 +3471,7 @@ INFO is a plist used as a communication channel."
(if (not special-column-p) (org-element-contents table-row)
(cdr (org-element-contents table-row)))))
-(defun org-html-table--table.el-table (table info)
+(defun org-html-table--table.el-table (table _info)
"Format table.el tables into HTML.
INFO is a plist used as a communication channel."
(when (eq (org-element-property :type table) 'table.el)
@@ -3372,63 +3492,61 @@ INFO is a plist used as a communication channel."
"Transcode a TABLE element from Org to HTML.
CONTENTS is the contents of the table. INFO is a plist holding
contextual information."
- (case (org-element-property :type table)
- ;; Case 1: table.el table. Convert it using appropriate tools.
- (table.el (org-html-table--table.el-table table info))
- ;; Case 2: Standard table.
- (t
- (let* ((caption (org-export-get-caption table))
- (number (org-export-get-ordinal
- table info nil #'org-html--has-caption-p))
- (attributes
- (org-html--make-attribute-string
- (org-combine-plists
- (and (org-element-property :name table)
- (list :id (org-export-get-reference table info)))
- (and (not (org-html-html5-p info))
- (plist-get info :html-table-attributes))
- (org-export-read-attribute :attr_html table))))
- (alignspec
- (if (and (boundp 'org-html-format-table-no-css)
- org-html-format-table-no-css)
- "align=\"%s\"" "class=\"org-%s\""))
- (table-column-specs
- (function
- (lambda (table info)
- (mapconcat
- (lambda (table-cell)
- (let ((alignment (org-export-table-cell-alignment
- table-cell info)))
- (concat
- ;; Begin a colgroup?
- (when (org-export-table-cell-starts-colgroup-p
- table-cell info)
- "\n<colgroup>")
- ;; Add a column. Also specify its alignment.
- (format "\n%s"
- (org-html-close-tag
- "col" (concat " " (format alignspec alignment)) info))
- ;; End a colgroup?
- (when (org-export-table-cell-ends-colgroup-p
- table-cell info)
- "\n</colgroup>"))))
- (org-html-table-first-row-data-cells table info) "\n")))))
- (format "<table%s>\n%s\n%s\n%s</table>"
- (if (equal attributes "") "" (concat " " attributes))
- (if (not caption) ""
- (format (if (plist-get info :html-table-caption-above)
- "<caption class=\"t-above\">%s</caption>"
- "<caption class=\"t-bottom\">%s</caption>")
- (concat
- "<span class=\"table-number\">"
- (format (org-html--translate "Table %d:" info) number)
- "</span> " (org-export-data caption info))))
- (funcall table-column-specs table info)
- contents)))))
+ (if (eq (org-element-property :type table) 'table.el)
+ ;; "table.el" table. Convert it using appropriate tools.
+ (org-html-table--table.el-table table info)
+ ;; Standard table.
+ (let* ((caption (org-export-get-caption table))
+ (number (org-export-get-ordinal
+ table info nil #'org-html--has-caption-p))
+ (attributes
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (and (org-element-property :name table)
+ (list :id (org-export-get-reference table info)))
+ (and (not (org-html-html5-p info))
+ (plist-get info :html-table-attributes))
+ (org-export-read-attribute :attr_html table))))
+ (alignspec
+ (if (bound-and-true-p org-html-format-table-no-css)
+ "align=\"%s\""
+ "class=\"org-%s\""))
+ (table-column-specs
+ (lambda (table info)
+ (mapconcat
+ (lambda (table-cell)
+ (let ((alignment (org-export-table-cell-alignment
+ table-cell info)))
+ (concat
+ ;; Begin a colgroup?
+ (when (org-export-table-cell-starts-colgroup-p
+ table-cell info)
+ "\n<colgroup>")
+ ;; Add a column. Also specify its alignment.
+ (format "\n%s"
+ (org-html-close-tag
+ "col" (concat " " (format alignspec alignment)) info))
+ ;; End a colgroup?
+ (when (org-export-table-cell-ends-colgroup-p
+ table-cell info)
+ "\n</colgroup>"))))
+ (org-html-table-first-row-data-cells table info) "\n"))))
+ (format "<table%s>\n%s\n%s\n%s</table>"
+ (if (equal attributes "") "" (concat " " attributes))
+ (if (not caption) ""
+ (format (if (plist-get info :html-table-caption-above)
+ "<caption class=\"t-above\">%s</caption>"
+ "<caption class=\"t-bottom\">%s</caption>")
+ (concat
+ "<span class=\"table-number\">"
+ (format (org-html--translate "Table %d:" info) number)
+ "</span> " (org-export-data caption info))))
+ (funcall table-column-specs table info)
+ contents))))
;;;; Target
-(defun org-html-target (target contents info)
+(defun org-html-target (target _contents info)
"Transcode a TARGET object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -3437,7 +3555,7 @@ information."
;;;; Timestamp
-(defun org-html-timestamp (timestamp contents info)
+(defun org-html-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -3447,7 +3565,7 @@ information."
;;;; Underline
-(defun org-html-underline (underline contents info)
+(defun org-html-underline (_underline contents info)
"Transcode UNDERLINE from Org to HTML.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -3457,7 +3575,7 @@ holding contextual information."
;;;; Verbatim
-(defun org-html-verbatim (verbatim contents info)
+(defun org-html-verbatim (verbatim _contents info)
"Transcode VERBATIM from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -3466,7 +3584,7 @@ information."
;;;; Verse Block
-(defun org-html-verse-block (verse-block contents info)
+(defun org-html-verse-block (_verse-block contents info)
"Transcode a VERSE-BLOCK element from Org to HTML.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
@@ -3481,15 +3599,14 @@ contextual information."
;; non-breaking space.
(while (string-match "^[ \t]+" contents)
(let* ((num-ws (length (match-string 0 contents)))
- (ws (let (out) (dotimes (i num-ws out)
- (setq out (concat out "&#xa0;"))))))
+ (ws (org-html--make-string num-ws "&#xa0;")))
(setq contents (replace-match ws nil t contents))))
(format "<p class=\"verse\">\n%s</p>" contents))
;;; Filter Functions
-(defun org-html-final-function (contents backend info)
+(defun org-html-final-function (contents _backend info)
"Filter to indent the HTML and convert HTML entities."
(with-temp-buffer
(insert contents)
@@ -3539,10 +3656,10 @@ is non-nil."
;;;###autoload
(defun org-html-convert-region-to-html ()
- "Assume the current region has org-mode syntax, and convert it to HTML.
+ "Assume the current region has Org syntax, and convert it to HTML.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an HTML buffer and use this
-command to convert it."
+itemized list in Org syntax in an HTML buffer and use this command
+to convert it."
(interactive)
(org-export-replace-region-by 'html))
diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el
index f965ddc..c22866a 100644
--- a/lisp/ox-icalendar.el
+++ b/lisp/ox-icalendar.el
@@ -1,4 +1,4 @@
-;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine
+;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -31,7 +31,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox-ascii)
(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
@@ -46,7 +46,7 @@
(defcustom org-icalendar-combined-agenda-file "~/org.ics"
"The file name for the iCalendar file covering all agenda files.
-This file is created with the command \\[org-icalendar-combine-agenda-files].
+This file is created with the command `\\[org-icalendar-combine-agenda-files]'.
The file name should be absolute. It will be overwritten without warning."
:group 'org-export-icalendar
:type 'file)
@@ -396,7 +396,8 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
;; Convert timestamp into internal time in order to use
;; `format-time-string' and fix any mistake (i.e. MI >= 60).
(encode-time 0 mi h d m y)
- (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p)))))))
+ (and (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p)))
+ t)))))
(defun org-icalendar-dtstamp ()
"Return DTSTAMP property, as a string."
@@ -407,27 +408,25 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
ENTRY is a headline or an inlinetask element. INFO is a plist
used as a communication channel."
(mapconcat
- 'identity
+ #'identity
(org-uniquify
(let (categories)
- (mapc (lambda (type)
- (case type
- (category
- (push (org-export-get-category entry info) categories))
- (todo-state
- (let ((todo (org-element-property :todo-keyword entry)))
- (and todo (push todo categories))))
- (local-tags
- (setq categories
- (append (nreverse (org-export-get-tags entry info))
- categories)))
- (all-tags
- (setq categories
- (append (nreverse (org-export-get-tags entry info nil t))
- categories)))))
- org-icalendar-categories)
- ;; Return list of categories, following specified order.
- (nreverse categories))) ","))
+ (dolist (type org-icalendar-categories (nreverse categories))
+ (cl-case type
+ (category
+ (push (org-export-get-category entry info) categories))
+ (todo-state
+ (let ((todo (org-element-property :todo-keyword entry)))
+ (and todo (push todo categories))))
+ (local-tags
+ (setq categories
+ (append (nreverse (org-export-get-tags entry info))
+ categories)))
+ (all-tags
+ (setq categories
+ (append (nreverse (org-export-get-tags entry info nil t))
+ categories)))))))
+ ","))
(defun org-icalendar-transcode-diary-sexp (sexp uid summary)
"Transcode a diary sexp into iCalendar format.
@@ -479,7 +478,7 @@ or subject for the event."
;;; Filters
-(defun org-icalendar-clear-blank-lines (headline back-end info)
+(defun org-icalendar-clear-blank-lines (headline _back-end _info)
"Remove blank lines in HEADLINE export.
HEADLINE is a string representing a transcoded headline.
BACK-END and INFO are ignored."
@@ -576,11 +575,11 @@ inlinetask within the section."
'timestamp
(lambda (ts)
(when (let ((type (org-element-property :type ts)))
- (case (plist-get info :with-timestamps)
+ (cl-case (plist-get info :with-timestamps)
(active (memq type '(active active-range)))
(inactive (memq type '(inactive inactive-range)))
((t) t)))
- (let ((uid (format "TS%d-%s" (incf counter) uid)))
+ (let ((uid (format "TS%d-%s" (cl-incf counter) uid)))
(org-icalendar--vevent
entry ts uid summary loc desc cat))))
info nil (and (eq type 'headline) 'inlinetask))
@@ -589,7 +588,7 @@ inlinetask within the section."
;; so, call `org-icalendar--vtodo' to transcode it into
;; a "VTODO" component.
(when (and todo-type
- (case (plist-get info :icalendar-include-todo)
+ (cl-case (plist-get info :icalendar-include-todo)
(all t)
(unblocked
(and (eq type 'headline)
@@ -611,7 +610,7 @@ inlinetask within the section."
(lambda (sexp)
(org-icalendar-transcode-diary-sexp
(org-element-property :value sexp)
- (format "DS%d-%s" (incf counter) uid)
+ (format "DS%d-%s" (cl-incf counter) uid)
summary))
info nil (and (eq type 'headline) 'inlinetask))
"")))))
@@ -627,7 +626,7 @@ inlinetask within the section."
contents))))
(defun org-icalendar--vevent
- (entry timestamp uid summary location description categories)
+ (entry timestamp uid summary location description categories)
"Create a VEVENT component.
ENTRY is either a headline or an inlinetask element. TIMESTAMP
@@ -651,7 +650,7 @@ Return VEVENT component as a string."
;; RRULE.
(when (org-element-property :repeater-type timestamp)
(format "RRULE:FREQ=%s;INTERVAL=%d\n"
- (case (org-element-property :repeater-unit timestamp)
+ (cl-case (org-element-property :repeater-unit timestamp)
(hour "HOURLY") (day "DAILY") (week "WEEKLY")
(month "MONTHLY") (year "YEARLY"))
(org-element-property :repeater-value timestamp)))
@@ -836,27 +835,23 @@ external process."
;; Asynchronous export is not interactive, so we will not call
;; `org-check-agenda-file'. Instead we remove any non-existent
;; agenda file from the list.
- (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+ (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t))))
(org-export-async-start
(lambda (results)
- (mapc (lambda (f) (org-export-add-to-stack f 'icalendar))
- results))
+ (dolist (f results) (org-export-add-to-stack f 'icalendar)))
`(let (output-files)
- (mapc (lambda (file)
- (with-current-buffer (org-get-agenda-file-buffer file)
- (push (expand-file-name (org-icalendar-export-to-ics))
- output-files)))
- ',files)
- output-files)))
+ (dolist (file ',files outputfiles)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (push (expand-file-name (org-icalendar-export-to-ics))
+ output-files))))))
(let ((files (org-agenda-files t)))
(org-agenda-prepare-buffers files)
(unwind-protect
- (mapc (lambda (file)
- (catch 'nextfile
- (org-check-agenda-file file)
- (with-current-buffer (org-get-agenda-file-buffer file)
- (org-icalendar-export-to-ics))))
- files)
+ (dolist (file files)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (org-icalendar-export-to-ics))))
(org-release-buffers org-agenda-new-buffers)))))
;;;###autoload
@@ -871,14 +866,14 @@ The file is stored under the name chosen in
`org-icalendar-combined-agenda-file'."
(interactive)
(if async
- (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+ (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t))))
(org-export-async-start
- (lambda (dummy)
+ (lambda (_)
(org-export-add-to-stack
(expand-file-name org-icalendar-combined-agenda-file)
'icalendar))
- `(apply 'org-icalendar--combine-files ',files)))
- (apply 'org-icalendar--combine-files (org-agenda-files t))))
+ `(apply #'org-icalendar--combine-files ',files)))
+ (apply #'org-icalendar--combine-files (org-agenda-files t))))
(defun org-icalendar-export-current-agenda (file)
"Export current agenda view to an iCalendar FILE.
diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el
index 121a675..57ec1d2 100644
--- a/lisp/ox-latex.el
+++ b/lisp/ox-latex.el
@@ -1,4 +1,4 @@
-;;; ox-latex.el --- LaTeX Back-End for Org Export Engine
+;;; ox-latex.el --- LaTeX Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@@ -26,7 +26,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox)
(require 'ox-publish)
@@ -90,7 +90,6 @@
;; Pseudo objects and elements.
(latex-math-block . org-latex-math-block)
(latex-matrices . org-latex-matrices))
- :export-block '("LATEX" "TEX")
:menu-entry
'(?l "Export to LaTeX"
((?L "As LaTeX buffer" org-latex-export-as-latex)
@@ -119,6 +118,7 @@
(:latex-default-table-environment nil nil org-latex-default-table-environment)
(:latex-default-table-mode nil nil org-latex-default-table-mode)
(:latex-diary-timestamp-format nil nil org-latex-diary-timestamp-format)
+ (:latex-footnote-defined-format nil nil org-latex-footnote-defined-format)
(:latex-footnote-separator nil nil org-latex-footnote-separator)
(:latex-format-drawer-function nil nil org-latex-format-drawer-function)
(:latex-format-headline-function nil nil org-latex-format-headline-function)
@@ -127,6 +127,7 @@
(:latex-image-default-height nil nil org-latex-image-default-height)
(:latex-image-default-option nil nil org-latex-image-default-option)
(:latex-image-default-width nil nil org-latex-image-default-width)
+ (:latex-images-centered nil nil org-latex-images-centered)
(:latex-inactive-timestamp-format nil nil org-latex-inactive-timestamp-format)
(:latex-inline-image-rules nil nil org-latex-inline-image-rules)
(:latex-link-with-unknown-path-format nil nil org-latex-link-with-unknown-path-format)
@@ -144,6 +145,7 @@
(:latex-text-markup-alist nil nil org-latex-text-markup-alist)
(:latex-title-command nil nil org-latex-title-command)
(:latex-toc-command nil nil org-latex-toc-command)
+ (:latex-compiler "LATEX_COMPILER" nil org-latex-compiler)
;; Redefine regular options.
(:date "DATE" nil "\\today" parse)))
@@ -327,7 +329,7 @@ Otherwise, place it near the end. When value is a list of
symbols, put caption above selected elements only. Allowed
symbols are: `image', `table', `src-block' and `special-block'."
:group 'org-export-latex
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "For all elements" t)
@@ -363,9 +365,9 @@ For example, when this variable is non-nil, a headline like this:
:CUSTOM_ID: sec:foo
:END:
This is section [[#sec:foo]].
- #+BEGIN_LATEX
+ #+BEGIN_EXPORT latex
And this is still section \\ref{sec:foo}.
- #+END_LATEX
+ #+END_EXPORT
will be exported to LaTeX as:
@@ -390,7 +392,7 @@ labeling scheme to generate labels and resolve links into proper
references."
:group 'org-export-latex
:type 'boolean
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3"))
;;;; Preamble
@@ -572,14 +574,14 @@ precedence over this variable."
The format string should have at most one \"%s\"-expression,
which is replaced with the subtitle."
:group 'org-export-latex
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(string :tag "Format string"))
(defcustom org-latex-subtitle-separate nil
"Non-nil means the subtitle is not typeset as part of title."
:group 'org-export-latex
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'boolean)
@@ -616,12 +618,10 @@ inserted.
Setting :latex-hyperref-template in publishing projects will take
precedence over this variable."
:group 'org-export-latex
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(choice (const :tag "No template" nil)
(string :tag "Format string")))
-(define-obsolete-variable-alias
- 'org-latex-with-hyperref 'org-latex-hyperref-template "25.1")
;;;; Headline
@@ -651,6 +651,16 @@ The function result will be used in the section format string."
:group 'org-export-latex
:type 'string)
+(defcustom org-latex-footnote-defined-format "\\textsuperscript{\\ref{%s}}"
+ "Format string used to format reference to footnote already defined.
+%s will be replaced by the label of the referred footnote."
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "Use plain superscript (default)" "\\textsuperscript{\\ref{%s}}")
+ (const :tag "Use Memoir/KOMA-Script footref" "\\footref{%s}")
+ (string :tag "Other format string"))
+ :version "25.2"
+ :package-version '(Org . "9.0"))
;;;; Timestamps
@@ -672,6 +682,14 @@ The function result will be used in the section format string."
;;;; Links
+(defcustom org-latex-images-centered t
+ "When non-nil, images are centered."
+ :group 'org-export-latex
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :type 'boolean
+ :safe #'booleanp)
+
(defcustom org-latex-image-default-option ""
"Default option for images."
:group 'org-export-latex
@@ -697,10 +715,13 @@ environment."
:package-version '(Org . "8.0")
:type 'string)
-(defcustom org-latex-default-figure-position "htb"
- "Default position for latex figures."
+(defcustom org-latex-default-figure-position "htbp"
+ "Default position for LaTeX figures."
:group 'org-export-latex
- :type 'string)
+ :type 'string
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :safe #'stringp)
(defcustom org-latex-inline-image-rules
'(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'"))
@@ -821,7 +842,7 @@ to typeset and try to protect special characters.
If no association can be found for a given markup, text will be
returned as-is."
:group 'org-export-latex
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'alist
:options '(bold code italic strike-through underline verbatim))
@@ -829,8 +850,7 @@ returned as-is."
;;;; Drawers
-(defcustom org-latex-format-drawer-function
- (lambda (name contents) contents)
+(defcustom org-latex-format-drawer-function (lambda (_ contents) contents)
"Function called to format a drawer in LaTeX code.
The function must accept two parameters:
@@ -864,7 +884,7 @@ The function must accept seven parameters:
The function should return the string to be exported."
:group 'org-export-latex
:type 'function
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3"))
@@ -923,7 +943,8 @@ into previewing problems, please consult
(gnuplot "Gnuplot")
(ocaml "Caml") (caml "Caml")
(sql "SQL") (sqlite "sql")
- (makefile "make"))
+ (makefile "make")
+ (R "r"))
"Alist mapping languages to their listing language counterpart.
The key is a symbol, the major mode symbol without the \"-mode\".
The value is the string that should be inserted as the language
@@ -1020,34 +1041,116 @@ block-specific options, you may use the following syntax:
(string :tag "Minted option name ")
(string :tag "Minted option value"))))
-(defvar org-latex-custom-lang-environments nil
+(defcustom org-latex-custom-lang-environments nil
"Alist mapping languages to language-specific LaTeX environments.
It is used during export of src blocks by the listings and minted
-latex packages. For example,
+latex packages. The environment may be a simple string, composed of
+only letters and numbers. In this case, the string is directly the
+name of the latex environment to use. The environment may also be
+a format string. In this case the format string will be directly
+exported. This format string may contain these elements:
+
+ %s for the formatted source
+ %c for the caption
+ %f for the float attribute
+ %l for an appropriate label
+ %o for the LaTeX attributes
+
+For example,
(setq org-latex-custom-lang-environments
- '((python \"pythoncode\")))
+ '((python \"pythoncode\")
+ (ocaml \"\\\\begin{listing}
+\\\\begin{minted}[%o]{ocaml}
+%s\\\\end{minted}
+\\\\caption{%c}
+\\\\label{%l}\")))
-would have the effect that if org encounters begin_src python
-during latex export it will output
+would have the effect that if Org encounters a Python source block
+during LaTeX export it will produce
\\begin{pythoncode}
<src block body>
- \\end{pythoncode}")
+ \\end{pythoncode}
+
+and if Org encounters an Ocaml source block during LaTeX export it
+will produce
+
+ \\begin{listing}
+ \\begin{minted}[<attr_latex options>]{ocaml}
+ <src block body>
+ \\end{minted}
+ \\caption{<caption>}
+ \\label{<label>}
+ \\end{listing}"
+ :group 'org-export-latex
+ :type '(repeat
+ (list
+ (symbol :tag "Language name ")
+ (string :tag "Environment name or format string")))
+ :version "25.2"
+ :package-version '(Org . "9.0"))
;;;; Compilation
+(defcustom org-latex-compiler-file-string "%% Intended LaTeX compiler: %s\n"
+ "LaTeX compiler format-string.
+See also `org-latex-compiler'."
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "Comment" "%% Intended LaTeX compiler: %s\n")
+ (const :tag "latex-mode file variable" "%% -*- latex-run-command: %s -*-\n")
+ (const :tag "AUCTeX file variable" "%% -*- LaTeX-command: %s -*-\n")
+ (string :tag "custom format" "%% %s"))
+ :version "25.2"
+ :package-version '(Org . "9.0"))
+
+(defcustom org-latex-compiler "pdflatex"
+ "LaTeX compiler to use.
+
+Must be an element in `org-latex-compilers' or the empty quote.
+Can also be set in buffers via #+LATEX_COMPILER. See also
+`org-latex-compiler-file-string'."
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "pdfLaTeX" "pdflatex")
+ (const :tag "XeLaTeX" "xelatex")
+ (const :tag "LuaLaTeX" "lualatex")
+ (const :tag "Unset" ""))
+ :version "25.2"
+ :package-version '(Org . "9.0"))
+
+(defconst org-latex-compilers '("pdflatex" "xelatex" "lualatex")
+ "Known LaTeX compilers.
+See also `org-latex-compiler'.")
+
+(defcustom org-latex-bib-compiler "bibtex"
+ "Command to process a LaTeX file's bibliography.
+
+The shorthand %bib in `org-latex-pdf-process' is replaced with
+this value.
+
+A better approach is to use a compiler suit such as `latexmk'."
+ :group 'org-export-latex
+ :type '(choice (const :tag "BibTeX" "bibtex")
+ (const :tag "Biber" "biber")
+ (string :tag "Other process"))
+ :version "25.2"
+ :package-version '(Org . "9.0"))
+
(defcustom org-latex-pdf-process
- '("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f")
+ '("%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f")
"Commands to process a LaTeX file to a PDF file.
This is a list of strings, each of them will be given to the
shell as a command. %f in the command will be replaced by the
full file name, %b by the file base name (i.e. without directory
-and extension parts) and %o by the base directory of the file.
+and extension parts), %o by the base directory of the file,
+%latex is the LaTeX compiler (see `org-latex-compiler'), and %bib
+is the BibTeX-like compiler (see `org-latex-bib-compiler').
The reason why this is a list is that it usually takes several
runs of `pdflatex', maybe mixed with a call to `bibtex'. Org
@@ -1055,18 +1158,8 @@ does not have a clever mechanism to detect which of these
commands have to be run to get to a stable result, and it also
does not do any error checking.
-By default, Org uses 3 runs of `pdflatex' to do the processing.
-If you have texi2dvi on your system and if that does not cause
-the infamous egrep/locale bug:
-
- http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
-
-then `texi2dvi' is the superior choice as it automates the LaTeX
-build process by calling the \"correct\" combinations of
-auxiliary programs. Org does offer `texi2dvi' as one of the
-customize options. Alternatively, `rubber' and `latexmk' also
-provide similar functionality. The latter supports `biber' out
-of the box.
+Consider a smart LaTeX compiler such as `texi2dvi' or `latexmk',
+which calls the \"correct\" combinations of auxiliary programs.
Alternatively, this may be a Lisp function that does the
processing, so you could use this to apply the machinery of
@@ -1076,36 +1169,22 @@ file name as its single argument."
:type '(choice
(repeat :tag "Shell command sequence"
(string :tag "Shell command"))
- (const :tag "2 runs of pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "3 runs of pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "pdflatex,bibtex,pdflatex,pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "bibtex %b"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "2 runs of xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "3 runs of xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "xelatex,bibtex,xelatex,xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "bibtex %b"
- "xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "2 runs of latex"
+ ("%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "3 runs of latex"
+ ("%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "latex,bibtex,latex,latex"
+ ("%latex -interaction nonstopmode -output-directory %o %f"
+ "%bib %b"
+ "%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"))
(const :tag "texi2dvi"
- ("texi2dvi -p -b -V %f"))
- (const :tag "rubber"
- ("rubber -d --into %o %f"))
+ ("LATEX=\"%latex\" texi2dvi -p -b -V %f"))
(const :tag "latexmk"
- ("latexmk -g -pdf %f"))
+ ("latexmk -g -pdflatex=\"%latex\" %f"))
(function)))
(defcustom org-latex-logfiles-extensions
@@ -1115,7 +1194,7 @@ file name as its single argument."
The logfiles will be removed if `org-latex-remove-logfiles' is
non-nil."
:group 'org-export-latex
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(repeat (string :tag "Extension")))
@@ -1139,7 +1218,7 @@ The regular expressions are used to find possible warnings in the
log of a latex-run. These warnings will be reported after
calling `org-latex-compile'."
:group 'org-export-latex
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(repeat
(cons
@@ -1171,7 +1250,7 @@ Eventually, if FULL is non-nil, wrap label within \"\\label{}\"."
(let* ((type (org-element-type datum))
(user-label
(org-element-property
- (case type
+ (cl-case type
((headline inlinetask) :CUSTOM_ID)
(target :value)
(otherwise :name))
@@ -1180,11 +1259,11 @@ Eventually, if FULL is non-nil, wrap label within \"\\label{}\"."
(and (or user-label force)
(if (and user-label (plist-get info :latex-prefer-user-labels))
user-label
- (concat (case type
+ (concat (cl-case type
(headline "sec:")
(table "tab:")
(latex-environment
- (and (org-string-match-p
+ (and (string-match-p
org-latex-math-environments-re
(org-element-property :value datum))
"eq:"))
@@ -1222,13 +1301,13 @@ For non-floats, see `org-latex--wrap-label'."
((org-string-nw-p caption-from-attr-latex)
(concat caption-from-attr-latex "\n"))
((and (not main) (equal label "")) "")
- ((not main) (concat label "\n"))
+ ((not main) label)
;; Option caption format with short name.
(t
(format (if nonfloat "\\captionof{%s}%s{%s%s}\n"
"\\caption%s%s{%s%s}\n")
(if nonfloat
- (case type
+ (cl-case type
(paragraph "figure")
(src-block (if (plist-get info :latex-listings)
"listing"
@@ -1280,8 +1359,8 @@ Return the new header."
header
(let ((options (save-match-data
(org-split-string (match-string 1 header) ",[ \t]*")))
- (language (cdr (assoc language-code
- org-latex-babel-language-alist))))
+ (language (cdr (assoc-string language-code
+ org-latex-babel-language-alist t))))
;; If LANGUAGE is already loaded, return header without AUTO.
;; Otherwise, replace AUTO with language or append language if
;; AUTO is not present.
@@ -1346,13 +1425,37 @@ Return the new header."
""))
t t header 0)))))
+(defun org-latex--remove-packages (pkg-alist info)
+ "Remove packages based on the current LaTeX compiler.
+
+If the fourth argument of an element is set in pkg-alist, and it
+is not a member of the LaTeX compiler of the document, the packages
+is removed. See also `org-latex-compiler'.
+
+Return modified pkg-alist."
+ (let ((compiler (or (plist-get info :latex-compiler) "")))
+ (if (member-ignore-case compiler org-latex-compilers)
+ (delq nil
+ (mapcar
+ (lambda (pkg)
+ (unless (and
+ (listp pkg)
+ (let ((third (nth 3 pkg)))
+ (and third
+ (not (member-ignore-case
+ compiler
+ (if (listp third) third (list third)))))))
+ pkg))
+ pkg-alist))
+ pkg-alist)))
+
(defun org-latex--find-verb-separator (s)
"Return a character not used in string S.
This is used to choose a separator for constructs like \\verb."
(let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
- (loop for c across ll
- when (not (string-match (regexp-quote (char-to-string c)) s))
- return (char-to-string c))))
+ (cl-loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
(defun org-latex--make-option-string (options)
"Return a comma separated string of keywords and values.
@@ -1360,9 +1463,10 @@ OPTIONS is an alist where the key is the options keyword as
a string, and the value a list containing the keyword value, or
nil."
(mapconcat (lambda (pair)
- (concat (first pair)
- (when (> (length (second pair)) 0)
- (concat "=" (second pair)))))
+ (pcase-let ((`(,keyword ,value) pair))
+ (concat keyword
+ (and (> (length value) 0)
+ (concat "=" value)))))
options
","))
@@ -1394,7 +1498,7 @@ should not be used for floats. See
INFO is a plist used as a communication channel. See
`org-latex-text-markup-alist' for details."
(let ((fmt (cdr (assq markup (plist-get info :latex-text-markup-alist)))))
- (case fmt
+ (cl-case fmt
;; No format string: Return raw text.
((nil) text)
;; Handle the `verb' special case: Find an appropriate separator
@@ -1416,38 +1520,35 @@ INFO is a plist used as a communication channel. See
INFO is a plist used as a communication channel.
-Footnotes definitions are returned within \"\\footnotetxt{}\"
+Footnotes definitions are returned within \"\\footnotetext{}\"
commands.
This function is used within constructs that don't support
-\"\\footnote{}\" command (i.e. an item's tag). In that case,
+\"\\footnote{}\" command (e.g., an item tag). In that case,
\"\\footnotemark\" is used within the construct and the function
just outside of it."
(mapconcat
(lambda (ref)
- (format
- "\\footnotetext[%s]{%s}"
- (org-export-get-footnote-number ref info)
- (org-trim
- (org-export-data
- (org-export-get-footnote-definition ref info) info))))
+ (let ((def (org-export-get-footnote-definition ref info)))
+ (format "\\footnotetext[%d]{%s%s}"
+ (org-export-get-footnote-number ref info)
+ (org-trim (org-latex--label def info t t))
+ (org-trim (org-export-data def info)))))
;; Find every footnote reference in ELEMENT.
- (let* (all-refs
- search-refs ; For byte-compiler.
- (search-refs
- (function
- (lambda (data)
- ;; Return a list of all footnote references never seen
- ;; before in DATA.
- (org-element-map data 'footnote-reference
- (lambda (ref)
- (when (org-export-footnote-first-reference-p ref info)
- (push ref all-refs)
- (when (eq (org-element-property :type ref) 'standard)
- (funcall search-refs
- (org-export-get-footnote-definition ref info)))))
- info)
- (reverse all-refs)))))
+ (letrec ((all-refs nil)
+ (search-refs
+ (lambda (data)
+ ;; Return a list of all footnote references never seen
+ ;; before in DATA.
+ (org-element-map data 'footnote-reference
+ (lambda (ref)
+ (when (org-export-footnote-first-reference-p ref info)
+ (push ref all-refs)
+ (when (eq (org-element-property :type ref) 'standard)
+ (funcall search-refs
+ (org-export-get-footnote-definition ref info)))))
+ info)
+ (reverse all-refs))))
(funcall search-refs element))
""))
@@ -1460,7 +1561,8 @@ INFO is a plist used as a communication channel."
"Create a format-spec for document meta-data.
INFO is a plist used as a communication channel."
(let ((language (let ((lang (plist-get info :language)))
- (or (cdr (assoc lang org-latex-babel-language-alist))
+ (or (cdr (assoc-string lang org-latex-babel-language-alist t))
+ (nth 1 (assoc-string lang org-latex-polyglossia-language-alist t))
lang))))
`((?a . ,(org-export-data (plist-get info :author) info))
(?t . ,(org-export-data (plist-get info :title) info))
@@ -1475,8 +1577,8 @@ INFO is a plist used as a communication channel."
(?L . ,(capitalize language))
(?D . ,(org-export-get-date info)))))
-(defun org-latex--make-header (info)
- "Return a formatted LaTeX header.
+(defun org-latex--make-preamble (info)
+ "Return a formatted LaTeX preamble.
INFO is a plist used as a communication channel."
(let* ((class (plist-get info :latex-class))
(class-options (plist-get info :latex-class-options))
@@ -1495,14 +1597,25 @@ INFO is a plist used as a communication channel."
(org-element-normalize-string
(org-splice-latex-header
document-class-string
- org-latex-default-packages-alist
- org-latex-packages-alist nil
- (concat (org-element-normalize-string
- (plist-get info :latex-header))
- (plist-get info :latex-header-extra)))))
+ (org-latex--remove-packages
+ org-latex-default-packages-alist info)
+ (org-latex--remove-packages
+ org-latex-packages-alist info)
+ nil
+ (mapconcat 'org-element-normalize-string
+ (list (plist-get info :latex-header)
+ (plist-get info :latex-header-extra)) ""))))
info)
info))))
+(defun org-latex--insert-compiler (info)
+ "Insert LaTeX_compiler info into the document.
+INFO is a plist used as a communication channel."
+ (let ((compiler (plist-get info :latex-compiler)))
+ (and (org-string-nw-p org-latex-compiler-file-string)
+ (member (or compiler "") org-latex-compilers)
+ (format org-latex-compiler-file-string compiler))))
+
;;; Template
@@ -1516,8 +1629,10 @@ holding export options."
;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; LaTeX compiler.
+ (org-latex--insert-compiler info)
;; Document class and packages.
- (org-latex--make-header info)
+ (org-latex--make-preamble info)
;; Possibly limit depth for headline numbering.
(let ((sec-num (plist-get info :section-numbers)))
(when (integerp sec-num)
@@ -1583,7 +1698,7 @@ holding export options."
;;;; Bold
-(defun org-latex-bold (bold contents info)
+(defun org-latex-bold (_bold contents info)
"Transcode BOLD from Org to LaTeX.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -1602,7 +1717,7 @@ holding contextual information."
;;;; Clock
-(defun org-latex-clock (clock contents info)
+(defun org-latex-clock (clock _contents info)
"Transcode a CLOCK element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1618,7 +1733,7 @@ information."
;;;; Code
-(defun org-latex-code (code contents info)
+(defun org-latex-code (code _contents info)
"Transcode a CODE object from Org to LaTeX.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -1648,7 +1763,7 @@ holding contextual information. See `org-export-data'."
;;;; Entity
-(defun org-latex-entity (entity contents info)
+(defun org-latex-entity (entity _contents _info)
"Transcode an ENTITY object from Org to LaTeX.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -1657,7 +1772,7 @@ contextual information."
;;;; Example Block
-(defun org-latex-example-block (example-block contents info)
+(defun org-latex-example-block (example-block _contents info)
"Transcode an EXAMPLE-BLOCK element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1676,7 +1791,7 @@ information."
;;;; Export Block
-(defun org-latex-export-block (export-block contents info)
+(defun org-latex-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (member (org-element-property :type export-block) '("LATEX" "TEX"))
@@ -1685,7 +1800,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Snippet
-(defun org-latex-export-snippet (export-snippet contents info)
+(defun org-latex-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'latex)
@@ -1694,7 +1809,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-latex-fixed-width (fixed-width contents info)
+(defun org-latex-fixed-width (fixed-width _contents info)
"Transcode a FIXED-WIDTH element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-latex--wrap-label
@@ -1707,33 +1822,47 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Reference
-(defun org-latex-footnote-reference (footnote-reference contents info)
+(defun org-latex-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
- (concat
- ;; Insert separator between two footnotes in a row.
- (let ((prev (org-export-get-previous-element footnote-reference info)))
- (when (eq (org-element-type prev) 'footnote-reference)
- (plist-get info :latex-footnote-separator)))
- (cond
- ;; Use \footnotemark if the footnote has already been defined.
- ((not (org-export-footnote-first-reference-p footnote-reference info))
- (format "\\footnotemark[%s]{}"
- (org-export-get-footnote-number footnote-reference info)))
- ;; Use \footnotemark if reference is within another footnote
- ;; reference, footnote definition or table cell.
- ((org-element-lineage footnote-reference
- '(footnote-reference footnote-definition table-cell))
- "\\footnotemark")
- ;; Otherwise, define it with \footnote command.
- (t
- (let ((def (org-export-get-footnote-definition footnote-reference info)))
- (concat
- (format "\\footnote{%s}" (org-trim (org-export-data def info)))
- ;; Retrieve all footnote references within the footnote and
- ;; add their definition after it, since LaTeX doesn't support
- ;; them inside.
- (org-latex--delayed-footnotes-definitions def info)))))))
+ (let ((label (org-element-property :label footnote-reference)))
+ (concat
+ ;; Insert separator between two footnotes in a row.
+ (let ((prev (org-export-get-previous-element footnote-reference info)))
+ (when (eq (org-element-type prev) 'footnote-reference)
+ (plist-get info :latex-footnote-separator)))
+ (cond
+ ;; Use `:latex-footnote-defined-format' if the footnote has
+ ;; already been defined.
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (format (plist-get info :latex-footnote-defined-format)
+ (org-latex--label
+ (org-export-get-footnote-definition footnote-reference info)
+ info t)))
+ ;; Use \footnotemark if reference is within another footnote
+ ;; reference, footnote definition or table cell.
+ ((org-element-lineage footnote-reference
+ '(footnote-reference footnote-definition table-cell))
+ "\\footnotemark")
+ ;; Otherwise, define it with \footnote command.
+ (t
+ (let ((def (org-export-get-footnote-definition footnote-reference info)))
+ (concat
+ (format "\\footnote{%s%s}" (org-trim (org-export-data def info))
+ ;; Only insert a \label if there exist another
+ ;; reference to def.
+ (cond ((not label) "")
+ ((org-element-map (plist-get info :parse-tree) 'footnote-reference
+ (lambda (f)
+ (and (not (eq f footnote-reference))
+ (equal (org-element-property :label f) label)
+ (org-trim (org-latex--label def info t t))))
+ info t))
+ (t "")))
+ ;; Retrieve all footnote references within the footnote and
+ ;; add their definition after it, since LaTeX doesn't support
+ ;; them inside.
+ (org-latex--delayed-footnotes-definitions def info))))))))
;;;; Headline
@@ -1807,7 +1936,8 @@ holding contextual information."
(format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize)))
;; Itemize headline
"\\item"
- (and full-text (org-string-match-p "\\`[ \t]*\\[" full-text)
+ (and full-text
+ (string-match-p "\\`[ \t]*\\[" full-text)
"\\relax")
" " full-text "\n"
headline-label
@@ -1844,8 +1974,8 @@ holding contextual information."
(lambda (k)
(and (equal (org-element-property :key k) "TOC")
(let ((v (org-element-property :value k)))
- (and (org-string-match-p "\\<headlines\\>" v)
- (org-string-match-p "\\<local\\>" v)
+ (and (string-match-p "\\<headlines\\>" v)
+ (string-match-p "\\<local\\>" v)
(format "\\stopcontents[level-%d]" level)))))
info t)))))
(if (and opt-title
@@ -1865,7 +1995,7 @@ holding contextual information."
(concat headline-label pre-blanks contents))))))))
(defun org-latex-format-headline-default-function
- (todo todo-type priority text tags info)
+ (todo _todo-type priority text tags info)
"Default format function for a headline.
See `org-latex-format-headline-function' for details."
(concat
@@ -1880,7 +2010,7 @@ See `org-latex-format-headline-function' for details."
;;;; Horizontal Rule
-(defun org-latex-horizontal-rule (horizontal-rule contents info)
+(defun org-latex-horizontal-rule (horizontal-rule _contents info)
"Transcode an HORIZONTAL-RULE object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((attr (org-export-read-attribute :attr_latex horizontal-rule))
@@ -1902,13 +2032,13 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Inline Src Block
-(defun org-latex-inline-src-block (inline-src-block contents info)
+(defun org-latex-inline-src-block (inline-src-block _contents info)
"Transcode an INLINE-SRC-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((code (org-element-property :value inline-src-block))
(separator (org-latex--find-verb-separator code)))
- (case (plist-get info :latex-listings)
+ (cl-case (plist-get info :latex-listings)
;; Do not use a special package: transcode it verbatim.
((nil) (format "\\texttt{%s}" (org-latex--protect-text code)))
;; Use minted package.
@@ -1919,10 +2049,10 @@ contextual information."
(downcase org-lang)))
(options (org-latex--make-option-string
(plist-get info :latex-minted-options))))
- (concat (format "\\mint%s{%s}"
- (if (string= options "") "" (format "[%s]" options))
- mint-lang)
- separator code separator)))
+ (format "\\mintinline%s{%s}{%s}"
+ (if (string= options "") "" (format "[%s]" options))
+ mint-lang
+ code)))
;; Use listings package.
(otherwise
;; Maybe translate language's name.
@@ -1957,7 +2087,7 @@ holding contextual information."
todo todo-type priority title tags contents info)))
(defun org-latex-format-inlinetask-default-function
- (todo todo-type priority title tags contents info)
+ (todo _todo-type priority title tags contents info)
"Default format function for a inlinetasks.
See `org-latex-format-inlinetask-function' for details."
(let ((full-title
@@ -1982,7 +2112,7 @@ See `org-latex-format-inlinetask-function' for details."
;;;; Italic
-(defun org-latex-italic (italic contents info)
+(defun org-latex-italic (_italic contents info)
"Transcode ITALIC from Org to LaTeX.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -2007,14 +2137,14 @@ contextual information."
(when (and (eq (org-element-type parent) 'plain-list)
(eq (org-element-property :type parent)
'ordered))
- (incf level)))
+ (cl-incf level)))
level)))
(and count
(< level 5)
(format "\\setcounter{enum%s}{%s}\n"
(nth (1- level) '("i" "ii" "iii" "iv"))
(1- count)))))
- (checkbox (case (org-element-property :checkbox item)
+ (checkbox (cl-case (org-element-property :checkbox item)
(on "$\\boxtimes$ ")
(off "$\\square$ ")
(trans "$\\boxminus$ ")))
@@ -2033,7 +2163,7 @@ contextual information."
;; unless the brackets comes from an initial export
;; snippet (i.e. it is inserted willingly by the user).
((and contents
- (org-string-match-p "\\`[ \t]*\\[" contents)
+ (string-match-p "\\`[ \t]*\\[" contents)
(not (let ((e (car (org-element-contents item))))
(and (eq (org-element-type e) 'paragraph)
(let ((o (car (org-element-contents e))))
@@ -2054,7 +2184,7 @@ contextual information."
;;;; Keyword
-(defun org-latex-keyword (keyword contents info)
+(defun org-latex-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((key (org-element-property :key keyword))
@@ -2065,8 +2195,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string= key "TOC")
(let ((case-fold-search t))
(cond
- ((org-string-match-p "\\<headlines\\>" value)
- (let* ((localp (org-string-match-p "\\<local\\>" value))
+ ((string-match-p "\\<headlines\\>" value)
+ (let* ((localp (string-match-p "\\<local\\>" value))
(parent (org-element-lineage keyword '(headline)))
(level (if (not (and localp parent)) 0
(org-export-get-relative-level parent info)))
@@ -2082,9 +2212,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
\\printcontents[level-%d]{}{0}{%s}"
level level (or depth ""))
(concat depth (and depth "\n") "\\tableofcontents"))))
- ((org-string-match-p "\\<tables\\>" value) "\\listoftables")
- ((org-string-match-p "\\<listings\\>" value)
- (case (plist-get info :latex-listings)
+ ((string-match-p "\\<tables\\>" value) "\\listoftables")
+ ((string-match-p "\\<listings\\>" value)
+ (cl-case (plist-get info :latex-listings)
((nil) "\\listoffigures")
(minted "\\listoflistings")
(otherwise "\\lstlistoflistings")))))))))
@@ -2092,7 +2222,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Latex Environment
-(defun org-latex-latex-environment (latex-environment contents info)
+(defun org-latex-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (plist-get info :with-latex)
@@ -2112,22 +2242,20 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Latex Fragment
-(defun org-latex-latex-fragment (latex-fragment contents info)
+(defun org-latex-latex-fragment (latex-fragment _contents _info)
"Transcode a LATEX-FRAGMENT object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((value (org-element-property :value latex-fragment)))
;; Trim math markers since the fragment is enclosed within
;; a latex-math-block object anyway.
- (cond ((string-match "\\`\\(\\$\\{1,2\\}\\)\\([^\000]*\\)\\1\\'" value)
- (match-string 2 value))
- ((string-match "\\`\\\\(\\([^\000]*\\)\\\\)\\'" value)
- (match-string 1 value))
+ (cond ((string-match-p "\\`\\$[^$]" value) (substring value 1 -1))
+ ((string-prefix-p "\\(" value) (substring value 2 -2))
(t value))))
;;;; Line Break
-(defun org-latex-line-break (line-break contents info)
+(defun org-latex-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
"\\\\\n")
@@ -2152,13 +2280,12 @@ used as a communication channel."
(cond ((string= float "wrap") 'wrap)
((string= float "sideways") 'sideways)
((string= float "multicolumn") 'multicolumn)
+ ((and (plist-member attr :float) (not float)) 'nonfloat)
((or float
(org-element-property :caption parent)
(org-string-nw-p (plist-get attr :caption)))
- (if (and (plist-member attr :float) (not float))
- 'nonfloat
- 'figure))
- ((and (not float) (plist-member attr :float)) nil))))
+ 'figure)
+ (t 'nonfloat))))
(placement
(let ((place (plist-get attr :placement)))
(cond
@@ -2167,6 +2294,9 @@ used as a communication channel."
((eq float 'figure)
(format "[%s]" (plist-get info :latex-default-figure-position)))
(t ""))))
+ (center
+ (if (plist-member attr :center) (plist-get attr :center)
+ (plist-get info :latex-images-centered)))
(comment-include (if (plist-get attr :comment-include) "%" ""))
;; It is possible to specify width and height in the
;; ATTR_LATEX line, and also via default variables.
@@ -2211,14 +2341,14 @@ used as a communication channel."
(let ((search-option (org-element-property :search-option link)))
(when (and search-option
(equal filetype "pdf")
- (org-string-match-p "\\`[0-9]+\\'" search-option)
- (not (org-string-match-p "page=" options)))
+ (string-match-p "\\`[0-9]+\\'" search-option)
+ (not (string-match-p "page=" options)))
(setq options (concat options ",page=" search-option))))
(setq image-code
(format "\\includegraphics%s{%s}"
(cond ((not (org-string-nw-p options)) "")
- ((= (aref options 0) ?,)
- (format "[%s]"(substring options 1)))
+ ((string-prefix-p "," options)
+ (format "[%s]" (substring options 1)))
(t (format "[%s]" options)))
path))
(when (equal filetype "svg")
@@ -2231,46 +2361,53 @@ used as a communication channel."
image-code
nil t))))
;; Return proper string, depending on FLOAT.
- (case float
- (wrap (format "\\begin{wrapfigure}%s
-%s\\centering
+ (pcase float
+ (`wrap (format "\\begin{wrapfigure}%s
+%s%s
%s%s
%s\\end{wrapfigure}"
- placement
- (if caption-above-p caption "")
- comment-include image-code
- (if caption-above-p "" caption)))
- (sideways (format "\\begin{sidewaysfigure}
-%s\\centering
+ placement
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ (`sideways (format "\\begin{sidewaysfigure}
+%s%s
%s%s
%s\\end{sidewaysfigure}"
- (if caption-above-p caption "")
- comment-include image-code
- (if caption-above-p "" caption)))
- (multicolumn (format "\\begin{figure*}%s
-%s\\centering
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ (`multicolumn (format "\\begin{figure*}%s
+%s%s
%s%s
%s\\end{figure*}"
- placement
- (if caption-above-p caption "")
- comment-include image-code
- (if caption-above-p "" caption)))
- (figure (format "\\begin{figure}%s
-%s\\centering
+ placement
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ (`figure (format "\\begin{figure}%s
+%s%s
%s%s
%s\\end{figure}"
- placement
- (if caption-above-p caption "")
- comment-include image-code
- (if caption-above-p "" caption)))
- (nonfloat
+ placement
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ ((guard center)
(format "\\begin{center}
%s%s
%s\\end{center}"
(if caption-above-p caption "")
image-code
(if caption-above-p "" caption)))
- (otherwise image-code))))
+ (_
+ (concat (if caption-above-p caption "")
+ image-code
+ (if caption-above-p caption ""))))))
(defun org-latex-link (link desc info)
"Transcode a LINK object from Org to LaTeX.
@@ -2309,7 +2446,7 @@ INFO is a plist holding contextual information. See
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
+ (cl-case (org-element-type destination)
;; Id link points to an external file.
(plain-text
(if desc (format "\\href{%s}{%s}" destination desc)
@@ -2353,7 +2490,7 @@ INFO is a plist holding contextual information. See
;;;; Node Property
-(defun org-latex-node-property (node-property contents info)
+(defun org-latex-node-property (node-property _contents _info)
"Transcode a NODE-PROPERTY element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -2365,7 +2502,7 @@ information."
;;;; Paragraph
-(defun org-latex-paragraph (paragraph contents info)
+(defun org-latex-paragraph (_paragraph contents _info)
"Transcode a PARAGRAPH element from Org to LaTeX.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
@@ -2413,7 +2550,7 @@ contextual information."
(replace-regexp-in-string
(concat "[%$#&{}_~^]\\|\\\\" (and specialp "\\([^-]\\|$\\)"))
(lambda (m)
- (case (string-to-char m)
+ (cl-case (string-to-char m)
(?\\ "$\\\\backslash$\\1")
(?~ "\\\\textasciitilde{}")
(?^ "\\\\^{}")
@@ -2436,7 +2573,7 @@ contextual information."
;;;; Planning
-(defun org-latex-planning (planning contents info)
+(defun org-latex-planning (planning _contents info)
"Transcode a PLANNING element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -2470,7 +2607,7 @@ information."
;;;; Property Drawer
-(defun org-latex-property-drawer (property-drawer contents info)
+(defun org-latex-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element from Org to LaTeX.
CONTENTS holds the contents of the drawer. INFO is a plist
holding contextual information."
@@ -2524,24 +2661,28 @@ it."
(org-element-extract-element previous)
(org-element-adopt-elements matrices previous)
(setq previous next))
+ ;; Inherit `:post-blank' from the value of the last
+ ;; swallowed table. Set the latter's `:post-blank'
+ ;; value to 0 so as to not duplicate empty lines.
(org-element-put-property
matrices :post-blank (org-element-property :post-blank previous))
+ (org-element-put-property previous :post-blank 0)
(org-element-extract-element previous)
(org-element-adopt-elements matrices previous))))))
info)
data)
-(defun org-latex-matrices (matrices contents info)
+(defun org-latex-matrices (matrices contents _info)
"Transcode a MATRICES element from Org to LaTeX.
CONTENTS is a string. INFO is a plist used as a communication
channel."
- (format (case (org-element-property :markup matrices)
+ (format (cl-case (org-element-property :markup matrices)
(inline "\\(%s\\)")
(equation "\\begin{equation}\n%s\\end{equation}")
(t "\\[\n%s\\]"))
contents))
-(defun org-latex-matrices-tree-filter (tree backend info)
+(defun org-latex-matrices-tree-filter (tree _backend info)
(org-latex--wrap-latex-matrices tree info))
;;;; Pseudo Object: LaTeX Math Block
@@ -2554,16 +2695,15 @@ channel."
DATA is a parse tree or a secondary string. INFO is a plist
containing export options. Modify DATA by side-effect and return it."
(let ((valid-object-p
- (function
- ;; Non-nil when OBJ can be added to the latex math block.
- (lambda (obj)
- (case (org-element-type obj)
- (entity (org-element-property :latex-math-p obj))
- (latex-fragment
- (let ((value (org-element-property :value obj)))
- (or (org-string-match-p "\\`\\\\([^\000]*\\\\)\\'" value)
- (org-string-match-p "\\`\\$[^\000]*\\$\\'" value))))
- ((subscript superscript) t))))))
+ ;; Non-nil when OBJ can be added to the latex math block.
+ (lambda (obj)
+ (pcase (org-element-type obj)
+ (`entity (org-element-property :latex-math-p obj))
+ (`latex-fragment
+ (let ((value (org-element-property :value obj)))
+ (or (string-prefix-p "\\(" value)
+ (string-match-p "\\`\\$[^$]" value))))
+ ((or `subscript `superscript) t)))))
(org-element-map data '(entity latex-fragment subscript superscript)
(lambda (object)
;; Skip objects already wrapped.
@@ -2598,15 +2738,15 @@ containing export options. Modify DATA by side-effect and return it."
;; Return updated DATA.
data))
-(defun org-latex-math-block-tree-filter (tree backend info)
+(defun org-latex-math-block-tree-filter (tree _backend info)
(org-latex--wrap-latex-math-block tree info))
-(defun org-latex-math-block-options-filter (info backend)
+(defun org-latex-math-block-options-filter (info _backend)
(dolist (prop '(:author :date :title) info)
(plist-put info prop
(org-latex--wrap-latex-math-block (plist-get info prop) info))))
-(defun org-latex-math-block (math-block contents info)
+(defun org-latex-math-block (_math-block contents _info)
"Transcode a MATH-BLOCK object from Org to LaTeX.
CONTENTS is a string. INFO is a plist used as a communication
channel."
@@ -2634,7 +2774,7 @@ contextual information."
;;;; Section
-(defun org-latex-section (section contents info)
+(defun org-latex-section (_section contents _info)
"Transcode a SECTION element from Org to LaTeX.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
@@ -2660,7 +2800,7 @@ holding contextual information."
;;;; Src Block
-(defun org-latex-src-block (src-block contents info)
+(defun org-latex-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
@@ -2672,9 +2812,7 @@ contextual information."
(custom-env (and lang
(cadr (assq (intern lang)
org-latex-custom-lang-environments))))
- (num-start (case (org-element-property :number-lines src-block)
- (continued (org-export-get-loc src-block info))
- (new 0)))
+ (num-start (org-export-get-loc src-block info))
(retain-labels (org-element-property :retain-labels src-block))
(attributes (org-export-read-attribute :attr_latex src-block))
(float (plist-get attributes :float))
@@ -2700,13 +2838,21 @@ contextual information."
(org-export-format-code-default src-block info))))))
;; Case 2. Custom environment.
(custom-env
- (let ((caption-str (org-latex--caption/label-string src-block info)))
- (format "\\begin{%s}\n%s\\end{%s}\n"
- custom-env
- (concat (and caption-above-p caption-str)
- (org-export-format-code-default src-block info)
- (and (not caption-above-p) caption-str))
- custom-env)))
+ (let ((caption-str (org-latex--caption/label-string src-block info))
+ (formatted-src (org-export-format-code-default src-block info)))
+ (if (string-match-p "\\`[a-zA-Z0-9]+\\'" custom-env)
+ (format "\\begin{%s}\n%s\\end{%s}\n"
+ custom-env
+ (concat (and caption-above-p caption-str)
+ formatted-src
+ (and (not caption-above-p) caption-str))
+ custom-env)
+ (format-spec custom-env
+ `((?s . ,formatted-src)
+ (?c . ,caption)
+ (?f . ,float)
+ (?l . ,(org-latex--label src-block info))
+ (?o . ,(or (plist-get attributes :options) "")))))))
;; Case 3. Use minted package.
((eq listings 'minted)
(let* ((caption-str (org-latex--caption/label-string src-block info))
@@ -2749,7 +2895,7 @@ contextual information."
"\n")))))
(org-export-format-code
(car code-info)
- (lambda (loc num ref)
+ (lambda (loc _num ref)
(concat
loc
(when ref
@@ -2792,7 +2938,9 @@ contextual information."
((and float (not (assoc "float" lst-opt)))
`(("float" ,(plist-get info :latex-default-figure-position)))))
`(("language" ,lst-lang))
- (if label `(("label" ,label)) '(("label" " ")))
+ (if label
+ `(("label" ,(org-latex--label src-block info)))
+ '(("label" " ")))
(if caption-str `(("caption" ,caption-str)) '(("caption" " ")))
`(("captionpos" ,(if caption-above-p "t" "b")))
(cond ((assoc "numbers" lst-opt) nil)
@@ -2811,21 +2959,21 @@ contextual information."
(org-split-string (car code-info) "\n")))))
(org-export-format-code
(car code-info)
- (lambda (loc num ref)
+ (lambda (loc _num ref)
(concat
loc
(when ref
;; Ensure references are flushed to the right,
;; separated with 6 spaces from the widest line of
;; code
- (concat (make-string (+ (- max-width (length loc)) 6) ? )
+ (concat (make-string (+ (- max-width (length loc)) 6) ?\s)
(format "(%s)" ref)))))
nil (and retain-labels (cdr code-info))))))))))))
;;;; Statistics Cookie
-(defun org-latex-statistics-cookie (statistics-cookie contents info)
+(defun org-latex-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(replace-regexp-in-string
@@ -2834,7 +2982,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Strike-Through
-(defun org-latex-strike-through (strike-through contents info)
+(defun org-latex-strike-through (_strike-through contents info)
"Transcode STRIKE-THROUGH from Org to LaTeX.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
@@ -2847,12 +2995,11 @@ holding contextual information."
"Transcode a subscript or superscript object.
OBJECT is an Org object. INFO is a plist used as a communication
channel."
- (let ((type (org-element-type object))
- (output ""))
+ (let ((output ""))
(org-element-map (org-element-contents object)
(cons 'plain-text org-element-all-objects)
(lambda (obj)
- (case (org-element-type obj)
+ (cl-case (org-element-type obj)
((entity latex-fragment)
(let ((data (org-trim (org-export-data obj info))))
(string-match
@@ -2880,7 +3027,7 @@ channel."
output
(and (> (length output) 1) "}"))))
-(defun org-latex-subscript (subscript contents info)
+(defun org-latex-subscript (subscript _contents info)
"Transcode a SUBSCRIPT object from Org to LaTeX.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -2889,7 +3036,7 @@ contextual information."
;;;; Superscript
-(defun org-latex-superscript (superscript contents info)
+(defun org-latex-superscript (superscript _contents info)
"Transcode a SUPERSCRIPT object from Org to LaTeX.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -2951,7 +3098,7 @@ a communication channel."
;; Check left border for the first cell only.
(when (and (memq 'left borders) (not align))
(push "|" align))
- (push (case (org-export-table-cell-alignment cell info)
+ (push (cl-case (org-export-table-cell-alignment cell info)
(left "l")
(right "r")
(center "c"))
@@ -3103,7 +3250,7 @@ property."
(let ((n 0) (pos 0))
(while (and (< (length output) pos)
(setq pos (string-match "^\\\\hline\n?" output pos)))
- (incf n)
+ (cl-incf n)
(unless (= n 2) (setq output (replace-match "" nil nil output))))))
(let ((centerp (if (plist-member attr :center) (plist-get attr :center)
(plist-get info :latex-tables-centered))))
@@ -3239,7 +3386,7 @@ a communication channel."
;;;; Target
-(defun org-latex-target (target contents info)
+(defun org-latex-target (target _contents info)
"Transcode a TARGET object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -3248,14 +3395,14 @@ information."
;;;; Timestamp
-(defun org-latex-timestamp (timestamp contents info)
+(defun org-latex-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((value (org-latex-plain-text (org-timestamp-translate timestamp) info)))
(format
(plist-get info
- (case (org-element-property :type timestamp)
+ (cl-case (org-element-property :type timestamp)
((active active-range) :latex-active-timestamp-format)
((inactive inactive-range) :latex-inactive-timestamp-format)
(otherwise :latex-diary-timestamp-format)))
@@ -3264,7 +3411,7 @@ information."
;;;; Underline
-(defun org-latex-underline (underline contents info)
+(defun org-latex-underline (_underline contents info)
"Transcode UNDERLINE from Org to LaTeX.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -3273,7 +3420,7 @@ holding contextual information."
;;;; Verbatim
-(defun org-latex-verbatim (verbatim contents info)
+(defun org-latex-verbatim (verbatim _contents info)
"Transcode a VERBATIM object from Org to LaTeX.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -3344,9 +3491,9 @@ is non-nil."
;;;###autoload
(defun org-latex-convert-region-to-latex ()
- "Assume the current region has org-mode syntax, and convert it to LaTeX.
+ "Assume the current region has Org syntax, and convert it to LaTeX.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an LaTeX buffer and use this
+itemized list in Org syntax in an LaTeX buffer and use this
command to convert it."
(interactive)
(org-export-replace-region-by 'latex))
@@ -3422,74 +3569,59 @@ Return PDF file's name."
"Compile a TeX file.
TEXFILE is the name of the file being compiled. Processing is
-done through the command specified in `org-latex-pdf-process'.
+done through the command specified in `org-latex-pdf-process',
+which see. Output is redirected to \"*Org PDF LaTeX Output*\"
+buffer.
When optional argument SNIPPET is non-nil, TEXFILE is a temporary
file used to preview a LaTeX snippet. In this case, do not
-create a log buffer and do not bother removing log files.
-
-Return PDF file name or an error if it couldn't be produced."
- (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile)))
- (full-name (file-truename texfile))
- (out-dir (file-name-directory texfile))
- ;; Properly set working directory for compilation.
- (default-directory (if (file-name-absolute-p texfile)
- (file-name-directory full-name)
- default-directory))
- (time (current-time))
- warnings)
- (unless snippet (message "Processing LaTeX file %s..." texfile))
- (save-window-excursion
- (cond
- ;; A function is provided: Apply it.
- ((functionp org-latex-pdf-process)
- (funcall org-latex-pdf-process (shell-quote-argument texfile)))
- ;; A list is provided: Replace %b, %f and %o with appropriate
- ;; values in each command before applying it. Output is
- ;; redirected to "*Org PDF LaTeX Output*" buffer.
- ((consp org-latex-pdf-process)
- (let ((outbuf (and (not snippet)
- (get-buffer-create "*Org PDF LaTeX Output*"))))
- (dolist (command org-latex-pdf-process)
- (shell-command
- (replace-regexp-in-string
- "%b" (shell-quote-argument base-name)
- (replace-regexp-in-string
- "%f" (shell-quote-argument full-name)
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-dir) command t t) t t) t t)
- outbuf))
- ;; Collect standard errors from output buffer.
- (setq warnings (and (not snippet)
- (org-latex--collect-warnings outbuf)))))
- (t (error "No valid command to process to PDF")))
- (let ((pdffile (concat out-dir base-name ".pdf")))
- ;; Check for process failure. Provide collected errors if
- ;; possible.
- (if (or (not (file-exists-p pdffile))
- ;; Only compare times up to whole seconds as some filesystems
- ;; (e.g. HFS+) do not retain any finer granularity.
- (time-less-p (org-sublist (nth 5 (file-attributes pdffile)) 1 2)
- (org-sublist time 1 2)))
- (error (format "PDF file %s wasn't produced" pdffile))
- ;; Else remove log files, when specified, and signal end of
- ;; process to user, along with any error encountered.
- (unless snippet
- (when org-latex-remove-logfiles
- (dolist (file (directory-files
- out-dir t
- (concat (regexp-quote base-name)
- "\\(?:\\.[0-9]+\\)?"
- "\\."
- (regexp-opt org-latex-logfiles-extensions))))
- (delete-file file)))
- (message (concat "PDF file produced"
- (cond
- ((eq warnings 'error) " with errors.")
- (warnings (concat " with warnings: " warnings))
- (t "."))))))
- ;; Return output file name.
- pdffile))))
+create a log buffer and do not remove log files.
+
+Return PDF file name or raise an error if it couldn't be
+produced."
+ (unless snippet (message "Processing LaTeX file %s..." texfile))
+ (let* ((compiler
+ (or (with-temp-buffer
+ (save-excursion (insert-file-contents texfile))
+ (and (search-forward-regexp (regexp-opt org-latex-compilers)
+ (line-end-position 2)
+ t)
+ (progn (beginning-of-line) (looking-at-p "%"))
+ (match-string 0)))
+ "pdflatex"))
+ (process (if (functionp org-latex-pdf-process) org-latex-pdf-process
+ ;; Replace "%latex" and "%bibtex" with,
+ ;; respectively, "%L" and "%B" so as to adhere to
+ ;; `format-spec' specifications.
+ (mapcar (lambda (command)
+ (replace-regexp-in-string
+ "%\\(?:bib\\|la\\)tex\\>"
+ (lambda (m) (upcase (substring m 0 2)))
+ command))
+ org-latex-pdf-process)))
+ (spec `((?B . ,(shell-quote-argument org-latex-bib-compiler))
+ (?L . ,(shell-quote-argument compiler))))
+ (log-buf-name "*Org PDF LaTeX Output*")
+ (log-buf (and (not snippet) (get-buffer-create log-buf-name)))
+ (outfile (org-compile-file texfile process "pdf"
+ (format "See %S for details" log-buf-name)
+ log-buf spec)))
+ (unless snippet
+ (when org-latex-remove-logfiles
+ (mapc #'delete-file
+ (directory-files
+ (file-name-directory texfile) t
+ (concat (regexp-quote (file-name-base outfile))
+ "\\(?:\\.[0-9]+\\)?\\."
+ (regexp-opt org-latex-logfiles-extensions)))))
+ (let ((warnings (org-latex--collect-warnings log-buf)))
+ (message (concat "PDF file produced"
+ (cond
+ ((eq warnings 'error) " with errors.")
+ (warnings (concat " with warnings: " warnings))
+ (t "."))))))
+ ;; Return output file name.
+ outfile))
(defun org-latex--collect-warnings (buffer)
"Collect some warnings from \"pdflatex\" command output.
diff --git a/lisp/ox-man.el b/lisp/ox-man.el
index df744e8..4e2bfc7 100644
--- a/lisp/ox-man.el
+++ b/lisp/ox-man.el
@@ -1,4 +1,4 @@
-;; ox-man.el --- Man Back-End for Org Export Engine
+;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
@@ -29,18 +29,17 @@
;;
;; M-: (org-export-to-buffer 'man "*Test Man*") RET
;;
-;; in an org-mode buffer then switch to the buffer to see the Man
-;; export. See ox.el for more details on how this exporter works.
+;; in an Org buffer then switch to the buffer to see the Man export.
+;; See ox.el for more details on how this exporter works.
;;
;; It introduces one new buffer keywords:
;; "MAN_CLASS_OPTIONS".
;;; Code:
+(require 'cl-lib)
(require 'ox)
-(eval-when-compile (require 'cl))
-
(defvar org-export-man-default-packages-alist)
(defvar org-export-man-packages-alist)
(defvar orgtbl-exp-regexp)
@@ -53,7 +52,6 @@
'((babel-call . org-man-babel-call)
(bold . org-man-bold)
(center-block . org-man-center-block)
- (clock . org-man-clock)
(code . org-man-code)
(drawer . org-man-drawer)
(dynamic-block . org-man-dynamic-block)
@@ -98,7 +96,6 @@
(underline . org-man-underline)
(verbatim . org-man-verbatim)
(verse-block . org-man-verse-block))
- :export-block "MAN"
:menu-entry
'(?M "Export to MAN"
((?m "As MAN file" org-man-export-to-man)
@@ -203,21 +200,6 @@ in this list - but it does not hurt if it is present."
(string :tag "Listings language"))))
-
-(defvar org-man-custom-lang-environments nil
- "Alist mapping languages to language-specific Man environments.
-
-It is used during export of src blocks by the listings and
-man packages. For example,
-
- (setq org-man-custom-lang-environments
- '((python \"pythoncode\")))
-
-would have the effect that if org encounters begin_src python
-during man export."
-)
-
-
;;; Compilation
(defcustom org-man-pdf-process
@@ -343,7 +325,7 @@ holding export options."
;;; Bold
-(defun org-man-bold (bold contents info)
+(defun org-man-bold (_bold contents _info)
"Transcode BOLD from Org to Man.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -352,7 +334,7 @@ contextual information."
;;; Center Block
-(defun org-man-center-block (center-block contents info)
+(defun org-man-center-block (center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to Man.
CONTENTS holds the contents of the center block. INFO is a plist
holding contextual information."
@@ -363,37 +345,18 @@ holding contextual information."
contents)))
-;;; Clock
-
-(defun org-man-clock (clock contents info)
- "Transcode a CLOCK element from Org to Man.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- "" )
-
-
;;; Code
-(defun org-man-code (code contents info)
+(defun org-man-code (code _contents _info)
"Transcode a CODE object from Org to Man.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(format "\\fC%s\\fP" code))
-;;; Comment
-;;
-;; Comments are ignored.
-
-
-;;; Comment Block
-;;
-;; Comment Blocks are ignored.
-
-
;;; Drawer
-(defun org-man-drawer (drawer contents info)
+(defun org-man-drawer (_drawer contents _info)
"Transcode a DRAWER element from Org to Man.
DRAWER holds the drawer information
CONTENTS holds the contents of the block.
@@ -403,7 +366,7 @@ channel."
;;; Dynamic Block
-(defun org-man-dynamic-block (dynamic-block contents info)
+(defun org-man-dynamic-block (dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to Man.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
@@ -412,7 +375,7 @@ holding contextual information. See `org-export-data'."
;;; Entity
-(defun org-man-entity (entity contents info)
+(defun org-man-entity (entity _contents _info)
"Transcode an ENTITY object from Org to Man.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -421,7 +384,7 @@ contextual information."
;;; Example Block
-(defun org-man-example-block (example-block contents info)
+(defun org-man-example-block (example-block _contents info)
"Transcode an EXAMPLE-BLOCK element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -433,7 +396,7 @@ information."
;;; Export Block
-(defun org-man-export-block (export-block contents info)
+(defun org-man-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "MAN")
@@ -442,7 +405,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Export Snippet
-(defun org-man-export-snippet (export-snippet contents info)
+(defun org-man-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'man)
@@ -451,7 +414,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Fixed Width
-(defun org-man-fixed-width (fixed-width contents info)
+(defun org-man-fixed-width (fixed-width _contents _info)
"Transcode a FIXED-WIDTH element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-man--wrap-label
@@ -477,16 +440,15 @@ CONTENTS is nil. INFO is a plist holding contextual information."
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
(let* ((level (org-export-get-relative-level headline info))
- (numberedp (org-export-numbered-headline-p headline info))
- ;; Section formatting will set two placeholders: one for the
- ;; title and the other for the contents.
- (section-fmt
- (case level
- (1 ".SH \"%s\"\n%s")
- (2 ".SS \"%s\"\n%s")
- (3 ".SS \"%s\"\n%s")
- (t nil)))
- (text (org-export-data (org-element-property :title headline) info)))
+ ;; Section formatting will set two placeholders: one for the
+ ;; title and the other for the contents.
+ (section-fmt
+ (pcase level
+ (1 ".SH \"%s\"\n%s")
+ (2 ".SS \"%s\"\n%s")
+ (3 ".SS \"%s\"\n%s")
+ (_ nil)))
+ (text (org-export-data (org-element-property :title headline) info)))
(cond
;; Case 1: This is a footnote section: ignore it.
@@ -498,20 +460,20 @@ holding contextual information."
((or (not section-fmt) (org-export-low-level-p headline info))
;; Build the real contents of the sub-tree.
(let ((low-level-body
- (concat
- ;; If the headline is the first sibling, start a list.
- (when (org-export-first-sibling-p headline info)
- (format "%s\n" ".RS"))
- ;; Itemize headline
- ".TP\n.ft I\n" text "\n.ft\n"
- contents ".RE")))
- ;; If headline is not the last sibling simply return
- ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
- ;; blank line.
- (if (not (org-export-last-sibling-p headline info)) low-level-body
- (replace-regexp-in-string
- "[ \t\n]*\\'" ""
- low-level-body))))
+ (concat
+ ;; If the headline is the first sibling, start a list.
+ (when (org-export-first-sibling-p headline info)
+ (format "%s\n" ".RS"))
+ ;; Itemize headline
+ ".TP\n.ft I\n" text "\n.ft\n"
+ contents ".RE")))
+ ;; If headline is not the last sibling simply return
+ ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
+ ;; blank line.
+ (if (not (org-export-last-sibling-p headline info)) low-level-body
+ (replace-regexp-in-string
+ "[ \t\n]*\\'" ""
+ low-level-body))))
;; Case 3. Standard headline. Export it as a section.
(t (format section-fmt text contents )))))
@@ -525,16 +487,14 @@ holding contextual information."
;;; Inline Src Block
-(defun org-man-inline-src-block (inline-src-block contents info)
+(defun org-man-inline-src-block (inline-src-block _contents info)
"Transcode an INLINE-SRC-BLOCK element from Org to Man.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((code (org-element-property :value inline-src-block)))
(cond
((plist-get info :man-source-highlight)
- (let* ((tmpdir (if (featurep 'xemacs)
- temp-directory
- temporary-file-directory ))
+ (let* ((tmpdir temporary-file-directory)
(in-file (make-temp-name
(expand-file-name "srchilite" tmpdir)))
(out-file (make-temp-name
@@ -570,7 +530,7 @@ contextual information."
;;; Inlinetask
;;; Italic
-(defun org-man-italic (italic contents info)
+(defun org-man-italic (_italic contents _info)
"Transcode ITALIC from Org to Man.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -581,17 +541,15 @@ contextual information."
(defun org-man-item (item contents info)
-
"Transcode an ITEM element from Org to Man.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
-
(let* ((bullet (org-element-property :bullet item))
(type (org-element-property :type (org-element-property :parent item)))
- (checkbox (case (org-element-property :checkbox item)
- (on "\\o'\\(sq\\(mu'") ;;
- (off "\\(sq ") ;;
- (trans "\\o'\\(sq\\(mi'" ))) ;;
+ (checkbox (pcase (org-element-property :checkbox item)
+ (`on "\\o'\\(sq\\(mu'")
+ (`off "\\(sq ")
+ (`trans "\\o'\\(sq\\(mi'")))
(tag (let ((tag (org-element-property :tag item)))
;; Check-boxes must belong to the tag.
@@ -599,24 +557,22 @@ contextual information."
(concat checkbox
(org-export-data tag info)))))))
- (if (and (null tag )
- (null checkbox))
- (let* ((bullet (org-trim bullet))
- (marker (cond ((string= "-" bullet) "\\(em")
- ((string= "*" bullet) "\\(bu")
- ((eq type 'ordered)
- (format "%s " (org-trim bullet)))
- (t "\\(dg"))))
- (concat ".IP " marker " 4\n"
- (org-trim (or contents " " ))))
- ; else
+ (if (and (null tag) (null checkbox))
+ (let* ((bullet (org-trim bullet))
+ (marker (cond ((string= "-" bullet) "\\(em")
+ ((string= "*" bullet) "\\(bu")
+ ((eq type 'ordered)
+ (format "%s " (org-trim bullet)))
+ (t "\\(dg"))))
+ (concat ".IP " marker " 4\n"
+ (org-trim (or contents " " ))))
(concat ".TP\n" (or tag (concat " " checkbox)) "\n"
(org-trim (or contents " " ))))))
;;; Keyword
-(defun org-man-keyword (keyword contents info)
+(defun org-man-keyword (keyword _contents _info)
"Transcode a KEYWORD element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((key (org-element-property :key keyword))
@@ -629,7 +585,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Line Break
-(defun org-man-line-break (line-break contents info)
+(defun org-man-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
".br\n")
@@ -638,7 +594,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Link
-(defun org-man-link (link desc info)
+(defun org-man-link (link desc _info)
"Transcode a LINK object from Org to Man.
DESC is the description part of the link, or the empty string.
@@ -652,8 +608,7 @@ INFO is a plist holding contextual information. See
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
((string= type "file") (org-export-file-uri raw-path))
- (t raw-path)))
- protocol)
+ (t raw-path))))
(cond
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'man))
@@ -666,7 +621,7 @@ INFO is a plist holding contextual information. See
;;;; Node Property
-(defun org-man-node-property (node-property contents info)
+(defun org-man-node-property (node-property _contents _info)
"Transcode a NODE-PROPERTY element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -677,7 +632,7 @@ information."
;;; Paragraph
-(defun org-man-paragraph (paragraph contents info)
+(defun org-man-paragraph (paragraph contents _info)
"Transcode a PARAGRAPH element from Org to Man.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
@@ -698,7 +653,7 @@ the plist used as a communication channel."
;;; Plain List
-(defun org-man-plain-list (plain-list contents info)
+(defun org-man-plain-list (_plain-list contents _info)
"Transcode a PLAIN-LIST element from Org to Man.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
@@ -733,7 +688,7 @@ contextual information."
;;; Property Drawer
-(defun org-man-property-drawer (property-drawer contents info)
+(defun org-man-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element from Org to Man.
CONTENTS holds the contents of the drawer. INFO is a plist
holding contextual information."
@@ -742,7 +697,7 @@ holding contextual information."
;;; Quote Block
-(defun org-man-quote-block (quote-block contents info)
+(defun org-man-quote-block (quote-block contents _info)
"Transcode a QUOTE-BLOCK element from Org to Man.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -753,16 +708,16 @@ holding contextual information."
;;; Radio Target
-(defun org-man-radio-target (radio-target text info)
+(defun org-man-radio-target (_radio-target text _info)
"Transcode a RADIO-TARGET object from Org to Man.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- text )
+ text)
;;; Section
-(defun org-man-section (section contents info)
+(defun org-man-section (_section contents _info)
"Transcode a SECTION element from Org to Man.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
@@ -771,61 +726,49 @@ holding contextual information."
;;; Special Block
-(defun org-man-special-block (special-block contents info)
+(defun org-man-special-block (special-block contents _info)
"Transcode a SPECIAL-BLOCK element from Org to Man.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let ((type (org-element-property :type special-block)))
- (org-man--wrap-label
- special-block
- (format "%s\n" contents))))
+ (org-man--wrap-label special-block (format "%s\n" contents)))
;;; Src Block
-(defun org-man-src-block (src-block contents info)
+(defun org-man-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to Man.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((lang (org-element-property :language src-block))
- (code (org-element-property :value src-block))
- (custom-env (and lang
- (cadr (assq (intern lang)
- org-man-custom-lang-environments))))
- (num-start (case (org-element-property :number-lines src-block)
- (continued (org-export-get-loc src-block info))
- (new 0)))
- (retain-labels (org-element-property :retain-labels src-block)))
- (if (not (plist-get info :man-source-highlight))
- (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
- (org-export-format-code-default src-block info))
- (let* ((tmpdir (if (featurep 'xemacs) temp-directory
- temporary-file-directory))
- (in-file (make-temp-name (expand-file-name "srchilite" tmpdir)))
- (out-file (make-temp-name (expand-file-name "reshilite" tmpdir)))
- (org-lang (org-element-property :language src-block))
- (lst-lang
- (cadr (assq (intern org-lang)
- (plist-get info :man-source-highlight-langs))))
- (cmd (concat "source-highlight"
- " -s " lst-lang
- " -f groff_man "
- " -i " in-file
- " -o " out-file)))
- (if lst-lang
- (let ((code-block ""))
- (with-temp-file in-file (insert code))
- (shell-command cmd)
- (setq code-block (org-file-contents out-file))
- (delete-file in-file)
- (delete-file out-file)
- code-block)
- (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code))))))
+ (if (not (plist-get info :man-source-highlight))
+ (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
+ (org-export-format-code-default src-block info))
+ (let* ((tmpdir temporary-file-directory)
+ (in-file (make-temp-name (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name (expand-file-name "reshilite" tmpdir)))
+ (code (org-element-property :value src-block))
+ (org-lang (org-element-property :language src-block))
+ (lst-lang
+ (cadr (assq (intern org-lang)
+ (plist-get info :man-source-highlight-langs))))
+ (cmd (concat "source-highlight"
+ " -s " lst-lang
+ " -f groff_man "
+ " -i " in-file
+ " -o " out-file)))
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ code-block)
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))
;;; Statistics Cookie
-(defun org-man-statistics-cookie (statistics-cookie contents info)
+(defun org-man-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-element-property :value statistics-cookie))
@@ -833,7 +776,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Strike-Through
-(defun org-man-strike-through (strike-through contents info)
+(defun org-man-strike-through (_strike-through contents _info)
"Transcode STRIKE-THROUGH from Org to Man.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
@@ -841,7 +784,7 @@ holding contextual information."
;;; Subscript
-(defun org-man-subscript (subscript contents info)
+(defun org-man-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to Man.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -849,7 +792,7 @@ contextual information."
;;; Superscript "^_%s$
-(defun org-man-superscript (superscript contents info)
+(defun org-man-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to Man.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -912,14 +855,14 @@ a communication channel."
(when (and (memq 'left borders) (not alignment))
(push "|" alignment))
(push
- (case (org-export-table-cell-alignment cell info)
- (left (concat "l" width divider))
- (right (concat "r" width divider))
- (center (concat "c" width divider)))
+ (concat (pcase (org-export-table-cell-alignment cell info)
+ (`left "l") (`right "r") (`center "c"))
+ width
+ divider)
alignment)
(when (memq 'right borders) (push "|" alignment))))
info)
- (apply 'concat (reverse alignment))))
+ (apply #'concat (reverse alignment))))
(defun org-man-table--org-table (table contents info)
"Return appropriate Man code for an Org table.
@@ -930,7 +873,6 @@ channel.
This function assumes TABLE has `org' as its `:type' attribute."
(let* ((attr (org-export-read-attribute :attr_man table))
- (label (org-element-property :name table))
(caption (and (not (plist-get attr :disable-caption))
(org-man--caption/label-string table info)))
(divider (if (plist-get attr :divider) "|" " "))
@@ -976,14 +918,14 @@ This function assumes TABLE has `org' as its `:type' attribute."
(format "%s.\n"
(let ((final-line ""))
(when title-line
- (dotimes (i (length first-line))
+ (dotimes (_ (length first-line))
(setq final-line (concat final-line "cb" divider))))
(setq final-line (concat final-line "\n"))
(if alignment
(setq final-line (concat final-line alignment))
- (dotimes (i (length first-line))
+ (dotimes (_ (length first-line))
(setq final-line (concat final-line "c" divider))))
final-line ))
@@ -1040,35 +982,26 @@ a communication channel."
;;; Table Row
(defun org-man-table-row (table-row contents info)
- "Transcode a TABLE-ROW element from Org to Man
+ "Transcode a TABLE-ROW element from Org to Man.
CONTENTS is the contents of the row. INFO is a plist used as
a communication channel."
- ;; Rules are ignored since table separators are deduced from
- ;; borders of the current row.
+ ;; Rules are ignored since table separators are deduced from borders
+ ;; of the current row.
(when (eq (org-element-property :type table-row) 'standard)
- (let* ((attr (mapconcat 'identity
- (org-element-property
- :attr_man (org-export-get-parent table-row))
- " "))
- ;; TABLE-ROW's borders are extracted from its first cell.
- (borders
- (org-export-table-cell-borders
- (car (org-element-contents table-row)) info)))
+ (let ((borders
+ ;; TABLE-ROW's borders are extracted from its first cell.
+ (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
(concat
- ;; Mark horizontal lines
- (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
+ (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
contents
-
- (cond
- ;; When BOOKTABS are activated enforce bottom rule even when
- ;; no hline was specifically marked.
- ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
- ((memq 'below borders) "\n_"))))))
+ (cond ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
+ ((memq 'below borders) "\n_"))))))
;;; Target
-(defun org-man-target (target contents info)
+(defun org-man-target (target _contents info)
"Transcode a TARGET object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1077,16 +1010,15 @@ information."
;;; Timestamp
-(defun org-man-timestamp (timestamp contents info)
+(defun org-man-timestamp (_timestamp _contents _info)
"Transcode a TIMESTAMP object from Org to Man.
- CONTENTS is nil. INFO is a plist holding contextual
- information."
- "" )
+ONTENTS is nil. INFO is a plist holding contextual information."
+ "")
;;; Underline
-(defun org-man-underline (underline contents info)
+(defun org-man-underline (_underline contents _info)
"Transcode UNDERLINE from Org to Man.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -1095,7 +1027,7 @@ holding contextual information."
;;; Verbatim
-(defun org-man-verbatim (verbatim contents info)
+(defun org-man-verbatim (_verbatim contents _info)
"Transcode a VERBATIM object from Org to Man.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -1104,7 +1036,7 @@ channel."
;;; Verse Block
-(defun org-man-verse-block (verse-block contents info)
+(defun org-man-verse-block (_verse-block contents _info)
"Transcode a VERSE-BLOCK element from Org to Man.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
@@ -1188,68 +1120,15 @@ FILE is the name of the file being compiled. Processing is done
through the command specified in `org-man-pdf-process'.
Return PDF file name or an error if it couldn't be produced."
- (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
- (full-name (file-truename file))
- (out-dir (file-name-directory file))
- ;; Properly set working directory for compilation.
- (default-directory (if (file-name-absolute-p file)
- (file-name-directory full-name)
- default-directory))
- errors)
- (message "Processing Groff file %s..." file)
- (save-window-excursion
- (cond
- ;; A function is provided: Apply it.
- ((functionp org-man-pdf-process)
- (funcall org-man-pdf-process (shell-quote-argument file)))
- ;; A list is provided: Replace %b, %f and %o with appropriate
- ;; values in each command before applying it. Output is
- ;; redirected to "*Org PDF Groff Output*" buffer.
- ((consp org-man-pdf-process)
- (let ((outbuf (get-buffer-create "*Org PDF Groff Output*")))
- (mapc
- (lambda (command)
- (shell-command
- (replace-regexp-in-string
- "%b" (shell-quote-argument base-name)
- (replace-regexp-in-string
- "%f" (shell-quote-argument full-name)
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-dir) command t t) t t) t t)
- outbuf))
- org-man-pdf-process)
- ;; Collect standard errors from output buffer.
- (setq errors (org-man-collect-errors outbuf))))
- (t (error "No valid command to process to PDF")))
- (let ((pdffile (concat out-dir base-name ".pdf")))
- ;; Check for process failure. Provide collected errors if
- ;; possible.
- (if (not (file-exists-p pdffile))
- (error "PDF file %s wasn't produced%s" pdffile
- (if errors (concat ": " errors) ""))
- ;; Else remove log files, when specified, and signal end of
- ;; process to user, along with any error encountered.
- (when org-man-remove-logfiles
- (dolist (ext org-man-logfiles-extensions)
- (let ((file (concat out-dir base-name "." ext)))
- (when (file-exists-p file) (delete-file file)))))
- (message (concat "Process completed"
- (if (not errors) "."
- (concat " with errors: " errors)))))
- ;; Return output file name.
- pdffile))))
-
-(defun org-man-collect-errors (buffer)
- "Collect some kind of errors from \"groff\" output
-BUFFER is the buffer containing output.
-Return collected error types as a string, or nil if there was
-none."
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-max))
- ;; Find final run
- nil )))
-
+ (message "Processing Groff file %s..." file)
+ (let ((output (org-compile-file file org-man-pdf-process "pdf")))
+ (when org-man-remove-logfiles
+ (let ((base (file-name-sans-extension output)))
+ (dolist (ext org-man-logfiles-extensions)
+ (let ((file (concat base "." ext)))
+ (when (file-exists-p file) (delete-file file))))))
+ (message "Process completed.")
+ output))
(provide 'ox-man)
diff --git a/lisp/ox-md.el b/lisp/ox-md.el
index 0aaade6..b8c4704 100644
--- a/lisp/ox-md.el
+++ b/lisp/ox-md.el
@@ -1,4 +1,4 @@
-;;; ox-md.el --- Markdown Back-End for Org Export Engine
+;;; ox-md.el --- Markdown Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@@ -28,7 +28,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox-html)
(require 'ox-publish)
@@ -51,11 +51,29 @@ This variable can be set to either `atx' or `setext'."
(const :tag "Use \"Setext\" style" setext)))
+;;;; Footnotes
+
+(defcustom org-md-footnotes-section "%s%s"
+ "Format string for the footnotes section.
+The first %s placeholder will be replaced with the localized Footnotes section
+heading, the second with the contents of the Footnotes section."
+ :group 'org-export-md
+ :type 'string
+ :version "25.2"
+ :package-version '(Org . "9.0"))
+
+(defcustom org-md-footnote-format "<sup>%s</sup>"
+ "Format string for the footnote reference.
+The %s will be replaced by the footnote reference itself."
+ :group 'org-export-md
+ :type 'string
+ :version "25.2"
+ :package-version '(Org . "9.0"))
+
;;; Define Back-End
(org-export-define-derived-backend 'md 'html
- :export-block '("MD" "MARKDOWN")
:filters-alist '((:filter-parse-tree . org-md-separate-elements))
:menu-entry
'(?m "Export to Markdown"
@@ -90,12 +108,15 @@ This variable can be set to either `atx' or `setext'."
(src-block . org-md-example-block)
(template . org-md-template)
(verbatim . org-md-verbatim))
- :options-alist '((:md-headline-style nil nil org-md-headline-style)))
+ :options-alist
+ '((:md-footnote-format nil nil org-md-footnote-format)
+ (:md-footnotes-section nil nil org-md-footnotes-section)
+ (:md-headline-style nil nil org-md-headline-style)))
;;; Filters
-(defun org-md-separate-elements (tree backend info)
+(defun org-md-separate-elements (tree _backend info)
"Fix blank lines between elements.
TREE is the parse tree being exported. BACKEND is the export
@@ -132,7 +153,7 @@ Assume BACKEND is `md'."
;;;; Bold
-(defun org-md-bold (bold contents info)
+(defun org-md-bold (_bold contents _info)
"Transcode BOLD object into Markdown format.
CONTENTS is the text within bold markup. INFO is a plist used as
a communication channel."
@@ -141,14 +162,14 @@ a communication channel."
;;;; Code and Verbatim
-(defun org-md-verbatim (verbatim contents info)
+(defun org-md-verbatim (verbatim _contents _info)
"Transcode VERBATIM object into Markdown format.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(let ((value (org-element-property :value verbatim)))
(format (cond ((not (string-match "`" value)) "`%s`")
- ((or (string-match "\\``" value)
- (string-match "`\\'" value))
+ ((or (string-prefix-p "`" value)
+ (string-suffix-p "`" value))
"`` %s ``")
(t "``%s``"))
value)))
@@ -156,7 +177,7 @@ channel."
;;;; Example Block, Src Block and export Block
-(defun org-md-example-block (example-block contents info)
+(defun org-md-example-block (example-block _contents info)
"Transcode EXAMPLE-BLOCK element into Markdown format.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -216,24 +237,33 @@ a communication channel."
(car (last (org-export-get-headline-number
headline info))))
"."))))
- (concat bullet (make-string (- 4 (length bullet)) ?\s) heading tags
- "\n\n"
- (and contents
- (replace-regexp-in-string "^" " " contents)))))
- ;; Use "Setext" style.
- ((eq style 'setext)
- (concat heading tags anchor "\n"
- (make-string (length heading) (if (= level 1) ?= ?-))
- "\n\n"
- contents))
- ;; Use "atx" style.
- (t (concat (make-string level ?#) " " heading tags anchor "\n\n"
- contents))))))
-
+ (concat bullet (make-string (- 4 (length bullet)) ?\s) heading tags "\n\n"
+ (and contents (replace-regexp-in-string "^" " " contents)))))
+ (t (concat (org-md--headline-title style level title anchor tags) contents))))))
+
+
+;; Headline Title
+
+(defun org-md--headline-title (style level title &optional anchor tags)
+ "Generate a headline title in the preferred Markdown headline style.
+STYLE is the preferred style (`atx' or `setext'). LEVEL is the
+header level. TITLE is the headline title. ANCHOR is the HTML
+anchor tag for the section as a string. TAGS are the tags set on
+the section."
+ (let ((anchor-lines (and anchor (concat anchor "\n\n"))))
+ ;; Use "Setext" style
+ (if (and (eq style 'setext) (< level 3))
+ (let* ((underline-char (if (= level 1) ?= ?-))
+ (underline (concat (make-string (length title) underline-char)
+ "\n")))
+ (concat "\n" anchor-lines title tags "\n" underline "\n"))
+ ;; Use "Atx" style
+ (let ((level-mark (make-string level ?#)))
+ (concat "\n" anchor-lines level-mark " " title tags "\n\n")))))
;;;; Horizontal Rule
-(defun org-md-horizontal-rule (horizontal-rule contents info)
+(defun org-md-horizontal-rule (_horizontal-rule _contents _info)
"Transcode HORIZONTAL-RULE element into Markdown format.
CONTENTS is the horizontal rule contents. INFO is a plist used
as a communication channel."
@@ -242,7 +272,7 @@ as a communication channel."
;;;; Italic
-(defun org-md-italic (italic contents info)
+(defun org-md-italic (_italic contents _info)
"Transcode ITALIC object into Markdown format.
CONTENTS is the text within italic markup. INFO is a plist used
as a communication channel."
@@ -267,10 +297,10 @@ a communication channel."
"."))))
(concat bullet
(make-string (- 4 (length bullet)) ? )
- (case (org-element-property :checkbox item)
- (on "[X] ")
- (trans "[-] ")
- (off "[ ] "))
+ (pcase (org-element-property :checkbox item)
+ (`on "[X] ")
+ (`trans "[-] ")
+ (`off "[ ] "))
(let ((tag (org-element-property :tag item)))
(and tag (format "**%s:** "(org-export-data tag info))))
(and contents
@@ -291,7 +321,7 @@ channel."
;;;; Line Break
-(defun org-md-line-break (line-break contents info)
+(defun org-md-line-break (_line-break _contents _info)
"Transcode LINE-BREAK object into Markdown format.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -318,12 +348,12 @@ a communication channel."
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
- (plain-text ; External file.
+ (pcase (org-element-type destination)
+ (`plain-text ; External file.
(let ((path (funcall link-org-files-as-md destination)))
(if (not contents) (format "<%s>" path)
(format "[%s](%s)" contents path))))
- (headline
+ (`headline
(format
"[%s](#%s)"
;; Description.
@@ -337,7 +367,7 @@ a communication channel."
;; Reference.
(or (org-element-property :CUSTOM_ID destination)
(org-export-get-reference destination info))))
- (t
+ (_
(let ((description
(or (org-string-nw-p contents)
(let ((number (org-export-get-ordinal destination info)))
@@ -378,7 +408,7 @@ a communication channel."
;;;; Node Property
-(defun org-md-node-property (node-property contents info)
+(defun org-md-node-property (node-property _contents _info)
"Transcode a NODE-PROPERTY element into Markdown syntax.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -390,20 +420,20 @@ information."
;;;; Paragraph
-(defun org-md-paragraph (paragraph contents info)
+(defun org-md-paragraph (paragraph contents _info)
"Transcode PARAGRAPH element into Markdown format.
CONTENTS is the paragraph contents. INFO is a plist used as
a communication channel."
(let ((first-object (car (org-element-contents paragraph))))
;; If paragraph starts with a #, protect it.
- (if (and (stringp first-object) (string-match "\\`#" first-object))
- (replace-regexp-in-string "\\`#" "\\#" contents nil t)
+ (if (and (stringp first-object) (string-prefix-p "#" first-object))
+ (concat "\\" contents)
contents)))
;;;; Plain List
-(defun org-md-plain-list (plain-list contents info)
+(defun org-md-plain-list (_plain-list contents _info)
"Transcode PLAIN-LIST element into Markdown format.
CONTENTS is the plain-list contents. INFO is a plist used as
a communication channel."
@@ -438,7 +468,7 @@ contextual information."
;;;; Property Drawer
-(defun org-md-property-drawer (property-drawer contents info)
+(defun org-md-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element into Markdown format.
CONTENTS holds the contents of the drawer. INFO is a plist
holding contextual information."
@@ -448,7 +478,7 @@ holding contextual information."
;;;; Quote Block
-(defun org-md-quote-block (quote-block contents info)
+(defun org-md-quote-block (_quote-block contents _info)
"Transcode QUOTE-BLOCK element into Markdown format.
CONTENTS is the quote-block contents. INFO is a plist used as
a communication channel."
@@ -459,7 +489,7 @@ a communication channel."
;;;; Section
-(defun org-md-section (section contents info)
+(defun org-md-section (_section contents _info)
"Transcode SECTION element into Markdown format.
CONTENTS is the section contents. INFO is a plist used as
a communication channel."
@@ -468,15 +498,50 @@ a communication channel."
;;;; Template
+(defun org-md--footnote-formatted (footnote info)
+ "Formats a single footnote entry FOOTNOTE.
+FOOTNOTE is a cons cell of the form (number . definition).
+INFO is a plist with contextual information."
+ (let* ((fn-num (car footnote))
+ (fn-text (cdr footnote))
+ (fn-format (plist-get info :md-footnote-format))
+ (fn-anchor (format "fn.%d" fn-num))
+ (fn-href (format " href=\"#fnr.%d\"" fn-num))
+ (fn-link-to-ref (org-html--anchor fn-anchor fn-num fn-href info)))
+ (concat (format fn-format fn-link-to-ref) " " fn-text "\n")))
+
+(defun org-md--footnote-section (info)
+ "Format the footnote section.
+INFO is a plist used as a communication channel."
+ (let* ((fn-alist (org-export-collect-footnote-definitions info))
+ (fn-alist (cl-loop for (n _type raw) in fn-alist collect
+ (cons n (org-trim (org-export-data raw info)))))
+ (headline-style (plist-get info :md-headline-style))
+ (section-title (org-html--translate "Footnotes" info)))
+ (when fn-alist
+ (format (plist-get info :md-footnotes-section)
+ (org-md--headline-title headline-style 1 section-title)
+ (mapconcat (lambda (fn) (org-md--footnote-formatted fn info))
+ fn-alist
+ "\n")))))
+
(defun org-md-inner-template (contents info)
"Return body of document after converting it to Markdown syntax.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
;; Make sure CONTENTS is separated from table of contents and
;; footnotes with at least a blank line.
- (org-trim (org-html-inner-template (concat "\n" contents "\n") info)))
-
-(defun org-md-template (contents info)
+ (concat
+ ;; Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth (org-html-toc depth info)))
+ ;; Document contents.
+ contents
+ "\n"
+ ;; Footnotes section.
+ (org-md--footnote-section info)))
+
+(defun org-md-template (contents _info)
"Return complete document string after Markdown conversion.
CONTENTS is the transcoded contents string. INFO is a plist used
as a communication channel."
@@ -515,9 +580,9 @@ non-nil."
;;;###autoload
(defun org-md-convert-region-to-md ()
- "Assume the current region has org-mode syntax, and convert it to Markdown.
+ "Assume the current region has Org syntax, and convert it to Markdown.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in a Markdown buffer and use
+itemized list in Org syntax in a Markdown buffer and use
this command to convert it."
(interactive)
(org-export-replace-region-by 'md))
diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el
index 9fce5e7..05d86bf 100644
--- a/lisp/ox-odt.el
+++ b/lisp/ox-odt.el
@@ -1,4 +1,4 @@
-;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode
+;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
@@ -25,12 +25,11 @@
;;; Code:
-(eval-when-compile
- (require 'cl)
- (require 'table nil 'noerror))
+(require 'cl-lib)
(require 'format-spec)
(require 'ox)
(require 'org-compat)
+(require 'table nil 'noerror)
;;; Define Back-End
@@ -83,7 +82,6 @@
(underline . org-odt-underline)
(verbatim . org-odt-verbatim)
(verse-block . org-odt-verse-block))
- :export-block "ODT"
:filters-alist '((:filter-parse-tree
. (org-odt--translate-latex-fragments
org-odt--translate-description-lists
@@ -121,7 +119,7 @@
;;; Hooks
-;;; Function Declarations
+;;; Function and Dynamically Scoped Variables Declarations
(declare-function hfy-face-to-style "htmlfontify" (fn))
(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
@@ -129,6 +127,13 @@
(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file))
(declare-function browse-url-file-url "browse-url" (file))
+(defvar nxml-auto-insert-xml-declaration-flag) ; nxml-mode.el
+(defvar archive-zip-extract) ; arc-mode.el
+(defvar hfy-end-span-handler) ; htmlfontify.el
+(defvar hfy-begin-span-handler) ; htmlfontify.el
+(defvar hfy-face-to-css) ; htmlfontify.el
+(defvar hfy-html-quote-map) ; htmlfontify.el
+(defvar hfy-html-quote-regex) ; htmlfontify.el
;;; Internal Variables
@@ -172,7 +177,7 @@ and `org-odt-data-dir'.")
(eval-when-compile
(and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
(expand-file-name "./styles/" org-odt-data-dir)))
- (expand-file-name "../../etc/styles/" org-odt-lib-dir) ; git
+ (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git
(expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
(expand-file-name "./org/" data-directory) ; system
)
@@ -182,23 +187,14 @@ heuristically based on the values of `org-odt-lib-dir' and
`org-odt-data-dir'.")
(defconst org-odt-styles-dir
- (let* ((styles-dir
- (catch 'styles-dir
- (message "Debug (ox-odt): Searching for OpenDocument styles files...")
- (mapc (lambda (styles-dir)
- (when styles-dir
- (message "Debug (ox-odt): Trying %s..." styles-dir)
- (when (and (file-readable-p
- (expand-file-name
- "OrgOdtContentTemplate.xml" styles-dir))
- (file-readable-p
- (expand-file-name
- "OrgOdtStyles.xml" styles-dir)))
- (message "Debug (ox-odt): Using styles under %s"
- styles-dir)
- (throw 'styles-dir styles-dir))))
- org-odt-styles-dir-list)
- nil)))
+ (let ((styles-dir
+ (cl-find-if
+ (lambda (dir)
+ (and dir
+ (file-readable-p
+ (expand-file-name "OrgOdtContentTemplate.xml" dir))
+ (file-readable-p (expand-file-name "OrgOdtStyles.xml" dir))))
+ org-odt-styles-dir-list)))
(unless styles-dir
(error "Error (ox-odt): Cannot find factory styles files, aborting"))
styles-dir)
@@ -210,9 +206,9 @@ This directory contains the following XML files -
`org-odt-styles-file' and `org-odt-content-template-file'.
The default value of this variable varies depending on the
-version of org in use and is initialized from
-`org-odt-styles-dir-list'. Note that the user could be using org
-from one of: org's own private git repository, GNU ELPA tar or
+version of Org in use and is initialized from
+`org-odt-styles-dir-list'. Note that the user could be using Org
+from one of: Org own private git repository, GNU ELPA tar or
standard Emacs.")
(defconst org-odt-bookmark-prefix "OrgXref.")
@@ -277,7 +273,6 @@ except that the foreground and background colors are set
according to the default face identified by the `htmlfontify'.")
(defvar hfy-optimizations)
-(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "25.1")
(defvar org-odt-embedded-formulas-count 0)
(defvar org-odt-embedded-images-count 0)
(defvar org-odt-image-size-probe-method
@@ -383,28 +378,14 @@ visually."
(require 'rng-loc)
(defcustom org-odt-schema-dir
- (let* ((schema-dir
- (catch 'schema-dir
- (message "Debug (ox-odt): Searching for OpenDocument schema files...")
- (mapc
- (lambda (schema-dir)
- (when schema-dir
- (message "Debug (ox-odt): Trying %s..." schema-dir)
- (when (and (file-expand-wildcards
- (expand-file-name "od-manifest-schema*.rnc"
- schema-dir))
- (file-expand-wildcards
- (expand-file-name "od-schema*.rnc"
- schema-dir))
- (file-readable-p
- (expand-file-name "schemas.xml" schema-dir)))
- (message "Debug (ox-odt): Using schema files under %s"
- schema-dir)
- (throw 'schema-dir schema-dir))))
- org-odt-schema-dir-list)
- (message "Debug (ox-odt): No OpenDocument schema files installed")
- nil)))
- schema-dir)
+ (cl-find-if
+ (lambda (dir)
+ (and dir
+ (file-expand-wildcards
+ (expand-file-name "od-manifest-schema*.rnc" dir))
+ (file-expand-wildcards (expand-file-name "od-schema*.rnc" dir))
+ (file-readable-p (expand-file-name "schemas.xml" dir))))
+ org-odt-schema-dir-list)
"Directory that contains OpenDocument schema files.
This directory contains:
@@ -661,8 +642,7 @@ values. See Info node `(emacs) File Variables'."
;;;; Drawers
-(defcustom org-odt-format-drawer-function
- (lambda (name contents) contents)
+(defcustom org-odt-format-drawer-function (lambda (_name contents) contents)
"Function called to format a drawer in ODT code.
The function must accept two parameters:
@@ -693,7 +673,7 @@ TAGS the tags string, separated with colons (string or nil).
The function result will be used as headline text."
:group 'org-export-odt
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'function)
@@ -714,7 +694,7 @@ The function must accept six parameters:
The function should return the string to be exported."
:group 'org-export-odt
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type 'function)
@@ -773,7 +753,7 @@ A rule consists in an association whose key is the type of link
to consider, and value is a regexp that will be matched against
link's path."
:group 'org-export-odt
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(alist :key-type (string :tag "Type")
:value-type (regexp :tag "Path")))
@@ -992,11 +972,11 @@ See `org-odt--build-date-styles' for implementation details."
(repeater-unit (org-element-property
:repeater-unit timestamp)))
(concat
- (case repeater-type
+ (cl-case repeater-type
(catchup "++") (restart ".+") (cumulate "+"))
(when repeater-value
(number-to-string repeater-value))
- (case repeater-unit
+ (cl-case repeater-unit
(hour "h") (day "d") (week "w") (month "m")
(year "y"))))))
(concat
@@ -1035,29 +1015,28 @@ See `org-odt--build-date-styles' for implementation details."
(defun org-odt--zip-extract (archive members target)
(when (atom members) (setq members (list members)))
- (mapc (lambda (member)
- (require 'arc-mode)
- (let* ((--quote-file-name
- ;; This is shamelessly stolen from `archive-zip-extract'.
- (lambda (name)
- (if (or (not (memq system-type '(windows-nt ms-dos)))
- (and (boundp 'w32-quote-process-args)
- (null w32-quote-process-args)))
- (shell-quote-argument name)
- name)))
- (target (funcall --quote-file-name target))
- (archive (expand-file-name archive))
- (archive-zip-extract
- (list "unzip" "-qq" "-o" "-d" target))
- exit-code command-output)
- (setq command-output
- (with-temp-buffer
- (setq exit-code (archive-zip-extract archive member))
- (buffer-string)))
- (unless (zerop exit-code)
- (message command-output)
- (error "Extraction failed"))))
- members))
+ (require 'arc-mode)
+ (dolist (member members)
+ (let* ((--quote-file-name
+ ;; This is shamelessly stolen from `archive-zip-extract'.
+ (lambda (name)
+ (if (or (not (memq system-type '(windows-nt ms-dos)))
+ (and (boundp 'w32-quote-process-args)
+ (null w32-quote-process-args)))
+ (shell-quote-argument name)
+ name)))
+ (target (funcall --quote-file-name target))
+ (archive (expand-file-name archive))
+ (archive-zip-extract
+ (list "unzip" "-qq" "-o" "-d" target))
+ exit-code command-output)
+ (setq command-output
+ (with-temp-buffer
+ (setq exit-code (archive-zip-extract archive member))
+ (buffer-string)))
+ (unless (zerop exit-code)
+ (message command-output)
+ (error "Extraction failed")))))
;;;; Target
@@ -1125,38 +1104,37 @@ specifying the depth of the table."
</text:index-body>
</text:table-of-content>"))
-(defun* org-odt-format-toc-headline
- (todo todo-type priority text tags
- &key level section-number headline-label &allow-other-keys)
- (setq text
- (concat
- ;; Section number.
- (and section-number (concat section-number ". "))
- ;; Todo.
- (when todo
- (let ((style (if (member todo org-done-keywords)
- "OrgDone" "OrgTodo")))
- (format "<text:span text:style-name=\"%s\">%s</text:span> "
- style todo)))
- (when priority
- (let* ((style (format "OrgPriority-%s" priority))
- (priority (format "[#%c]" priority)))
- (format "<text:span text:style-name=\"%s\">%s</text:span> "
- style priority)))
- ;; Title.
- text
- ;; Tags.
- (when tags
- (concat
- (format " <text:span text:style-name=\"%s\">[%s]</text:span>"
- "OrgTags"
- (mapconcat
- (lambda (tag)
- (format
- "<text:span text:style-name=\"%s\">%s</text:span>"
- "OrgTag" tag)) tags " : "))))))
+(cl-defun org-odt-format-toc-headline
+ (todo _todo-type priority text tags
+ &key _level section-number headline-label &allow-other-keys)
(format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
- headline-label text))
+ headline-label
+ (concat
+ ;; Section number.
+ (and section-number (concat section-number ". "))
+ ;; Todo.
+ (when todo
+ (let ((style (if (member todo org-done-keywords)
+ "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style todo)))
+ (when priority
+ (let* ((style (format "OrgPriority-%s" priority))
+ (priority (format "[#%c]" priority)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style priority)))
+ ;; Title.
+ text
+ ;; Tags.
+ (when tags
+ (concat
+ (format " <text:span text:style-name=\"%s\">[%s]</text:span>"
+ "OrgTags"
+ (mapconcat
+ (lambda (tag)
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" tag)) tags " : ")))))))
(defun org-odt-toc (depth info &optional scope)
"Build a table of contents.
@@ -1164,7 +1142,7 @@ DEPTH is an integer specifying the depth of the table. INFO is
a plist containing current export properties. Optional argument
SCOPE, when non-nil, defines the scope of the table. Return the
table of contents as a string, or nil."
- (assert (wholenump depth))
+ (cl-assert (wholenump depth))
;; When a headline is marked as a radio target, as in the example below:
;;
;; ** <<<Some Heading>>>
@@ -1211,7 +1189,7 @@ Use `org-odt-object-counters' to generate an automatic
OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a
new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
. STYLE-NAME)."
- (assert (stringp object-type))
+ (cl-assert (stringp object-type))
(let* ((object (intern object-type))
(seqvar object)
(seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0)))
@@ -1233,7 +1211,7 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
(let ((checkbox (org-element-property :checkbox item)))
(if (not checkbox) ""
(format "<text:span text:style-name=\"%s\">%s</text:span>"
- "OrgCode" (case checkbox
+ "OrgCode" (cl-case checkbox
(on "[&#x2713;] ") ; CHECK MARK
(off "[ ] ")
(trans "[-] "))))))
@@ -1277,31 +1255,30 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
(case-fold-search nil)
(re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|"))
match rpl (start 0) (filler-beg 0) filler-end filler output)
- (mapc
- (lambda (pair)
- (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t)))
- '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns
- ("%C" . "Y") ; replace century with year
- ("%D" . "%m/%d/%y")
- ("%G" . "Y") ; year corresponding to iso week
- ("%I" . "%H") ; hour on a 12-hour clock
- ("%R" . "%H:%M")
- ("%T" . "%H:%M:%S")
- ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon.
- ("%Z" . "") ; time zone name
- ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format
- ("%g" . "%y")
- ("%X" . "%x" ) ; locale's pref. time format
- ("%j" . "") ; day of the year
- ("%l" . "%k") ; like %I blank-padded
- ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000
- ("%n" . "<text:line-break/>")
- ("%r" . "%I:%M:%S %p")
- ("%t" . "<text:tab/>")
- ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6)
- ("%x" . "%Y-%M-%d %a") ; locale's pref. time format
- ("%z" . "") ; time zone in numeric form
- ))
+ (dolist (pair
+ '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns
+ ("%C" . "Y") ; replace century with year
+ ("%D" . "%m/%d/%y")
+ ("%G" . "Y") ; year corresponding to iso week
+ ("%I" . "%H") ; hour on a 12-hour clock
+ ("%R" . "%H:%M")
+ ("%T" . "%H:%M:%S")
+ ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon.
+ ("%Z" . "") ; time zone name
+ ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format
+ ("%g" . "%y")
+ ("%X" . "%x" ) ; locale's pref. time format
+ ("%j" . "") ; day of the year
+ ("%l" . "%k") ; like %I blank-padded
+ ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000
+ ("%n" . "<text:line-break/>")
+ ("%r" . "%I:%M:%S %p")
+ ("%t" . "<text:tab/>")
+ ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6)
+ ("%x" . "%Y-%M-%d %a") ; locale's pref. time format
+ ("%z" . "") ; time zone in numeric form
+ ))
+ (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t)))
(while (string-match re fmt start)
(setq match (match-string 0 fmt))
(setq rpl (assoc-default match fmt-alist))
@@ -1334,7 +1311,6 @@ original parsed data. INFO is a plist holding export options."
(subtitle (org-export-data (plist-get info :subtitle) info))
(author (let ((author (plist-get info :author)))
(if (not author) "" (org-export-data author info))))
- (email (plist-get info :email))
(keywords (or (plist-get info :keywords) ""))
(description (or (plist-get info :description) "")))
(write-region
@@ -1397,13 +1373,11 @@ original parsed data. INFO is a plist holding export options."
(let ((archive (nth 0 styles-file))
(members (nth 1 styles-file)))
(org-odt--zip-extract archive members org-odt-zip-dir)
- (mapc
- (lambda (member)
- (when (org-file-image-p member)
- (let* ((image-type (file-name-extension member))
- (media-type (format "image/%s" image-type)))
- (org-odt-create-manifest-file-entry media-type member))))
- members)))
+ (dolist (member members)
+ (when (org-file-image-p member)
+ (let* ((image-type (file-name-extension member))
+ (media-type (format "image/%s" image-type)))
+ (org-odt-create-manifest-file-entry media-type member))))))
((and (stringp styles-file) (file-exists-p styles-file))
(let ((styles-file-type (file-name-extension styles-file)))
(cond
@@ -1446,7 +1420,7 @@ original parsed data. INFO is a plist holding export options."
;; currently the zip command zips up the entire temp directory so
;; that any auto-generated files created under the hood ends up in
;; the resulting odt file.
- (set (make-local-variable 'backup-inhibited) t)
+ (setq-local backup-inhibited t)
;; Outline numbering is retained only upto LEVEL.
;; To disable outline numbering pass a LEVEL of 0.
@@ -1483,16 +1457,16 @@ original parsed data. INFO is a plist holding export options."
(re-search-forward " </office:automatic-styles>" nil t)
(goto-char (match-beginning 0))
;; - Dump automatic table styles.
- (loop for (style-name props) in
- (plist-get org-odt-automatic-styles 'Table) do
- (when (setq props (or (plist-get props :rel-width) "96"))
- (insert (format org-odt-table-style-format style-name props))))
+ (cl-loop for (style-name props) in
+ (plist-get org-odt-automatic-styles 'Table) do
+ (when (setq props (or (plist-get props :rel-width) "96"))
+ (insert (format org-odt-table-style-format style-name props))))
;; - Dump date-styles.
(when (plist-get info :odt-use-date-fields)
(insert (org-odt--build-date-styles (car custom-time-fmts)
- "OrgDate1")
+ "OrgDate1")
(org-odt--build-date-styles (cdr custom-time-fmts)
- "OrgDate2")))
+ "OrgDate2")))
;; Update display level.
;; - Remove existing sequence decls. Also position the cursor.
(goto-char (point-min))
@@ -1600,7 +1574,7 @@ original parsed data. INFO is a plist holding export options."
;;;; Bold
-(defun org-odt-bold (bold contents info)
+(defun org-odt-bold (_bold contents _info)
"Transcode BOLD from Org to ODT.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -1610,7 +1584,7 @@ contextual information."
;;;; Center Block
-(defun org-odt-center-block (center-block contents info)
+(defun org-odt-center-block (_center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to ODT.
CONTENTS holds the contents of the center block. INFO is a plist
holding contextual information."
@@ -1637,7 +1611,7 @@ channel."
;;;; Code
-(defun org-odt-code (code contents info)
+(defun org-odt-code (code _contents _info)
"Transcode a CODE object from Org to ODT.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -1646,16 +1620,6 @@ channel."
(org-element-property :value code))))
-;;;; Comment
-
-;; Comments are ignored.
-
-
-;;;; Comment Block
-
-;; Comment Blocks are ignored.
-
-
;;;; Drawer
(defun org-odt-drawer (drawer contents info)
@@ -1670,7 +1634,7 @@ holding contextual information."
;;;; Dynamic Block
-(defun org-odt-dynamic-block (dynamic-block contents info)
+(defun org-odt-dynamic-block (_dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to ODT.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
@@ -1679,7 +1643,7 @@ holding contextual information. See `org-export-data'."
;;;; Entity
-(defun org-odt-entity (entity contents info)
+(defun org-odt-entity (entity _contents _info)
"Transcode an ENTITY object from Org to ODT.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -1688,7 +1652,7 @@ contextual information."
;;;; Example Block
-(defun org-odt-example-block (example-block contents info)
+(defun org-odt-example-block (example-block _contents info)
"Transcode a EXAMPLE-BLOCK element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-odt-format-code example-block info))
@@ -1696,7 +1660,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Snippet
-(defun org-odt-export-snippet (export-snippet contents info)
+(defun org-odt-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'odt)
@@ -1705,7 +1669,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Block
-(defun org-odt-export-block (export-block contents info)
+(defun org-odt-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "ODT")
@@ -1714,7 +1678,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-odt-fixed-width (fixed-width contents info)
+(defun org-odt-fixed-width (fixed-width _contents info)
"Transcode a FIXED-WIDTH element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-odt-do-format-code (org-element-property :value fixed-width) info))
@@ -1727,34 +1691,31 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Reference
-(defun org-odt-footnote-reference (footnote-reference contents info)
+(defun org-odt-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((--format-footnote-definition
- (function
- (lambda (n def)
- (setq n (format "%d" n))
- (let ((id (concat "fn" n))
- (note-class "footnote")
- (par-style "Footnote"))
- (format
- "<text:note text:id=\"%s\" text:note-class=\"%s\">%s</text:note>"
- id note-class
- (concat
- (format "<text:note-citation>%s</text:note-citation>" n)
- (format "<text:note-body>%s</text:note-body>" def)))))))
+ (lambda (n def)
+ (setq n (format "%d" n))
+ (let ((id (concat "fn" n))
+ (note-class "footnote"))
+ (format
+ "<text:note text:id=\"%s\" text:note-class=\"%s\">%s</text:note>"
+ id note-class
+ (concat
+ (format "<text:note-citation>%s</text:note-citation>" n)
+ (format "<text:note-body>%s</text:note-body>" def))))))
(--format-footnote-reference
- (function
- (lambda (n)
- (setq n (format "%d" n))
- (let ((note-class "footnote")
- (ref-format "text")
- (ref-name (concat "fn" n)))
- (format
- "<text:span text:style-name=\"%s\">%s</text:span>"
- "OrgSuperscript"
- (format "<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:note-ref>"
- note-class ref-format ref-name n)))))))
+ (lambda (n)
+ (setq n (format "%d" n))
+ (let ((note-class "footnote")
+ (ref-format "text")
+ (ref-name (concat "fn" n)))
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSuperscript"
+ (format "<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:note-ref>"
+ note-class ref-format ref-name n))))))
(concat
;; Insert separator between two footnotes in a row.
(let ((prev (org-export-get-previous-element footnote-reference info)))
@@ -1786,8 +1747,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
info))))
;; Inline definitions are secondary strings. We
;; need to wrap them within a paragraph.
- (if (memq (org-element-type (car (org-element-contents raw)))
- org-element-all-elements)
+ (if (eq (org-element-class (car (org-element-contents raw)))
+ 'element)
def
(format
"\n<text:p text:style-name=\"Footnote\">%s</text:p>"
@@ -1822,15 +1783,16 @@ INFO is a plist holding contextual information."
(headline-label (org-export-get-reference headline info))
(format-function
(if (functionp format-function) format-function
- (function*
+ (cl-function
(lambda (todo todo-type priority text tags
- &key level section-number headline-label
- &allow-other-keys)
+ &key _level _section-number _headline-label
+ &allow-other-keys)
(funcall (plist-get info :odt-format-headline-function)
todo todo-type priority text tags))))))
(apply format-function
todo todo-type priority text tags
- :headline-label headline-label :level level
+ :headline-label headline-label
+ :level level
:section-number section-number extra-keys)))
(defun org-odt-headline (headline contents info)
@@ -1839,9 +1801,7 @@ CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
;; Case 1: This is a footnote section: ignore it.
(unless (org-element-property :footnote-section-p headline)
- (let* ((text (org-export-data (org-element-property :title headline) info))
- ;; Create the headline text.
- (full-text (org-odt-format-headline--wrap headline nil info))
+ (let* ((full-text (org-odt-format-headline--wrap headline nil info))
;; Get level relative to current parsed data.
(level (org-export-get-relative-level headline info))
(numbered (org-export-numbered-headline-p headline info))
@@ -1928,7 +1888,7 @@ See `org-odt-format-headline-function' for details."
;;;; Horizontal Rule
-(defun org-odt-horizontal-rule (horizontal-rule contents info)
+(defun org-odt-horizontal-rule (_horizontal-rule _contents _info)
"Transcode an HORIZONTAL-RULE object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
@@ -1946,18 +1906,15 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Return a character not used in string S.
This is used to choose a separator for constructs like \\verb."
(let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
- (loop for c across ll
- when (not (string-match (regexp-quote (char-to-string c)) s))
- return (char-to-string c))))
+ (cl-loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
-(defun org-odt-inline-src-block (inline-src-block contents info)
+(defun org-odt-inline-src-block (_inline-src-block _contents _info)
"Transcode an INLINE-SRC-BLOCK element from Org to ODT.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((org-lang (org-element-property :language inline-src-block))
- (code (org-element-property :value inline-src-block))
- (separator (org-odt--find-verb-separator code)))
- (error "FIXME")))
+ (error "FIXME"))
;;;; Inlinetask
@@ -1996,7 +1953,7 @@ See `org-odt-format-inlinetask-function' for details."
;;;; Italic
-(defun org-odt-italic (italic contents info)
+(defun org-odt-italic (_italic contents _info)
"Transcode ITALIC from Org to ODT.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -2011,30 +1968,18 @@ contextual information."
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((plain-list (org-export-get-parent item))
- (type (org-element-property :type plain-list))
- (counter (org-element-property :counter item))
- (tag (let ((tag (org-element-property :tag item)))
- (and tag
- (concat (org-odt--checkbox item)
- (org-export-data tag info))))))
- (case type
- ((ordered unordered descriptive-1 descriptive-2)
- (format "\n<text:list-item>\n%s\n%s"
- contents
- (let* ((--element-has-a-table-p
- (function
- (lambda (element info)
- (loop for el in (org-element-contents element)
- thereis (eq (org-element-type el) 'table))))))
- (cond
- ((funcall --element-has-a-table-p item info)
- "</text:list-header>")
- (t "</text:list-item>")))))
- (t (error "Unknown list type: %S" type)))))
+ (type (org-element-property :type plain-list)))
+ (unless (memq type '(ordered unordered descriptive-1 descriptive-2))
+ (error "Unknown list type: %S" type))
+ (format "\n<text:list-item>\n%s\n%s"
+ contents
+ (if (org-element-map item 'table #'identity info 'first-match)
+ "</text:list-header>"
+ "</text:list-item>"))))
;;;; Keyword
-(defun org-odt-keyword (keyword contents info)
+(defun org-odt-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -2048,13 +1993,13 @@ information."
((string= key "TOC")
(let ((case-fold-search t))
(cond
- ((org-string-match-p "\\<headlines\\>" value)
+ ((string-match-p "\\<headlines\\>" value)
(let ((depth (or (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value)))
(plist-get info :headline-levels)))
- (localp (org-string-match-p "\\<local\\>" value)))
+ (localp (string-match-p "\\<local\\>" value)))
(org-odt-toc depth info (and localp keyword))))
- ((org-string-match-p "tables\\|figures\\|listings" value)
+ ((string-match-p "tables\\|figures\\|listings" value)
;; FIXME
(ignore))))))))
@@ -2070,7 +2015,7 @@ information."
;; (unless (> (length ad-return-value) 0)
;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0)))))
-(defun org-odt-latex-environment (latex-environment contents info)
+(defun org-odt-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(let* ((latex-frag (org-remove-indentation
@@ -2081,23 +2026,22 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Latex Fragment
;; (when latex-frag ; FIXME
-;; (setq href (org-propertize href :title "LaTeX Fragment"
+;; (setq href (propertize href :title "LaTeX Fragment"
;; :description latex-frag)))
;; handle verbatim
;; provide descriptions
-(defun org-odt-latex-fragment (latex-fragment contents info)
+(defun org-odt-latex-fragment (latex-fragment _contents _info)
"Transcode a LATEX-FRAGMENT object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
- (let* ((latex-frag (org-element-property :value latex-fragment))
- (processing-type (plist-get info :with-latex)))
+ (let ((latex-frag (org-element-property :value latex-fragment)))
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgCode" (org-odt--encode-plain-text latex-frag t))))
;;;; Line Break
-(defun org-odt-line-break (line-break contents info)
+(defun org-odt-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
"<text:line-break/>")
@@ -2108,27 +2052,25 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Links :: Label references
(defun org-odt--enumerate (element info &optional predicate n)
- (when predicate (assert (funcall predicate element info)))
+ (when predicate (cl-assert (funcall predicate element info)))
(let* ((--numbered-parent-headline-at-<=-n
- (function
- (lambda (element n info)
- (loop for x in (org-element-lineage element)
- thereis (and (eq (org-element-type x) 'headline)
- (<= (org-export-get-relative-level x info) n)
- (org-export-numbered-headline-p x info)
- x)))))
+ (lambda (element n info)
+ (cl-loop for x in (org-element-lineage element)
+ thereis (and (eq (org-element-type x) 'headline)
+ (<= (org-export-get-relative-level x info) n)
+ (org-export-numbered-headline-p x info)
+ x))))
(--enumerate
- (function
- (lambda (element scope info &optional predicate)
- (let ((counter 0))
- (org-element-map (or scope (plist-get info :parse-tree))
- (org-element-type element)
- (lambda (el)
- (and (or (not predicate) (funcall predicate el info))
- (incf counter)
- (eq element el)
- counter))
- info 'first-match)))))
+ (lambda (element scope info &optional predicate)
+ (let ((counter 0))
+ (org-element-map (or scope (plist-get info :parse-tree))
+ (org-element-type element)
+ (lambda (el)
+ (and (or (not predicate) (funcall predicate el info))
+ (cl-incf counter)
+ (eq element el)
+ counter))
+ info 'first-match))))
(scope (funcall --numbered-parent-headline-at-<=-n
element
(or n (plist-get info :odt-display-outline-level))
@@ -2157,9 +2099,9 @@ the generated string.
Return value is a string if OP is set to `reference' or a cons
cell like CAPTION . SHORT-CAPTION) where CAPTION and
SHORT-CAPTION are strings."
- (assert (memq (org-element-type element) '(link table src-block paragraph)))
+ (cl-assert (memq (org-element-type element) '(link table src-block paragraph)))
(let* ((element-or-parent
- (case (org-element-type element)
+ (cl-case (org-element-type element)
(link (org-export-get-parent-element element))
(t element)))
;; Get label and caption.
@@ -2172,7 +2114,7 @@ SHORT-CAPTION are strings."
(short-caption nil))
(when (or label caption)
(let* ((default-category
- (case (org-element-type element)
+ (cl-case (org-element-type element)
(table "__Table__")
(src-block "__Listing__")
((link paragraph)
@@ -2188,14 +2130,15 @@ SHORT-CAPTION are strings."
(t (error "Don't know how to format label for element type: %s"
(org-element-type element)))))
seqno)
- (assert default-category)
- (destructuring-bind (counter label-style category predicate)
- (assoc-default default-category org-odt-category-map-alist)
+ (cl-assert default-category)
+ (pcase-let
+ ((`(,counter ,label-style ,category ,predicate)
+ (assoc-default default-category org-odt-category-map-alist)))
;; Compute sequence number of the element.
(setq seqno (org-odt--enumerate element info predicate))
;; Localize category string.
(setq category (org-export-translate category :utf-8 info))
- (case op
+ (cl-case op
;; Case 1: Handle Label definition.
(definition
(cons
@@ -2238,7 +2181,7 @@ SHORT-CAPTION are strings."
(target-dir "Images/")
(target-file
(format "%s%04d.%s" target-dir
- (incf org-odt-embedded-images-count) image-type)))
+ (cl-incf org-odt-embedded-images-count) image-type)))
(message "Embedding %s as %s..."
(substring-no-properties path) target-file)
@@ -2317,7 +2260,7 @@ SHORT-CAPTION are strings."
"Return ODT code for an inline image.
LINK is the link pointing to the inline image. INFO is a plist
used as a communication channel."
- (assert (eq (org-element-type element) 'link))
+ (cl-assert (eq (org-element-type element) 'link))
(let* ((src (let* ((type (org-element-property :type element))
(raw-path (org-element-property :path element)))
(cond ((member type '("http" "https"))
@@ -2332,7 +2275,7 @@ used as a communication channel."
"\n<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>"
(org-odt--copy-image-file src-expanded)))
;; Extract attributes from #+ATTR_ODT line.
- (attr-from (case (org-element-type element)
+ (attr-from (cl-case (org-element-type element)
(link (org-export-get-parent-element element))
(t element)))
;; Convert attributes to a plist.
@@ -2366,7 +2309,7 @@ used as a communication channel."
(standalone-link-p (org-odt--standalone-link-p element info))
(embed-as (if standalone-link-p "paragraph" "as-char"))
(captions (org-odt-format-label element info 'definition))
- (caption (car captions)) (short-caption (cdr captions))
+ (caption (car captions))
(entity (concat (and caption "Captioned") embed-as "Image"))
;; Check if this link was created by LaTeX-to-PNG converter.
(replaces (org-element-property
@@ -2387,8 +2330,7 @@ used as a communication channel."
;;;; Links :: Math formula
(defun org-odt-link--inline-formula (element info)
- (let* ((src (let* ((type (org-element-property :type element))
- (raw-path (org-element-property :path element)))
+ (let* ((src (let ((raw-path (org-element-property :path element)))
(cond
((file-name-absolute-p raw-path)
(expand-file-name raw-path))
@@ -2404,7 +2346,6 @@ used as a communication channel."
(standalone-link-p (org-odt--standalone-link-p element info))
(embed-as (if standalone-link-p 'paragraph 'character))
(captions (org-odt-format-label element info 'definition))
- (caption (car captions)) (short-caption (cdr captions))
;; Check if this link was created by LaTeX-to-MathML
;; converter.
(replaces (org-element-property
@@ -2422,7 +2363,7 @@ used as a communication channel."
(cond
((eq embed-as 'character)
(org-odt--render-image/formula "InlineFormula" href width height
- nil nil title desc))
+ nil nil title desc))
(t
(let* ((equation (org-odt--render-image/formula
"CaptionedDisplayFormula" href width height
@@ -2437,7 +2378,7 @@ used as a communication channel."
(defun org-odt--copy-formula-file (src-file)
"Returns the internal name of the file"
(let* ((target-dir (format "Formula-%04d/"
- (incf org-odt-embedded-formulas-count)))
+ (cl-incf org-odt-embedded-formulas-count)))
(target-file (concat target-dir "content.xml")))
;; Create a directory for holding formula file. Also enter it in
;; to manifest.
@@ -2447,13 +2388,13 @@ used as a communication channel."
;; Copy over the formula file from user directory to zip
;; directory.
(message "Embedding %s as %s..." src-file target-file)
- (let ((case-fold-search nil))
+ (let ((ext (file-name-extension src-file)))
(cond
;; Case 1: Mathml.
- ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file)
+ ((member ext '("mathml" "mml"))
(copy-file src-file (concat org-odt-zip-dir target-file) 'overwrite))
;; Case 2: OpenDocument formula.
- ((string-match "\\.odf\\'" src-file)
+ ((string= ext "odf")
(org-odt--zip-extract src-file "content.xml"
(concat org-odt-zip-dir target-dir)))
(t (error "%s is not a formula file" src-file))))
@@ -2464,8 +2405,8 @@ used as a communication channel."
;;;; Targets
(defun org-odt--render-image/formula (cfg-key href width height &optional
- captions user-frame-params
- &rest title-and-desc)
+ captions user-frame-params
+ &rest title-and-desc)
(let* ((frame-cfg-alist
;; Each element of this alist is of the form (CFG-HANDLE
;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS).
@@ -2527,11 +2468,11 @@ used as a communication channel."
(lambda (default user)
"Merge default and user frame params."
(if (not user) default
- (assert (= (length default) 3))
- (assert (= (length user) 3))
- (loop for u in user
- for d in default
- collect (or u d)))))))
+ (cl-assert (= (length default) 3))
+ (cl-assert (= (length user) 3))
+ (cl-loop for u in user
+ for d in default
+ collect (or u d)))))))
(cond
;; Case 1: Image/Formula has no caption.
;; There is only one frame, one that surrounds the image
@@ -2565,7 +2506,7 @@ used as a communication channel."
caption))
width height outer)))))
-(defun org-odt--enumerable-p (element info)
+(defun org-odt--enumerable-p (element _info)
;; Element should have a caption or label.
(or (org-element-property :caption element)
(org-element-property :name element)))
@@ -2582,7 +2523,7 @@ used as a communication channel."
(org-element-property :name p))))
;; Link should point to an image file.
(lambda (l)
- (assert (eq (org-element-type l) 'link))
+ (cl-assert (eq (org-element-type l) 'link))
(org-export-inline-image-p l (plist-get info :odt-inline-image-rules)))))
(defun org-odt--enumerable-latex-image-p (element info)
@@ -2597,7 +2538,7 @@ used as a communication channel."
(org-element-property :name p))))
;; Link should point to an image file.
(lambda (l)
- (assert (eq (org-element-type l) 'link))
+ (cl-assert (eq (org-element-type l) 'link))
(org-export-inline-image-p l (plist-get info :odt-inline-image-rules)))))
(defun org-odt--enumerable-formula-p (element info)
@@ -2609,12 +2550,12 @@ used as a communication channel."
(org-element-property :name p)))
;; Link should point to a MathML or ODF file.
(lambda (l)
- (assert (eq (org-element-type l) 'link))
+ (cl-assert (eq (org-element-type l) 'link))
(org-export-inline-image-p l (plist-get info :odt-inline-formula-rules)))))
-(defun org-odt--standalone-link-p (element info &optional
- paragraph-predicate
- link-predicate)
+(defun org-odt--standalone-link-p (element _info &optional
+ paragraph-predicate
+ link-predicate)
"Test if ELEMENT is a standalone link for the purpose ODT export.
INFO is a plist holding contextual information.
@@ -2628,7 +2569,7 @@ PARAGRAPH-PREDICATE in addition to having no other content save for
leading and trailing whitespaces.
Return nil, otherwise."
- (let ((p (case (org-element-type element)
+ (let ((p (cl-case (org-element-type element)
(paragraph element)
(link (and (or (not link-predicate)
(funcall link-predicate element))
@@ -2638,16 +2579,16 @@ Return nil, otherwise."
(when (or (not paragraph-predicate)
(funcall paragraph-predicate p))
(let ((contents (org-element-contents p)))
- (loop for x in contents
- with inline-image-count = 0
- always (case (org-element-type x)
- (plain-text
- (not (org-string-nw-p x)))
- (link
- (and (or (not link-predicate)
- (funcall link-predicate x))
- (= (incf inline-image-count) 1)))
- (t nil))))))))
+ (cl-loop for x in contents
+ with inline-image-count = 0
+ always (cl-case (org-element-type x)
+ (plain-text
+ (not (org-string-nw-p x)))
+ (link
+ (and (or (not link-predicate)
+ (funcall link-predicate x))
+ (= (cl-incf inline-image-count) 1)))
+ (t nil))))))))
(defun org-odt-link--infer-description (destination info)
;; DESTINATION is a headline or an element (like paragraph,
@@ -2672,31 +2613,31 @@ Return nil, otherwise."
(or
(let* ( ;; Locate top-level list.
(top-level-list
- (loop for x on data
- when (eq (org-element-type (car x)) 'plain-list)
- return x))
+ (cl-loop for x on data
+ when (eq (org-element-type (car x)) 'plain-list)
+ return x))
;; Get list item nos.
(item-numbers
- (loop for (plain-list item . rest) on top-level-list by #'cddr
- until (not (eq (org-element-type plain-list) 'plain-list))
- collect (when (eq (org-element-property :type
- plain-list)
- 'ordered)
- (1+ (length (org-export-get-previous-element
- item info t))))))
+ (cl-loop for (plain-list item . rest) on top-level-list by #'cddr
+ until (not (eq (org-element-type plain-list) 'plain-list))
+ collect (when (eq (org-element-property :type
+ plain-list)
+ 'ordered)
+ (1+ (length (org-export-get-previous-element
+ item info t))))))
;; Locate top-most listified headline.
(listified-headlines
- (loop for x on data
- when (and (eq (org-element-type (car x)) 'headline)
- (org-export-low-level-p (car x) info))
- return x))
+ (cl-loop for x on data
+ when (and (eq (org-element-type (car x)) 'headline)
+ (org-export-low-level-p (car x) info))
+ return x))
;; Get listified headline numbers.
(listified-headline-nos
- (loop for el in listified-headlines
- when (eq (org-element-type el) 'headline)
- collect (when (org-export-numbered-headline-p el info)
- (1+ (length (org-export-get-previous-element
- el info t)))))))
+ (cl-loop for el in listified-headlines
+ when (eq (org-element-type el) 'headline)
+ collect (when (org-export-numbered-headline-p el info)
+ (1+ (length (org-export-get-previous-element
+ el info t)))))))
;; Combine item numbers from both the listified headlines and
;; regular list items.
@@ -2715,11 +2656,11 @@ Return nil, otherwise."
(and
;; Test if destination is a numbered headline.
(org-export-numbered-headline-p destination info)
- (loop for el in (cons destination genealogy)
- when (and (eq (org-element-type el) 'headline)
- (not (org-export-low-level-p el info))
- (org-export-numbered-headline-p el info))
- return el))))
+ (cl-loop for el in (cons destination genealogy)
+ when (and (eq (org-element-type el) 'headline)
+ (not (org-export-low-level-p el info))
+ (org-export-numbered-headline-p el info))
+ return el))))
;; We found one.
(when headline
(format "<text:bookmark-ref text:reference-format=\"chapter\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
@@ -2728,10 +2669,10 @@ Return nil, otherwise."
headline info) "."))))
;; Case 4: Locate a regular headline in the hierarchy. Display
;; its title.
- (let ((headline (loop for el in (cons destination genealogy)
- when (and (eq (org-element-type el) 'headline)
- (not (org-export-low-level-p el info)))
- return el)))
+ (let ((headline (cl-loop for el in (cons destination genealogy)
+ when (and (eq (org-element-type el) 'headline)
+ (not (org-export-low-level-p el info)))
+ return el)))
;; We found one.
(when headline
(format "<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
@@ -2763,12 +2704,11 @@ INFO is a plist holding contextual information. See
;; Link type is handled by a special function.
((org-export-custom-protocol-maybe link desc 'odt))
;; Image file.
- ((and (not desc) (org-export-inline-image-p
- link (plist-get info :odt-inline-image-rules)))
- (org-odt-link--inline-image link info))
+ ((and (not desc) imagep) (org-odt-link--inline-image link info))
;; Formula file.
- ((and (not desc) (org-export-inline-image-p
- link (plist-get info :odt-inline-formula-rules)))
+ ((and (not desc)
+ (org-export-inline-image-p
+ link (plist-get info :odt-inline-formula-rules)))
(org-odt-link--inline-formula link info))
;; Radio target: Transcode target's contents and use them as
;; link's description.
@@ -2785,7 +2725,7 @@ INFO is a plist holding contextual information. See
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
+ (cl-case (org-element-type destination)
;; Fuzzy link points to a headline. If there's
;; a description, create a hyperlink. Otherwise, try to
;; provide a meaningful description.
@@ -2862,7 +2802,7 @@ INFO is a plist holding contextual information. See
;;;; Node Property
-(defun org-odt-node-property (node-property contents info)
+(defun org-odt-node-property (node-property _contents _info)
"Transcode a NODE-PROPERTY element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -2881,7 +2821,7 @@ Style is a symbol among `quoted', `centered' and nil."
(while (and (setq up (org-element-property :parent up))
(not (memq (org-element-type up)
'(center-block quote-block section)))))
- (case (org-element-type up)
+ (cl-case (org-element-type up)
(center-block 'centered)
(quote-block 'quoted))))
@@ -2893,7 +2833,7 @@ a plist used as a communication channel. DEFAULT, CENTER and
QUOTE are, respectively, style to use when paragraph belongs to
no special environment, a center block, or a quote block."
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- (case (org-odt--paragraph-style paragraph)
+ (cl-case (org-odt--paragraph-style paragraph)
(quoted quote)
(centered center)
(otherwise default))
@@ -2919,13 +2859,13 @@ the plist used as a communication channel."
;;;; Plain List
-(defun org-odt-plain-list (plain-list contents info)
+(defun org-odt-plain-list (plain-list contents _info)
"Transcode a PLAIN-LIST element from Org to ODT.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
(format "\n<text:list text:style-name=\"%s\" %s>\n%s</text:list>"
;; Choose style based on list type.
- (case (org-element-property :type plain-list)
+ (cl-case (org-element-property :type plain-list)
(ordered "OrgNumberedList")
(unordered "OrgBulletedList")
(descriptive-1 "OrgDescriptionList")
@@ -2954,10 +2894,8 @@ contextual information."
line))
(defun org-odt--encode-plain-text (text &optional no-whitespace-filling)
- (mapc
- (lambda (pair)
- (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
- '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
+ (dolist (pair '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
(if no-whitespace-filling text
(org-odt--encode-tabs-and-spaces text)))
@@ -2974,11 +2912,9 @@ contextual information."
(setq output (org-export-activate-smart-quotes output :utf-8 info text)))
;; Convert special strings.
(when (plist-get info :with-special-strings)
- (mapc
- (lambda (pair)
- (setq output
- (replace-regexp-in-string (car pair) (cdr pair) output t nil)))
- org-odt-special-string-regexps))
+ (dolist (pair org-odt-special-string-regexps)
+ (setq output
+ (replace-regexp-in-string (car pair) (cdr pair) output t nil))))
;; Handle break preservation if required.
(when (plist-get info :preserve-breaks)
(setq output (replace-regexp-in-string
@@ -3018,7 +2954,7 @@ channel."
;;;; Property Drawer
-(defun org-odt-property-drawer (property-drawer contents info)
+(defun org-odt-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element from Org to ODT.
CONTENTS holds the contents of the drawer. INFO is a plist
holding contextual information."
@@ -3029,7 +2965,7 @@ holding contextual information."
;;;; Quote Block
-(defun org-odt-quote-block (quote-block contents info)
+(defun org-odt-quote-block (_quote-block contents _info)
"Transcode a QUOTE-BLOCK element from Org to ODT.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -3046,7 +2982,7 @@ holding contextual information."
text)))
-(defun org-odt-section (section contents info) ; FIXME
+(defun org-odt-section (_section contents _info) ; FIXME
"Transcode a SECTION element from Org to ODT.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
@@ -3137,25 +3073,24 @@ and prefix with \"OrgSrc\". For example,
(cons style-name style)))
(defun org-odt-htmlfontify-string (line)
- (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)")
+ (let* ((hfy-html-quote-regex "\\([<\"&> \t]\\)")
(hfy-html-quote-map '(("\"" "&quot;")
("<" "&lt;")
("&" "&amp;")
(">" "&gt;")
(" " "<text:s/>")
- (" " "<text:tab/>")))
+ ("\t" "<text:tab/>")))
(hfy-face-to-css 'org-odt-hfy-face-to-css)
(hfy-optimizations-1 (copy-sequence hfy-optimizations))
- (hfy-optimizations (add-to-list 'hfy-optimizations-1
- 'body-text-only))
+ (hfy-optimizations (cl-pushnew 'body-text-only hfy-optimizations-1))
(hfy-begin-span-handler
- (lambda (style text-block text-id text-begins-block-p)
+ (lambda (style _text-block _text-id _text-begins-block-p)
(insert (format "<text:span text:style-name=\"%s\">" style))))
- (hfy-end-span-handler (lambda nil (insert "</text:span>"))))
- (org-no-warnings (htmlfontify-string line))))
+ (hfy-end-span-handler (lambda () (insert "</text:span>"))))
+ (with-no-warnings (htmlfontify-string line))))
(defun org-odt-do-format-code
- (code info &optional lang refs retain-labels num-start)
+ (code info &optional lang refs retain-labels num-start)
(let* ((lang (or (assoc-default lang org-src-lang-modes) lang))
(lang-mode (and lang (intern (format "%s-mode" lang))))
(code-lines (org-split-string code "\n"))
@@ -3175,19 +3110,20 @@ and prefix with \"OrgSrc\". For example,
(par-style (if use-htmlfontify-p "OrgSrcBlock"
"OrgFixedWidthBlock"))
(i 0))
- (assert (= code-length (length (org-split-string code "\n"))))
+ (cl-assert (= code-length (length (org-split-string code "\n"))))
(setq code
(org-export-format-code
code
(lambda (loc line-num ref)
(setq par-style
- (concat par-style (and (= (incf i) code-length) "LastLine")))
+ (concat par-style (and (= (cl-incf i) code-length)
+ "LastLine")))
(setq loc (concat loc (and ref retain-labels (format " (%s)" ref))))
(setq loc (funcall fontifier loc))
(when ref
(setq loc (org-odt--target loc (concat "coderef-" ref))))
- (assert par-style)
+ (cl-assert par-style)
(setq loc (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
par-style loc))
(if (not line-num) loc
@@ -3213,19 +3149,15 @@ and prefix with \"OrgSrc\". For example,
;; Does the src block contain labels?
(retain-labels (org-element-property :retain-labels element))
;; Does it have line numbers?
- (num-start (case (org-element-property :number-lines element)
- (continued (org-export-get-loc element info))
- (new 0))))
+ (num-start (org-export-get-loc element info)))
(org-odt-do-format-code code info lang refs retain-labels num-start)))
-(defun org-odt-src-block (src-block contents info)
+(defun org-odt-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to ODT.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((lang (org-element-property :language src-block))
- (attributes (org-export-read-attribute :attr_odt src-block))
- (captions (org-odt-format-label src-block info 'definition))
- (caption (car captions)) (short-caption (cdr captions)))
+ (let* ((attributes (org-export-read-attribute :attr_odt src-block))
+ (caption (car (org-odt-format-label src-block info 'definition))))
(concat
(and caption
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
@@ -3239,7 +3171,7 @@ contextual information."
;;;; Statistics Cookie
-(defun org-odt-statistics-cookie (statistics-cookie contents info)
+(defun org-odt-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((cookie-value (org-element-property :value statistics-cookie)))
@@ -3249,7 +3181,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Strike-Through
-(defun org-odt-strike-through (strike-through contents info)
+(defun org-odt-strike-through (_strike-through contents _info)
"Transcode STRIKE-THROUGH from Org to ODT.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
@@ -3259,7 +3191,7 @@ holding contextual information."
;;;; Subscript
-(defun org-odt-subscript (subscript contents info)
+(defun org-odt-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to ODT.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -3269,7 +3201,7 @@ contextual information."
;;;; Superscript
-(defun org-odt-superscript (superscript contents info)
+(defun org-odt-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to ODT.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -3324,23 +3256,23 @@ styles congruent with the ODF-1.2 specification."
(cell-style-selectors (nth 2 style-spec))
(cell-type
(cond
- ((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
+ ((and (cdr (assq 'use-first-column-styles cell-style-selectors))
(= c 0)) "FirstColumn")
- ((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
+ ((and (cdr (assq 'use-last-column-styles cell-style-selectors))
(= (1+ c) (cdr table-dimensions)))
"LastColumn")
- ((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
+ ((and (cdr (assq 'use-first-row-styles cell-style-selectors))
(= r 0)) "FirstRow")
- ((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
+ ((and (cdr (assq 'use-last-row-styles cell-style-selectors))
(= (1+ r) (car table-dimensions)))
"LastRow")
- ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ ((and (cdr (assq 'use-banding-rows-styles cell-style-selectors))
(= (% r 2) 1)) "EvenRow")
- ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ ((and (cdr (assq 'use-banding-rows-styles cell-style-selectors))
(= (% r 2) 0)) "OddRow")
- ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ ((and (cdr (assq 'use-banding-columns-styles cell-style-selectors))
(= (% c 2) 1)) "EvenColumn")
- ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ ((and (cdr (assq 'use-banding-columns-styles cell-style-selectors))
(= (% c 2) 0)) "OddColumn")
(t ""))))
(concat template-name cell-type)))))
@@ -3398,17 +3330,16 @@ channel."
(1+ horiz-span))))))
(unless contents (setq contents ""))
(concat
- (assert paragraph-style)
+ (cl-assert paragraph-style)
(format "\n<table:table-cell%s>\n%s\n</table:table-cell>"
cell-attributes
(let ((table-cell-contents (org-element-contents table-cell)))
- (if (memq (org-element-type (car table-cell-contents))
- org-element-all-elements)
+ (if (eq (org-element-class (car table-cell-contents)) 'element)
contents
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
paragraph-style contents))))
(let (s)
- (dotimes (i horiz-span s)
+ (dotimes (_ horiz-span s)
(setq s (concat s "\n<table:covered-table-cell/>"))))
"\n")))
@@ -3459,7 +3390,7 @@ communication channel."
"Transcode a TABLE element from Org to ODT.
CONTENTS is the contents of the table. INFO is a plist holding
contextual information."
- (case (org-element-property :type table)
+ (cl-case (org-element-property :type table)
;; Case 1: table.el doesn't support export to OD format. Strip
;; such tables from export.
(table.el
@@ -3476,20 +3407,19 @@ contextual information."
(attributes (org-export-read-attribute :attr_odt table))
(custom-table-style (nth 1 (org-odt-table-style-spec table info)))
(table-column-specs
- (function
- (lambda (table info)
- (let* ((table-style (or custom-table-style "OrgTable"))
- (column-style (format "%sColumn" table-style)))
- (mapconcat
- (lambda (table-cell)
- (let ((width (1+ (or (org-export-table-cell-width
- table-cell info) 0)))
- (s (format
- "\n<table:table-column table:style-name=\"%s\"/>"
- column-style))
- out)
- (dotimes (i width out) (setq out (concat s out)))))
- (org-odt-table-first-row-data-cells table info) "\n"))))))
+ (lambda (table info)
+ (let* ((table-style (or custom-table-style "OrgTable"))
+ (column-style (format "%sColumn" table-style)))
+ (mapconcat
+ (lambda (table-cell)
+ (let ((width (1+ (or (org-export-table-cell-width
+ table-cell info) 0)))
+ (s (format
+ "\n<table:table-column table:style-name=\"%s\"/>"
+ column-style))
+ out)
+ (dotimes (_ width out) (setq out (concat s out)))))
+ (org-odt-table-first-row-data-cells table info) "\n")))))
(concat
;; caption.
(when caption
@@ -3518,84 +3448,84 @@ contextual information.
Use `org-odt--table' to typeset the table. Handle details
pertaining to indentation here."
(let* ((--element-preceded-by-table-p
- (function
- (lambda (element info)
- (loop for el in (org-export-get-previous-element element info t)
- thereis (eq (org-element-type el) 'table)))))
+ (lambda (element info)
+ (cl-loop for el in (org-export-get-previous-element element info t)
+ thereis (eq (org-element-type el) 'table))))
(--walk-list-genealogy-and-collect-tags
- (function
- (lambda (table info)
- (let* ((genealogy (org-element-lineage table))
- (list-genealogy
- (when (eq (org-element-type (car genealogy)) 'item)
- (loop for el in genealogy
- when (memq (org-element-type el)
- '(item plain-list))
- collect el)))
- (llh-genealogy
- (apply 'nconc
- (loop for el in genealogy
- when (and (eq (org-element-type el) 'headline)
- (org-export-low-level-p el info))
- collect
- (list el
- (assq 'headline
- (org-element-contents
- (org-export-get-parent el)))))))
- parent-list)
- (nconc
- ;; Handle list genealogy.
- (loop for el in list-genealogy collect
- (case (org-element-type el)
- (plain-list
- (setq parent-list el)
- (cons "</text:list>"
- (format "\n<text:list text:style-name=\"%s\" %s>"
- (case (org-element-property :type el)
- (ordered "OrgNumberedList")
- (unordered "OrgBulletedList")
- (descriptive-1 "OrgDescriptionList")
- (descriptive-2 "OrgDescriptionList"))
- "text:continue-numbering=\"true\"")))
- (item
- (cond
- ((not parent-list)
- (if (funcall --element-preceded-by-table-p table info)
- '("</text:list-header>" . "<text:list-header>")
- '("</text:list-item>" . "<text:list-header>")))
- ((funcall --element-preceded-by-table-p
- parent-list info)
- '("</text:list-header>" . "<text:list-header>"))
- (t '("</text:list-item>" . "<text:list-item>"))))))
- ;; Handle low-level headlines.
- (loop for el in llh-genealogy
- with step = 'item collect
- (case step
- (plain-list
- (setq step 'item) ; Flip-flop
- (setq parent-list el)
- (cons "</text:list>"
- (format "\n<text:list text:style-name=\"%s\" %s>"
- (if (org-export-numbered-headline-p
- el info)
- "OrgNumberedList"
- "OrgBulletedList")
- "text:continue-numbering=\"true\"")))
- (item
- (setq step 'plain-list) ; Flip-flop
- (cond
- ((not parent-list)
- (if (funcall --element-preceded-by-table-p table info)
- '("</text:list-header>" . "<text:list-header>")
- '("</text:list-item>" . "<text:list-header>")))
- ((let ((section? (org-export-get-previous-element
- parent-list info)))
- (and section?
- (eq (org-element-type section?) 'section)
- (assq 'table (org-element-contents section?))))
- '("</text:list-header>" . "<text:list-header>"))
- (t
- '("</text:list-item>" . "<text:list-item>")))))))))))
+ (lambda (table info)
+ (let* ((genealogy (org-element-lineage table))
+ (list-genealogy
+ (when (eq (org-element-type (car genealogy)) 'item)
+ (cl-loop for el in genealogy
+ when (memq (org-element-type el)
+ '(item plain-list))
+ collect el)))
+ (llh-genealogy
+ (apply #'nconc
+ (cl-loop
+ for el in genealogy
+ when (and (eq (org-element-type el) 'headline)
+ (org-export-low-level-p el info))
+ collect
+ (list el
+ (assq 'headline
+ (org-element-contents
+ (org-export-get-parent el)))))))
+ parent-list)
+ (nconc
+ ;; Handle list genealogy.
+ (cl-loop
+ for el in list-genealogy collect
+ (cl-case (org-element-type el)
+ (plain-list
+ (setq parent-list el)
+ (cons "</text:list>"
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ (cl-case (org-element-property :type el)
+ (ordered "OrgNumberedList")
+ (unordered "OrgBulletedList")
+ (descriptive-1 "OrgDescriptionList")
+ (descriptive-2 "OrgDescriptionList"))
+ "text:continue-numbering=\"true\"")))
+ (item
+ (cond
+ ((not parent-list)
+ (if (funcall --element-preceded-by-table-p table info)
+ '("</text:list-header>" . "<text:list-header>")
+ '("</text:list-item>" . "<text:list-header>")))
+ ((funcall --element-preceded-by-table-p
+ parent-list info)
+ '("</text:list-header>" . "<text:list-header>"))
+ (t '("</text:list-item>" . "<text:list-item>"))))))
+ ;; Handle low-level headlines.
+ (cl-loop for el in llh-genealogy
+ with step = 'item collect
+ (cl-case step
+ (plain-list
+ (setq step 'item) ; Flip-flop
+ (setq parent-list el)
+ (cons "</text:list>"
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ (if (org-export-numbered-headline-p
+ el info)
+ "OrgNumberedList"
+ "OrgBulletedList")
+ "text:continue-numbering=\"true\"")))
+ (item
+ (setq step 'plain-list) ; Flip-flop
+ (cond
+ ((not parent-list)
+ (if (funcall --element-preceded-by-table-p table info)
+ '("</text:list-header>" . "<text:list-header>")
+ '("</text:list-item>" . "<text:list-header>")))
+ ((let ((section? (org-export-get-previous-element
+ parent-list info)))
+ (and section?
+ (eq (org-element-type section?) 'section)
+ (assq 'table (org-element-contents section?))))
+ '("</text:list-header>" . "<text:list-header>"))
+ (t
+ '("</text:list-item>" . "<text:list-item>"))))))))))
(close-open-tags (funcall --walk-list-genealogy-and-collect-tags
table info)))
;; OpenDocument schema does not permit table to occur within a
@@ -3641,7 +3571,7 @@ pertaining to indentation here."
;;
;; - Description lists are simulated as plain lists.
;; - Low-level headlines can be listified.
- ;; - In Org-mode, a table can occur not only as a regular list
+ ;; - In Org mode, a table can occur not only as a regular list
;; item, but also within description lists and low-level
;; headlines.
@@ -3663,7 +3593,7 @@ pertaining to indentation here."
;;;; Target
-(defun org-odt-target (target contents info)
+(defun org-odt-target (target _contents info)
"Transcode a TARGET object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -3672,16 +3602,15 @@ information."
;;;; Timestamp
-(defun org-odt-timestamp (timestamp contents info)
+(defun org-odt-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to ODT.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (let* ((raw-value (org-element-property :raw-value timestamp))
- (type (org-element-property :type timestamp)))
+ (let ((type (org-element-property :type timestamp)))
(if (not (plist-get info :odt-use-date-fields))
(let ((value (org-odt-plain-text
(org-timestamp-translate timestamp) info)))
- (case (org-element-property :type timestamp)
+ (cl-case (org-element-property :type timestamp)
((active active-range)
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgActiveTimestamp" value))
@@ -3689,7 +3618,7 @@ channel."
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgInactiveTimestamp" value))
(otherwise value)))
- (case type
+ (cl-case type
(active
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgActiveTimestamp"
@@ -3719,7 +3648,7 @@ channel."
;;;; Underline
-(defun org-odt-underline (underline contents info)
+(defun org-odt-underline (_underline contents _info)
"Transcode UNDERLINE from Org to ODT.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -3729,7 +3658,7 @@ holding contextual information."
;;;; Verbatim
-(defun org-odt-verbatim (verbatim contents info)
+(defun org-odt-verbatim (verbatim _contents _info)
"Transcode a VERBATIM object from Org to ODT.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -3740,7 +3669,7 @@ channel."
;;;; Verse Block
-(defun org-odt-verse-block (verse-block contents info)
+(defun org-odt-verse-block (_verse-block contents _info)
"Transcode a VERSE-BLOCK element from Org to ODT.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
@@ -3760,13 +3689,13 @@ contextual information."
;;;; LaTeX fragments
-(defun org-odt--translate-latex-fragments (tree backend info)
+(defun org-odt--translate-latex-fragments (tree _backend info)
(let ((processing-type (plist-get info :with-latex))
(count 0))
;; Normalize processing-type to one of dvipng, mathml or verbatim.
;; If the desired converter is not available, force verbatim
;; processing.
- (case processing-type
+ (cl-case processing-type
((t mathml)
(if (and (fboundp 'org-format-latex-mathml-available-p)
(org-format-latex-mathml-available-p))
@@ -3792,18 +3721,18 @@ contextual information."
(when (memq processing-type '(mathml dvipng imagemagick))
(org-element-map tree '(latex-fragment latex-environment)
(lambda (latex-*)
- (incf count)
+ (cl-incf count)
(let* ((latex-frag (org-element-property :value latex-*))
(input-file (plist-get info :input-file))
(cache-dir (file-name-directory input-file))
(cache-subdir (concat
- (case processing-type
+ (cl-case processing-type
((dvipng imagemagick) "ltxpng/")
(mathml "ltxmathml/"))
(file-name-sans-extension
(file-name-nondirectory input-file))))
(display-msg
- (case processing-type
+ (cl-case processing-type
((dvipng imagemagick)
(format "Creating LaTeX Image %d..." count))
(mathml (format "Creating MathML snippet %d..." count))))
@@ -3817,7 +3746,7 @@ contextual information."
nil processing-type)
(buffer-substring-no-properties
(point-min) (point-max)))))
- (if (org-string-match-p "file:\\([^]]*\\)" link) link
+ (if (string-match-p "file:\\([^]]*\\)" link) link
(message "LaTeX Conversion failed.")
nil))))
(when org-link
@@ -3828,7 +3757,7 @@ contextual information."
(org-element-parse-secondary-string org-link '(link))
'link #'identity info t))
(replacement
- (case (org-element-type latex-*)
+ (cl-case (org-element-type latex-*)
;; Case 1: LaTeX environment. Mimic
;; a "standalone image or formula" by
;; enclosing the `link' in a `paragraph'.
@@ -3864,7 +3793,7 @@ contextual information."
;; This translator is necessary to handle indented tables in a uniform
;; manner. See comment in `org-odt--table'.
-(defun org-odt--translate-description-lists (tree backend info)
+(defun org-odt--translate-description-lists (tree _backend info)
;; OpenDocument has no notion of a description list. So simulate it
;; using plain lists. Description lists in the exported document
;; are typeset in the same manner as they are in a typical HTML
@@ -3897,7 +3826,7 @@ contextual information."
;;
(org-element-map tree 'plain-list
(lambda (el)
- (when (equal (org-element-property :type el) 'descriptive)
+ (when (eq (org-element-property :type el) 'descriptive)
(org-element-set-element
el
(apply 'org-element-adopt-elements
@@ -3960,7 +3889,7 @@ contextual information."
;; Translate lists to tables
-(defun org-odt--translate-list-tables (tree backend info)
+(defun org-odt--translate-list-tables (tree _backend info)
(org-element-map tree 'plain-list
(lambda (l1-list)
(when (org-export-read-attribute :attr_odt l1-list :list-table)
@@ -4021,42 +3950,38 @@ contextual information."
(insert
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n")
- (mapc
- (lambda (file-entry)
- (let* ((version (nth 2 file-entry))
- (extra (if (not version) ""
- (format " manifest:version=\"%s\"" version))))
- (insert
- (format org-odt-manifest-file-entry-tag
- (nth 0 file-entry) (nth 1 file-entry) extra))))
- org-odt-manifest-file-entries)
+ (dolist (file-entry org-odt-manifest-file-entries)
+ (let* ((version (nth 2 file-entry))
+ (extra (if (not version) ""
+ (format " manifest:version=\"%s\"" version))))
+ (insert
+ (format org-odt-manifest-file-entry-tag
+ (nth 0 file-entry) (nth 1 file-entry) extra))))
(insert "\n</manifest:manifest>"))))
(defmacro org-odt--export-wrap (out-file &rest body)
`(let* ((--out-file ,out-file)
(out-file-type (file-name-extension --out-file))
(org-odt-xml-files '("META-INF/manifest.xml" "content.xml"
- "meta.xml" "styles.xml"))
+ "meta.xml" "styles.xml"))
;; Initialize temporary workarea. All files that end up in
;; the exported document get parked/created here.
(org-odt-zip-dir (file-name-as-directory
- (make-temp-file (format "%s-" out-file-type) t)))
+ (make-temp-file (format "%s-" out-file-type) t)))
(org-odt-manifest-file-entries nil)
(--cleanup-xml-buffers
- (function
- (lambda nil
- ;; Kill all XML buffers.
- (mapc (lambda (file)
- (let ((buf (find-buffer-visiting
- (concat org-odt-zip-dir file))))
- (when buf
- (with-current-buffer buf
- (set-buffer-modified-p nil)
- (kill-buffer buf)))))
- org-odt-xml-files)
- ;; Delete temporary directory and also other embedded
- ;; files that get copied there.
- (delete-directory org-odt-zip-dir t)))))
+ (lambda ()
+ ;; Kill all XML buffers.
+ (dolist (file org-odt-xml-files)
+ (let ((buf (find-buffer-visiting
+ (concat org-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))))
+ ;; Delete temporary directory and also other embedded
+ ;; files that get copied there.
+ (delete-directory org-odt-zip-dir t))))
(condition-case err
(progn
(unless (executable-find "zip")
@@ -4079,16 +4004,15 @@ contextual information."
;; Write out the manifest entries before zipping
(org-odt-write-manifest-file)
;; Save all XML files.
- (mapc (lambda (file)
- (let ((buf (find-buffer-visiting
- (concat org-odt-zip-dir file))))
- (when buf
- (with-current-buffer buf
- ;; Prettify output if needed.
- (when org-odt-prettify-xml
- (indent-region (point-min) (point-max)))
- (save-buffer 0)))))
- org-odt-xml-files)
+ (dolist (file org-odt-xml-files)
+ (let ((buf (find-buffer-visiting
+ (concat org-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ ;; Prettify output if needed.
+ (when org-odt-prettify-xml
+ (indent-region (point-min) (point-max)))
+ (save-buffer 0)))))
;; Run zip.
(let* ((target --out-file)
(target-name (file-name-nondirectory target))
@@ -4106,19 +4030,17 @@ contextual information."
;; directory.
(with-current-buffer
(find-file-noselect (concat org-odt-zip-dir "content.xml") t)
- (mapc
- (lambda (cmd)
- (message "Running %s" (mapconcat 'identity cmd " "))
- (setq err-string
- (with-output-to-string
- (setq exitcode
- (apply 'call-process (car cmd)
- nil standard-output nil (cdr cmd)))))
- (or (zerop exitcode)
- (error (concat "Unable to create OpenDocument file."
- " Zip failed with error (%s)")
- err-string)))
- cmds)))
+ (dolist (cmd cmds)
+ (message "Running %s" (mapconcat 'identity cmd " "))
+ (setq err-string
+ (with-output-to-string
+ (setq exitcode
+ (apply 'call-process (car cmd)
+ nil standard-output nil (cdr cmd)))))
+ (or (zerop exitcode)
+ (error (concat "Unable to create OpenDocument file."
+ " Zip failed with error (%s)")
+ err-string)))))
;; Move the zip file from temporary work directory to
;; user-mandated location.
(rename-file (concat org-odt-zip-dir target-name) target)
@@ -4162,9 +4084,9 @@ MathML source to kill ring depending on the value of
(setq frag (and (setq frag (and (region-active-p)
(buffer-substring (region-beginning)
(region-end))))
- (loop for e in org-latex-regexps
- thereis (when (string-match (nth 1 e) frag)
- (match-string (nth 2 e) frag)))))
+ (cl-loop for e in org-latex-regexps
+ thereis (when (string-match (nth 1 e) frag)
+ (match-string (nth 2 e) frag)))))
(read-string "LaTeX Fragment: " frag nil frag))
,(let ((odf-filename (expand-file-name
(concat
@@ -4292,12 +4214,12 @@ Return output file's name."
(when out-fmt-spec
(throw 'done (cons (car e) out-fmt-spec))))))))
-(defun org-odt-do-convert (in-file out-fmt &optional prefix-arg)
+(defun org-odt-do-convert (in-file out-fmt &optional open)
"Workhorse routine for `org-odt-convert'."
(require 'browse-url)
- (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
- (dummy (or (file-readable-p in-file)
- (error "Cannot read %s" in-file)))
+ (let* ((in-file (let ((f (expand-file-name (or in-file buffer-file-name))))
+ (if (file-readable-p f) f
+ (error "Cannot read %s" in-file))))
(in-fmt (file-name-extension in-file))
(out-fmt (or out-fmt (error "Output format unspecified")))
(how (or (org-odt-reachable-p in-fmt out-fmt)
@@ -4327,7 +4249,7 @@ Return output file's name."
(cond
((file-exists-p out-file)
(message "Exported to %s" out-file)
- (when prefix-arg
+ (when open
(message "Opening %s..." out-file)
(org-open-file out-file 'system))
out-file)
@@ -4360,12 +4282,10 @@ form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
(defun org-odt-reachable-formats (in-fmt)
"Return list of formats to which IN-FMT can be converted.
The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
- (let (l)
- (mapc (lambda (e) (add-to-list 'l e))
- (apply 'append (mapcar
- (lambda (e) (mapcar 'car (cdr e)))
- (org-odt-do-reachable-formats in-fmt))))
- l))
+ (copy-sequence
+ (apply #'append (mapcar
+ (lambda (e) (mapcar #'car (cdr e)))
+ (org-odt-do-reachable-formats in-fmt)))))
(defun org-odt-convert-read-params ()
"Return IN-FILE and OUT-FMT params for `org-odt-do-convert'.
@@ -4385,25 +4305,23 @@ This is a helper routine for interactive use."
(list in-file out-fmt)))
;;;###autoload
-(defun org-odt-convert (&optional in-file out-fmt prefix-arg)
+(defun org-odt-convert (&optional in-file out-fmt open)
"Convert IN-FILE to format OUT-FMT using a command line converter.
IN-FILE is the file to be converted. If unspecified, it defaults
to variable `buffer-file-name'. OUT-FMT is the desired output
-format. Use `org-odt-convert-process' as the converter.
-If PREFIX-ARG is non-nil then the newly converted file is opened
-using `org-open-file'."
+format. Use `org-odt-convert-process' as the converter. If OPEN
+is non-nil then the newly converted file is opened using
+`org-open-file'."
(interactive
(append (org-odt-convert-read-params) current-prefix-arg))
- (org-odt-do-convert in-file out-fmt prefix-arg))
+ (org-odt-do-convert in-file out-fmt open))
;;; Library Initializations
-(mapc
- (lambda (desc)
- ;; Let Emacs open all OpenDocument files in archive mode
- (add-to-list 'auto-mode-alist
- (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
- org-odt-file-extensions)
+(dolist (desc org-odt-file-extensions)
+ ;; Let Emacs open all OpenDocument files in archive mode.
+ (add-to-list 'auto-mode-alist
+ (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
(provide 'ox-odt)
diff --git a/lisp/ox-org.el b/lisp/ox-org.el
index d9af3f7..b8cd15d 100644
--- a/lisp/ox-org.el
+++ b/lisp/ox-org.el
@@ -1,4 +1,4 @@
-;;; ox-org.el --- Org Back-End for Org Export Engine
+;;; ox-org.el --- Org Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
@@ -25,7 +25,8 @@
;;; Code:
(require 'ox)
-(declare-function htmlize-buffer "htmlize" (&optional buffer))
+(declare-function htmlize-buffer "ext:htmlize" (&optional buffer))
+(defvar htmlize-output-type)
(defgroup org-export-org nil
"Options for exporting Org mode files to Org."
@@ -34,8 +35,6 @@
:version "24.4"
:package-version '(Org . "8.0"))
-(define-obsolete-variable-alias
- 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4")
(defcustom org-org-htmlized-css-url nil
"URL pointing to the CSS defining colors for htmlized Emacs buffers.
Normally when creating an htmlized version of an Org buffer,
@@ -62,6 +61,7 @@ setting of `org-html-htmlize-output-type' is `css'."
(dynamic-block . org-org-identity)
(entity . org-org-identity)
(example-block . org-org-identity)
+ (export-block . org-org-export-block)
(fixed-width . org-org-identity)
(footnote-definition . ignore)
(footnote-reference . org-org-identity)
@@ -109,7 +109,13 @@ setting of `org-html-htmlize-output-type' is `css'."
(if a (org-org-export-to-org t s v b)
(org-open-file (org-org-export-to-org nil s v b))))))))
-(defun org-org-identity (blob contents info)
+(defun org-org-export-block (export-block _contents _info)
+ "Transcode a EXPORT-BLOCK element from Org to LaTeX.
+CONTENTS and INFO are ignored."
+ (and (equal (org-element-property :type export-block) "ORG")
+ (org-element-property :value export-block)))
+
+(defun org-org-identity (blob contents _info)
"Transcode BLOB element or object back into Org syntax.
CONTENTS is its contents, as a string or nil. INFO is ignored."
(let ((case-fold-search t))
@@ -131,7 +137,7 @@ CONTENTS is its contents, as a string or nil. INFO is ignored."
(org-export-get-relative-level headline info))
(org-element-headline-interpreter headline contents)))
-(defun org-org-keyword (keyword contents info)
+(defun org-org-keyword (keyword _contents _info)
"Transcode KEYWORD element back into Org syntax.
CONTENTS is nil. INFO is ignored."
(let ((key (org-element-property :key keyword)))
@@ -139,7 +145,7 @@ CONTENTS is nil. INFO is ignored."
'("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE"))
(org-element-keyword-interpreter keyword nil))))
-(defun org-org-link (link contents info)
+(defun org-org-link (link contents _info)
"Transcode LINK object back into Org syntax.
CONTENTS is the description of the link, as a string, or nil.
INFO is a plist containing current export state."
@@ -202,7 +208,7 @@ a communication channel."
(mapconcat
(lambda (d)
(org-element-normalize-string
- (concat (format "[%s] "(car d))
+ (concat (format "[fn:%s] "(car d))
(org-export-data (cdr d) info))))
footnotes-alist "\n"))))
(make-string (or (org-element-property :post-blank section) 0) ?\n)))
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index 8e20a81..102f460 100644
--- a/lisp/ox-publish.el
+++ b/lisp/ox-publish.el
@@ -1,4 +1,4 @@
-;;; ox-publish.el --- Publish Related Org Mode Files as a Website
+;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2016 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
@@ -38,7 +38,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'format-spec)
(require 'ox)
@@ -61,15 +61,16 @@ the name of the original file and the name of the file
produced.")
(defgroup org-publish nil
- "Options for publishing a set of Org-mode and related files."
+ "Options for publishing a set of files."
:tag "Org Publishing"
:group 'org)
(defcustom org-publish-project-alist nil
"Association list to control publishing behavior.
-Each element of the alist is a publishing project. The CAR of
+\\<org-mode-map>
+Each element of the alist is a publishing project. The car of
each element is a string, uniquely identifying the project. The
-CDR of each element is in one of the following forms:
+cdr of each element is in one of the following forms:
1. A well-formed property list with an even number of elements,
alternating keys and values, specifying parameters for the
@@ -86,7 +87,7 @@ When the CDR of an element of org-publish-project-alist is in
this second form, the elements of the list after `:components'
are taken to be components of the project, which group together
files requiring different publishing options. When you publish
-such a project with \\[org-publish], the components all publish.
+such a project with `\\[org-publish]', the components all publish.
When a property is given a value in `org-publish-project-alist',
its setting overrides the value of the corresponding user
@@ -110,6 +111,9 @@ Most properties are optional, but some should always be set:
Directory (possibly remote) where output files will be
published.
+If `:recursive' is non-nil files in sub-directories of
+`:base-directory' are considered.
+
The `:exclude' property may be used to prevent certain files from
being published. Its value may be a string or regexp matching
file names you don't want to be published.
@@ -141,12 +145,16 @@ date.
`:preparation-function'
Function to be called before publishing this project. This
- may also be a list of functions.
+ may also be a list of functions. Preparation functions are
+ called with the project properties list as their sole
+ argument.
`:completion-function'
Function to be called after publishing this project. This
- may also be a list of functions.
+ may also be a list of functions. Completion functions are
+ called with the project properties list as their sole
+ argument.
Some properties control details of the Org publishing process,
and are equivalent to the corresponding user variables listed in
@@ -341,7 +349,7 @@ You could use brackets to delimit on what part the link will be.
(concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
(defun org-publish-needed-p
- (filename &optional pub-dir pub-func true-pub-dir base-dir)
+ (filename &optional pub-dir pub-func _true-pub-dir base-dir)
"Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC.
TRUE-PUB-DIR is where the file will truly end up. Currently we
are not using this - maybe it can eventually be used to check if
@@ -358,7 +366,7 @@ still decide about that independently."
rtn))
(defun org-publish-update-timestamp
- (filename &optional pub-dir pub-func base-dir)
+ (filename &optional pub-dir pub-func _base-dir)
"Update publishing timestamp for file FILENAME.
If there is no timestamp, create one."
(let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
@@ -367,10 +375,9 @@ If there is no timestamp, create one."
(defun org-publish-remove-all-timestamps ()
"Remove all files in the timestamp directory."
- (let ((dir org-publish-timestamp-directory)
- files)
+ (let ((dir org-publish-timestamp-directory))
(when (and (file-exists-p dir) (file-directory-p dir))
- (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
+ (mapc #'delete-file (directory-files dir 'full "[^.]\\'"))
(org-publish-reset-cache))))
@@ -403,12 +410,12 @@ This splices all the components into the list."
(when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
;; First we sort files:
(when org-publish-sitemap-sort-files
- (case org-publish-sitemap-sort-files
- (alphabetically
+ (pcase org-publish-sitemap-sort-files
+ (`alphabetically
(let* ((adir (file-directory-p a))
- (aorg (and (string-match "\\.org$" a) (not adir)))
+ (aorg (and (string-suffix-p ".org" a) (not adir)))
(bdir (file-directory-p b))
- (borg (and (string-match "\\.org$" b) (not bdir)))
+ (borg (and (string-suffix-p ".org" b) (not bdir)))
(A (if aorg (concat (file-name-directory a)
(org-publish-find-title a)) a))
(B (if borg (concat (file-name-directory b)
@@ -416,57 +423,56 @@ This splices all the components into the list."
(setq retval (if org-publish-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
- ((anti-chronologically chronologically)
+ ((or `anti-chronologically `chronologically)
(let* ((adate (org-publish-find-date a))
(bdate (org-publish-find-date b))
(A (+ (lsh (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate))))
(setq retval
- (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B)
+ (if (eq org-publish-sitemap-sort-files 'chronologically)
+ (<= A B)
(>= A B)))))))
;; Directory-wise wins:
(when org-publish-sitemap-sort-folders
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
- (setq retval (equal org-publish-sitemap-sort-folders 'first)))
+ (setq retval (eq org-publish-sitemap-sort-folders 'first)))
;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
- (setq retval (equal org-publish-sitemap-sort-folders 'last))))))
+ (setq retval (eq org-publish-sitemap-sort-folders 'last))))))
retval))
(defun org-publish-get-base-files-1
- (base-dir &optional recurse match skip-file skip-dir)
+ (base-dir &optional recurse match skip-file skip-dir)
"Set `org-publish-temp-files' with files from BASE-DIR directory.
If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
non-nil, restrict this list to the files matching the regexp
MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
matching the regexp SKIP-DIR when recursing through BASE-DIR."
- (mapc (lambda (f)
- (let ((fd-p (file-directory-p f))
- (fnd (file-name-nondirectory f)))
- (if (and fd-p recurse
- (not (string-match "^\\.+$" fnd))
- (if skip-dir (not (string-match skip-dir fnd)) t))
- (org-publish-get-base-files-1
- f recurse match skip-file skip-dir)
- (unless (or fd-p ;; this is a directory
- (and skip-file (string-match skip-file fnd))
- (not (file-exists-p (file-truename f)))
- (not (string-match match fnd)))
-
- (pushnew f org-publish-temp-files)))))
- (let ((all-files (if (not recurse) (directory-files base-dir t match)
- ;; If RECURSE is non-nil, we want all files
- ;; matching MATCH and sub-directories.
- (org-remove-if-not
- (lambda (file)
- (or (file-directory-p file)
- (and match (string-match match file))))
- (directory-files base-dir t)))))
- (if (not org-publish-sitemap-requested) all-files
- (sort all-files 'org-publish-compare-directory-files)))))
+ (let ((all-files (if (not recurse) (directory-files base-dir t match)
+ ;; If RECURSE is non-nil, we want all files
+ ;; matching MATCH and sub-directories.
+ (cl-remove-if-not
+ (lambda (file)
+ (or (file-directory-p file)
+ (and match (string-match match file))))
+ (directory-files base-dir t)))))
+ (dolist (f (if (not org-publish-sitemap-requested) all-files
+ (sort all-files #'org-publish-compare-directory-files)))
+ (let ((fd-p (file-directory-p f))
+ (fnd (file-name-nondirectory f)))
+ (if (and fd-p recurse
+ (not (string-match "^\\.+$" fnd))
+ (if skip-dir (not (string-match skip-dir fnd)) t))
+ (org-publish-get-base-files-1
+ f recurse match skip-file skip-dir)
+ (unless (or fd-p ; This is a directory.
+ (and skip-file (string-match skip-file fnd))
+ (not (file-exists-p (file-truename f)))
+ (not (string-match match fnd)))
+ (cl-pushnew f org-publish-temp-files)))))))
(defun org-publish-get-base-files (project &optional exclude-regexp)
"Return a list of all files in PROJECT.
@@ -508,19 +514,16 @@ matching filenames."
(setq org-publish-sitemap-sort-folders nil))
(setq org-publish-temp-files nil)
- (if org-publish-sitemap-requested
- (pushnew (expand-file-name (concat base-dir sitemap-filename))
+ (when org-publish-sitemap-requested
+ (cl-pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match
;; FIXME distinguish exclude regexp
;; for skip-file and skip-dir?
exclude-regexp exclude-regexp)
- (mapc (lambda (f)
- (pushnew
- (expand-file-name (concat base-dir f))
- org-publish-temp-files))
- include-list)
- org-publish-temp-files))
+ (dolist (f include-list org-publish-temp-files)
+ (cl-pushnew (expand-file-name (concat base-dir f))
+ org-publish-temp-files))))
(defun org-publish-get-project-from-filename (filename &optional up)
"Return the project that FILENAME belongs to."
@@ -541,9 +544,7 @@ matching filenames."
(when
(or (and i
(member filename
- (mapcar (lambda (file)
- (expand-file-name file b))
- i)))
+ (dolist (file i) (expand-file-name file b))))
(and (not (and e (string-match e filename)))
(string-match xm filename)))
(setq project-name (car prj))
@@ -575,29 +576,30 @@ Return output file name."
(unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
;; Check if a buffer visiting FILENAME is already open.
(let* ((org-inhibit-startup t)
- (visitingp (find-buffer-visiting filename))
- (work-buffer (or visitingp (find-file-noselect filename))))
- (prog1 (with-current-buffer work-buffer
- (let ((output-file
- (org-export-output-file-name extension nil pub-dir))
- (body-p (plist-get plist :body-only)))
- (org-export-to-file backend output-file
- nil nil nil body-p
- ;; Add `org-publish--collect-references' and
- ;; `org-publish-collect-index' to final output
- ;; filters. The latter isn't dependent on
- ;; `:makeindex', since we want to keep it up-to-date
- ;; in cache anyway.
- (org-combine-plists
- plist
- `(:filter-final-output
- ,(cons 'org-publish--collect-references
- (cons 'org-publish-collect-index
- (plist-get plist :filter-final-output))))))))
+ (visiting (find-buffer-visiting filename))
+ (work-buffer (or visiting (find-file-noselect filename))))
+ (unwind-protect
+ (with-current-buffer work-buffer
+ (let ((output (org-export-output-file-name extension nil pub-dir)))
+ (org-export-to-file backend output
+ nil nil nil (plist-get plist :body-only)
+ ;; Add `org-publish--store-crossrefs' and
+ ;; `org-publish-collect-index' to final output filters.
+ ;; The latter isn't dependent on `:makeindex', since we
+ ;; want to keep it up-to-date in cache anyway.
+ (org-combine-plists
+ plist
+ `(:crossrefs
+ ,(org-publish-cache-get-file-property
+ (expand-file-name filename) :crossrefs nil t)
+ :filter-final-output
+ (org-publish--store-crossrefs
+ org-publish-collect-index
+ ,@(plist-get plist :filter-final-output)))))))
;; Remove opened buffer in the process.
- (unless visitingp (kill-buffer work-buffer)))))
+ (unless visiting (kill-buffer work-buffer)))))
-(defun org-publish-attachment (plist filename pub-dir)
+(defun org-publish-attachment (_plist filename pub-dir)
"Publish a file with no transformation of any kind.
FILENAME is the filename of the Org file to be published. PLIST
@@ -621,10 +623,10 @@ Return output file name."
(defun org-publish-file (filename &optional project no-cache)
"Publish file FILENAME from PROJECT.
-If NO-CACHE is not nil, do not initialize org-publish-cache and
-write it to disk. This is needed, since this function is used to
-publish single files, when entire projects are published.
-See `org-publish-projects'."
+If NO-CACHE is not nil, do not initialize `org-publish-cache'.
+This is needed, since this function is used to publish single
+files, when entire projects are published (see
+`org-publish-projects')."
(let* ((project
(or project
(or (org-publish-get-project-from-filename filename)
@@ -666,53 +668,54 @@ See `org-publish-projects'."
(run-hook-with-args 'org-publish-after-publishing-hook
filename
output))))
- (unless no-cache (org-publish-write-cache-file))))
+ ;; Make sure to write cache to file after successfully publishing
+ ;; a file, so as to minimize impact of a publishing failure.
+ (org-publish-write-cache-file)))
(defun org-publish-projects (projects)
"Publish all files belonging to the PROJECTS alist.
If `:auto-sitemap' is set, publish the sitemap too. If
-`:makeindex' is set, also produce a file theindex.org."
- (mapc
- (lambda (project)
- ;; Each project uses its own cache file:
- (org-publish-initialize-cache (car project))
- (let* ((project-plist (cdr project))
- (exclude-regexp (plist-get project-plist :exclude))
- (sitemap-p (plist-get project-plist :auto-sitemap))
- (sitemap-filename (or (plist-get project-plist :sitemap-filename)
- "sitemap.org"))
- (sitemap-function (or (plist-get project-plist :sitemap-function)
- 'org-publish-org-sitemap))
- (org-publish-sitemap-date-format
- (or (plist-get project-plist :sitemap-date-format)
- org-publish-sitemap-date-format))
- (org-publish-sitemap-file-entry-format
- (or (plist-get project-plist :sitemap-file-entry-format)
- org-publish-sitemap-file-entry-format))
- (preparation-function
- (plist-get project-plist :preparation-function))
- (completion-function (plist-get project-plist :completion-function))
- (files (org-publish-get-base-files project exclude-regexp))
- (theindex
+`:makeindex' is set, also produce a file \"theindex.org\"."
+ (dolist (project (org-publish-expand-projects projects))
+ (let ((project-plist (cdr project)))
+ (let ((fun (plist-get project-plist :preparation-function)))
+ (cond ((consp fun) (dolist (f fun) (funcall f project-plist)))
+ ((functionp fun) (funcall fun project-plist))))
+ ;; Each project uses its own cache file.
+ (org-publish-initialize-cache (car project))
+ (when (plist-get project-plist :auto-sitemap)
+ (let ((sitemap-filename
+ (or (plist-get project-plist :sitemap-filename)
+ "sitemap.org"))
+ (sitemap-function
+ (or (plist-get project-plist :sitemap-function)
+ #'org-publish-org-sitemap))
+ (org-publish-sitemap-date-format
+ (or (plist-get project-plist :sitemap-date-format)
+ org-publish-sitemap-date-format))
+ (org-publish-sitemap-file-entry-format
+ (or (plist-get project-plist :sitemap-file-entry-format)
+ org-publish-sitemap-file-entry-format)))
+ (funcall sitemap-function project sitemap-filename)))
+ ;; Publish all files from PROJECT excepted "theindex.org". Its
+ ;; publishing will be deferred until "theindex.inc" is
+ ;; populated.
+ (let ((theindex
(expand-file-name "theindex.org"
- (plist-get project-plist :base-directory))))
- (when preparation-function (run-hooks 'preparation-function))
- (if sitemap-p (funcall sitemap-function project sitemap-filename))
- ;; Publish all files from PROJECT excepted "theindex.org". Its
- ;; publishing will be deferred until "theindex.inc" is
- ;; populated.
- (dolist (file files)
- (unless (equal file theindex)
- (org-publish-file file project t)))
- ;; Populate "theindex.inc", if needed, and publish
- ;; "theindex.org".
- (when (plist-get project-plist :makeindex)
- (org-publish-index-generate-theindex
- project (plist-get project-plist :base-directory))
- (org-publish-file theindex project t))
- (when completion-function (run-hooks 'completion-function))
- (org-publish-write-cache-file)))
- (org-publish-expand-projects projects)))
+ (plist-get project-plist :base-directory)))
+ (exclude-regexp (plist-get project-plist :exclude)))
+ (dolist (file (org-publish-get-base-files project exclude-regexp))
+ (unless (equal file theindex) (org-publish-file file project t)))
+ ;; Populate "theindex.inc", if needed, and publish
+ ;; "theindex.org".
+ (when (plist-get project-plist :makeindex)
+ (org-publish-index-generate-theindex
+ project (plist-get project-plist :base-directory))
+ (org-publish-file theindex project t)))
+ (let ((fun (plist-get project-plist :completion-function)))
+ (cond ((consp fun) (dolist (f fun) (funcall f project-plist)))
+ ((functionp fun) (funcall fun project-plist))))
+ (org-publish-write-cache-file))))
(defun org-publish-org-sitemap (project &optional sitemap-filename)
"Create a sitemap of pages in set defined by PROJECT.
@@ -734,7 +737,6 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
(sitemap-sans-extension
(plist-get project-plist :sitemap-sans-extension))
(visiting (find-buffer-visiting sitemap-filename))
- (ifn (file-name-nondirectory sitemap-filename))
file sitemap-buffer)
(with-current-buffer
(let ((org-inhibit-startup t))
@@ -743,8 +745,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
(erase-buffer)
(insert (concat "#+TITLE: " sitemap-title "\n\n"))
(while (setq file (pop files))
- (let ((fn (file-name-nondirectory file))
- (link (file-relative-name file dir))
+ (let ((link (file-relative-name file dir))
(oldlocal localdir))
(when sitemap-sans-extension
(setq link (file-name-sans-extension link)))
@@ -874,8 +875,8 @@ When optional argument FORCE is non-nil, force publishing all
files in PROJECT. With a non-nil optional argument ASYNC,
publishing will be done asynchronously, in another process."
(interactive
- (list (assoc (org-icompleting-read "Publish project: "
- org-publish-project-alist nil t)
+ (list (assoc (completing-read "Publish project: "
+ org-publish-project-alist nil t)
org-publish-project-alist)
current-prefix-arg))
(let ((project (if (not (stringp project)) project
@@ -885,7 +886,7 @@ publishing will be done asynchronously, in another process."
(cond
((not project))
(async
- (org-export-async-start (lambda (results) nil)
+ (org-export-async-start (lambda (_) nil)
`(let ((org-publish-use-timestamps-flag
,(and (not force) org-publish-use-timestamps-flag)))
;; Expand components right now as external process may not
@@ -906,7 +907,7 @@ optional argument ASYNC, publishing will be done asynchronously,
in another process."
(interactive "P")
(if async
- (org-export-async-start (lambda (results) nil)
+ (org-export-async-start (lambda (_) nil)
`(progn
(when ',force (org-publish-remove-all-timestamps))
(let ((org-publish-use-timestamps-flag
@@ -928,7 +929,7 @@ asynchronously, in another process."
(interactive "P")
(let ((file (buffer-file-name (buffer-base-buffer))))
(if async
- (org-export-async-start (lambda (results) nil)
+ (org-export-async-start (lambda (_) nil)
`(let ((org-publish-use-timestamps-flag
(if ',force nil ,org-publish-use-timestamps-flag)))
(org-publish-file ,file)))
@@ -954,7 +955,7 @@ the project."
;;; Index generation
-(defun org-publish-collect-index (output backend info)
+(defun org-publish-collect-index (output _backend info)
"Update index for a file in cache.
OUTPUT is the output from transcoding current file. BACKEND is
@@ -1027,10 +1028,11 @@ publishing directory."
;; Compute the first difference between last entry and
;; current one: it tells the level at which new items
;; should be added.
- (let* ((rank (if (equal entry last-entry) (1- (length entry))
- (loop for n from 0 to (length entry)
- unless (equal (nth n entry) (nth n last-entry))
- return n)))
+ (let* ((rank
+ (if (equal entry last-entry) (1- (length entry))
+ (cl-loop for n from 0 to (length entry)
+ unless (equal (nth n entry) (nth n last-entry))
+ return n)))
(len (length (nthcdr rank entry))))
;; For each term after the first difference, create
;; a new sub-list with the term as body. Moreover,
@@ -1045,11 +1047,11 @@ publishing directory."
(format
"[[%s][%s]]"
;; Destination.
- (case (car target)
- ('nil (format "file:%s" file))
- (id (format "id:%s" (cdr target)))
- (custom-id (format "file:%s::#%s" file (cdr target)))
- (otherwise (format "file:%s::*%s" file (cdr target))))
+ (pcase (car target)
+ (`nil (format "file:%s" file))
+ (`id (format "id:%s" (cdr target)))
+ (`custom-id (format "file:%s::#%s" file (cdr target)))
+ (_ (format "file:%s::*%s" file (cdr target))))
;; Description.
(car (last entry)))))
"\n"))))
@@ -1068,103 +1070,63 @@ publishing directory."
;; This part implements tools to resolve [[file.org::*Some headline]]
;; links, where "file.org" belongs to the current project.
-(defun org-publish--collect-references (output backend info)
- "Store headlines references for current published file.
+(defun org-publish--store-crossrefs (output _backend info)
+ "Store cross-references for current published file.
OUPUT is the produced output, as a string. BACKEND is the export
back-end used, as a symbol. INFO is the final export state, as
a plist.
-References are stored as an alist ((TYPE SEARCH) . VALUE) where
-
- TYPE is a symbol among `headline', `custom-id', `target' and
- `other'.
-
- SEARCH is the string a link is expected to match. It is
-
- - headline's title, as a string, with all whitespace
- characters and statistics cookies removed, if TYPE is
- `headline'.
-
- - CUSTOM_ID value if TYPE is `custom-id'.
-
- - target's or radio-target's name if TYPE is `target'.
-
- - NAME affiliated keyword is TYPE is `other'.
-
- VALUE is an internal reference used in the document, as
- a string.
-
-This function is meant to be used as a final out filter. See
+This function is meant to be used as a final output filter. See
`org-publish-org-to'."
(org-publish-cache-set-file-property
- (plist-get info :input-file) :references
- (let (refs)
- (when (hash-table-p (plist-get info :internal-references))
- (maphash
- (lambda (k v)
- (case (org-element-type k)
- ((headline inlinetask)
- (push (cons
- (cons 'headline
- (org-split-string
- (replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (org-element-property :raw-value k))))
- v)
- refs)
- (let ((custom-id (org-element-property :CUSTOM_ID k)))
- (when custom-id
- (push (cons (cons 'custom-id custom-id) v) refs))))
- ((radio-target target)
- (push
- (cons (cons 'target
- (org-split-string (org-element-property :value k)))
- v)
- refs))
- ((org-element-property :name k)
- (push
- (cons
- (cons 'other (org-split-string (org-element-property :name k)))
- v)
- refs)))
- refs)
- (plist-get info :internal-references)))
- refs))
+ (plist-get info :input-file) :crossrefs
+ ;; Update `:crossrefs' so as to remove unused references and search
+ ;; cells. Actually used references are extracted from
+ ;; `:internal-references', with references as strings removed. See
+ ;; `org-export-get-reference' for details.
+ (cl-remove-if (lambda (pair) (stringp (car pair)))
+ (plist-get info :internal-references)))
;; Return output unchanged.
output)
(defun org-publish-resolve-external-link (search file)
- "Return reference for elements or objects matching SEARCH in FILE.
+ "Return reference for element matching string SEARCH in FILE.
Return value is an internal reference, as a string.
-This function allows the resolution of external links like:
+This function allows resolving external links with a search
+option, e.g.,
- [[file.org::*fuzzy][description]]
+ [[file.org::*heading][description]]
[[file.org::#custom-id][description]]
- [[file.org::fuzzy][description]]"
+ [[file.org::fuzzy][description]]
+
+It only makes sense to use this if export back-end builds
+references with `org-export-get-reference'."
(if (not org-publish-cache)
(progn
- (message "Reference \"%s\" in file \"%s\" cannot be resolved without \
-publishing"
+ (message "Reference %S in file %S cannot be resolved without publishing"
search
file)
"MissingReference")
- (let ((references (org-publish-cache-get-file-property
- (expand-file-name file) :references nil t)))
- (cond
- ((cdr (case (aref search 0)
- (?* (assoc (cons 'headline (org-split-string (substring search 1)))
- references))
- (?# (assoc (cons 'custom-id (substring search 1)) references))
- (t
- (let ((s (org-split-string search)))
- (or (assoc (cons 'target s) references)
- (assoc (cons 'other s) references)
- (assoc (cons 'headline s) references)))))))
- (t (message "Unknown cross-reference \"%s\" in file \"%s\"" search file)
- "MissingReference")))))
+ (let* ((filename (expand-file-name file))
+ (crossrefs
+ (org-publish-cache-get-file-property filename :crossrefs nil t))
+ (cells (org-export-string-to-search-cell search)))
+ (or
+ ;; Look for reference associated to search cells triggered by
+ ;; LINK. It can match when targeted file has been published
+ ;; already.
+ (let ((known (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells))))
+ (and known (org-export-format-reference known)))
+ ;; Search cell is unknown so far. Generate a new internal
+ ;; reference that will be used when the targeted file will be
+ ;; published.
+ (let ((new (org-export-new-reference crossrefs)))
+ (dolist (cell cells) (push (cons cell new) crossrefs))
+ (org-publish-cache-set-file-property filename :crossrefs crossrefs)
+ (org-export-format-reference new))))))
@@ -1181,13 +1143,12 @@ If FREE-CACHE, empty the cache."
(error "Cannot find cache-file name in `org-publish-write-cache-file'"))
(with-temp-file cache-file
(let (print-level print-length)
- (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
+ (insert "(setq org-publish-cache \
+\(make-hash-table :test 'equal :weakness nil :size 100))\n")
(maphash (lambda (k v)
(insert
- (format (concat "(puthash %S "
- (if (or (listp v) (symbolp v))
- "'" "")
- "%S org-publish-cache)\n") k v)))
+ (format "(puthash %S %s%S org-publish-cache)\n"
+ k (if (or (listp v) (symbolp v)) "'" "") v)))
org-publish-cache)))
(when free-cache (org-publish-reset-cache))))
@@ -1195,7 +1156,8 @@ If FREE-CACHE, empty the cache."
"Initialize the projects cache if not initialized yet and return it."
(unless project-name
- (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
+ (error "Cannot initialize `org-publish-cache' without projects name in \
+`org-publish-initialize-cache'"))
(unless (file-exists-p org-publish-timestamp-directory)
(make-directory org-publish-timestamp-directory t))
@@ -1229,7 +1191,7 @@ If FREE-CACHE, empty the cache."
(setq org-publish-cache nil))
(defun org-publish-cache-file-needs-publishing
- (filename &optional pub-dir pub-func base-dir)
+ (filename &optional pub-dir pub-func _base-dir)
"Check the timestamp of the last publishing of FILENAME.
Return non-nil if the file needs publishing. Also check if
any included files have been more recently published, so that
@@ -1242,38 +1204,38 @@ the file including them will be republished as well."
(pstamp (org-publish-cache-get key))
(org-inhibit-startup t)
(visiting (find-buffer-visiting filename))
- included-files-ctime buf)
+ (buf (find-file-noselect (expand-file-name filename)))
+ included-files-ctime)
(when (equal (file-name-extension filename) "org")
- (setq buf (find-file (expand-file-name filename)))
- (with-current-buffer buf
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
- (let* ((element (org-element-at-point))
- (included-file
- (and (eq (org-element-type element) 'keyword)
- (let ((value (org-element-property :value element)))
- (and value
- (string-match
- "\\`\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)"
- value)
- (let ((m (match-string 1 value)))
- (org-remove-double-quotes
- ;; Ignore search suffix.
- (if (string-match "\\(::\\(.*?\\)\\)\"?\\'" m)
- (substring m 0 (match-beginning 0))
- m))))))))
- (when included-file
- (add-to-list 'included-files-ctime
- (org-publish-cache-ctime-of-src
- (expand-file-name included-file))
- t)))))
- (unless visiting (kill-buffer buf)))
- (if (null pstamp) t
- (let ((ctime (org-publish-cache-ctime-of-src filename)))
- (or (< pstamp ctime)
- (when included-files-ctime
- (not (null (delq nil (mapcar (lambda (ct) (< ctime ct))
- included-files-ctime))))))))))
+ (unwind-protect
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
+ (let* ((element (org-element-at-point))
+ (included-file
+ (and (eq (org-element-type element) 'keyword)
+ (let ((value (org-element-property :value element)))
+ (and value
+ (string-match
+ "\\`\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)"
+ value)
+ (let ((m (match-string 1 value)))
+ (org-unbracket-string
+ "\"" "\""
+ ;; Ignore search suffix.
+ (if (string-match "\\(::\\(.*?\\)\\)\"?\\'"
+ m)
+ (substring m 0 (match-beginning 0))
+ m))))))))
+ (when included-file
+ (push (org-publish-cache-ctime-of-src
+ (expand-file-name included-file))
+ included-files-ctime)))))
+ (unless visiting (kill-buffer buf))))
+ (or (null pstamp)
+ (let ((ctime (org-publish-cache-ctime-of-src filename)))
+ (or (< pstamp ctime)
+ (cl-some (lambda (ct) (< ctime ct)) included-files-ctime))))))
(defun org-publish-cache-set-file-property
(filename property value &optional project-name)
@@ -1290,9 +1252,9 @@ will be created. Return VALUE."
(defun org-publish-cache-get-file-property
(filename property &optional default no-create project-name)
"Return the value for a PROPERTY of file FILENAME in publishing cache.
-Use cache file of PROJECT-NAME. Return the value of that PROPERTY
-or DEFAULT, if the value does not yet exist. If the entry will
-be created, unless NO-CREATE is not nil."
+Use cache file of PROJECT-NAME. Return the value of that
+PROPERTY or DEFAULT, if the value does not yet exist. If the
+entry will be created, unless NO-CREATE is not nil."
;; Evtl. load the requested cache file:
(if project-name (org-publish-initialize-cache project-name))
(let ((pl (org-publish-cache-get filename)) retval)
diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el
index 610874b..cf9cc2f 100644
--- a/lisp/ox-texinfo.el
+++ b/lisp/ox-texinfo.el
@@ -1,4 +1,4 @@
-;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine
+;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
@@ -25,7 +25,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox)
(defvar orgtbl-exp-regexp)
@@ -68,6 +68,7 @@
(special-block . org-texinfo-special-block)
(src-block . org-texinfo-src-block)
(statistics-cookie . org-texinfo-statistics-cookie)
+ (strike-through . org-texinfo-strike-through)
(subscript . org-texinfo-subscript)
(superscript . org-texinfo-superscript)
(table . org-texinfo-table)
@@ -76,9 +77,9 @@
(target . org-texinfo-target)
(template . org-texinfo-template)
(timestamp . org-texinfo-timestamp)
+ (underline . org-texinfo-underline)
(verbatim . org-texinfo-verbatim)
(verse-block . org-texinfo-verse-block))
- :export-block "TEXINFO"
:filters-alist
'((:filter-headline . org-texinfo--filter-section-blank-lines)
(:filter-parse-tree . org-texinfo--normalize-headlines)
@@ -223,7 +224,7 @@ TAGS the tags as a list of strings (list of strings or nil).
The function result will be used in the section format string."
:group 'org-export-texinfo
:type 'function
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3"))
;;;; Node listing (menu)
@@ -287,29 +288,28 @@ When nil, no transformation is made."
(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}")
(code . code)
(italic . "@emph{%s}")
- (verbatim . verb)
- (comment . "@c %s"))
+ (verbatim . verb))
"Alist of Texinfo expressions to convert text markup.
-The key must be a symbol among `bold', `italic' and `comment'.
-The value is a formatting string to wrap fontified text with.
+The key must be a symbol among `bold', `code', `italic',
+`strike-through', `underscore' and `verbatim'. The value is
+a formatting string to wrap fontified text with.
Value can also be set to the following symbols: `verb' and
-`code'. For the former, Org will use \"@verb\" to
-create a format string and select a delimiter character that
-isn't in the string. For the latter, Org will use \"@code\"
-to typeset and try to protect special characters.
+`code'. For the former, Org will use \"@verb\" to create
+a format string and select a delimiter character that isn't in
+the string. For the latter, Org will use \"@code\" to typeset
+and try to protect special characters.
If no association can be found for a given markup, text will be
returned as-is."
:group 'org-export-texinfo
:type 'alist
- :options '(bold code italic verbatim comment))
+ :options '(bold code italic strike-through underscore verbatim))
;;;; Drawers
-(defcustom org-texinfo-format-drawer-function
- (lambda (name contents) contents)
+(defcustom org-texinfo-format-drawer-function (lambda (_name contents) contents)
"Function called to format a drawer in Texinfo code.
The function must accept two parameters:
@@ -393,12 +393,11 @@ If two strings share the same prefix (e.g. \"ISO-8859-1\" and
;;; Internal Functions
-(defun org-texinfo--filter-section-blank-lines (headline back-end info)
+(defun org-texinfo--filter-section-blank-lines (headline _backend _info)
"Filter controlling number of blank lines after a section."
- (let ((blanks (make-string 2 ?\n)))
- (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))
+ (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" "\n\n" headline))
-(defun org-texinfo--normalize-headlines (tree back-end info)
+(defun org-texinfo--normalize-headlines (tree _backend info)
"Normalize headlines in TREE.
BACK-END is the symbol specifying back-end used for export. INFO
@@ -427,37 +426,24 @@ Return new tree."
"Return a character not used in string S.
This is used to choose a separator for constructs like \\verb."
(let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
- (loop for c across ll
- when (not (string-match (regexp-quote (char-to-string c)) s))
- return (char-to-string c))))
+ (cl-loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
-(defun org-texinfo--text-markup (text markup info)
+(defun org-texinfo--text-markup (text markup _info)
"Format TEXT depending on MARKUP text markup.
INFO is a plist used as a communication channel. See
`org-texinfo-text-markup-alist' for details."
- (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist))))
- (cond
- ;; No format string: Return raw text.
- ((not fmt) text)
- ((eq 'verb fmt)
- (let ((separator (org-texinfo--find-verb-separator text)))
- (concat "@verb{" separator text separator "}")))
- ((eq 'code fmt)
- (let ((start 0)
- (rtn "")
- char)
- (while (string-match "[@{}]" text)
- (setq char (match-string 0 text))
- (if (> (match-beginning 0) 0)
- (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
- (setq text (substring text (1+ (match-beginning 0))))
- (setq char (concat "@" char)
- rtn (concat rtn char)))
- (setq text (concat rtn text)
- fmt "@code{%s}")
- (format fmt text)))
- ;; Else use format string.
- (t (format fmt text)))))
+ (pcase (cdr (assq markup org-texinfo-text-markup-alist))
+ ;; No format string: Return raw text.
+ (`nil text)
+ (`verb
+ (let ((separator (org-texinfo--find-verb-separator text)))
+ (concat "@verb{" separator text separator "}")))
+ (`code
+ (format "@code{%s}" (replace-regexp-in-string "[@{}]" "@\\&" text)))
+ ;; Else use format string.
+ (fmt (format fmt text))))
(defun org-texinfo--get-node (blob info)
"Return node or anchor associated to BLOB.
@@ -562,7 +548,7 @@ holding export options."
(name (symbol-name (or org-texinfo-coding-system
buffer-file-coding-system))))
(dolist (system org-texinfo-supported-coding-systems "UTF-8")
- (when (org-string-match-p (regexp-quote system) name)
+ (when (string-match-p (regexp-quote system) name)
(throw 'coding-system system))))))
(language (plist-get info :language))
(case-fold-search nil))
@@ -599,7 +585,7 @@ holding export options."
(let ((dirdesc
(let ((desc (plist-get info :texinfo-dirdesc)))
(cond ((not desc) nil)
- ((org-string-match-p "\\.$" desc) desc)
+ ((string-suffix-p "." desc) desc)
(t (concat desc "."))))))
(if dirdesc (format "%-23s %s" dirtitle dirdesc) dirtitle))
"\n"
@@ -658,7 +644,7 @@ holding export options."
;;;; Bold
-(defun org-texinfo-bold (bold contents info)
+(defun org-texinfo-bold (_bold contents info)
"Transcode BOLD from Org to Texinfo.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -666,7 +652,7 @@ contextual information."
;;;; Center Block
-(defun org-texinfo-center-block (center-block contents info)
+(defun org-texinfo-center-block (_center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist used
as a communication channel."
@@ -674,7 +660,7 @@ as a communication channel."
;;;; Clock
-(defun org-texinfo-clock (clock contents info)
+(defun org-texinfo-clock (clock _contents info)
"Transcode a CLOCK element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -689,7 +675,7 @@ information."
;;;; Code
-(defun org-texinfo-code (code contents info)
+(defun org-texinfo-code (code _contents info)
"Transcode a CODE object from Org to Texinfo.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -708,7 +694,7 @@ holding contextual information."
;;;; Dynamic Block
-(defun org-texinfo-dynamic-block (dynamic-block contents info)
+(defun org-texinfo-dynamic-block (_dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -716,7 +702,7 @@ holding contextual information."
;;;; Entity
-(defun org-texinfo-entity (entity contents info)
+(defun org-texinfo-entity (entity _contents _info)
"Transcode an ENTITY object from Org to Texinfo.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -725,7 +711,7 @@ contextual information."
;;;; Example Block
-(defun org-texinfo-example-block (example-block contents info)
+(defun org-texinfo-example-block (example-block _contents info)
"Transcode an EXAMPLE-BLOCK element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -734,7 +720,7 @@ information."
;;; Export Block
-(defun org-texinfo-export-block (export-block contents info)
+(defun org-texinfo-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "TEXINFO")
@@ -742,7 +728,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Export Snippet
-(defun org-texinfo-export-snippet (export-snippet contents info)
+(defun org-texinfo-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'texinfo)
@@ -750,7 +736,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-texinfo-fixed-width (fixed-width contents info)
+(defun org-texinfo-fixed-width (fixed-width _contents _info)
"Transcode a FIXED-WIDTH element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(format "@example\n%s\n@end example"
@@ -760,7 +746,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Reference
-(defun org-texinfo-footnote-reference (footnote contents info)
+(defun org-texinfo-footnote-reference (footnote _contents info)
"Create a footnote reference for FOOTNOTE.
FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a
@@ -848,7 +834,7 @@ holding contextual information."
(t (concat node (format section-fmt full-text contents))))))
(defun org-texinfo-format-headline-default-function
- (todo todo-type priority text tags)
+ (todo _todo-type priority text tags)
"Default format function for a headline.
See `org-texinfo-format-headline-function' for details."
(concat (when todo (format "@strong{%s} " todo))
@@ -858,7 +844,7 @@ See `org-texinfo-format-headline-function' for details."
;;;; Inline Src Block
-(defun org-texinfo-inline-src-block (inline-src-block contents info)
+(defun org-texinfo-inline-src-block (inline-src-block _contents _info)
"Transcode an INLINE-SRC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
@@ -885,7 +871,7 @@ holding contextual information."
todo todo-type priority title tags contents)))
(defun org-texinfo-format-inlinetask-default-function
- (todo todo-type priority title tags contents)
+ (todo _todo-type priority title tags contents)
"Default format function for a inlinetasks.
See `org-texinfo-format-inlinetask-function' for details."
(let ((full-title
@@ -897,7 +883,7 @@ See `org-texinfo-format-inlinetask-function' for details."
;;;; Italic
-(defun org-texinfo-italic (italic contents info)
+(defun org-texinfo-italic (_italic contents info)
"Transcode ITALIC from Org to Texinfo.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -916,7 +902,7 @@ contextual information."
;;;; Keyword
-(defun org-texinfo-keyword (keyword contents info)
+(defun org-texinfo-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((key (org-element-property :key keyword))
@@ -930,16 +916,16 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string= key "TINDEX") (format "@tindex %s" value))
((string= key "VINDEX") (format "@vindex %s" value))
((string= key "TOC")
- (cond ((org-string-match-p "\\<tables\\>" value)
+ (cond ((string-match-p "\\<tables\\>" value)
(concat "@listoffloats "
(org-export-translate "Table" :utf-8 info)))
- ((org-string-match-p "\\<listings\\>" value)
+ ((string-match-p "\\<listings\\>" value)
(concat "@listoffloats "
(org-export-translate "Listing" :utf-8 info))))))))
;;;; Line Break
-(defun org-texinfo-line-break (line-break contents info)
+(defun org-texinfo-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
"@*\n")
@@ -976,15 +962,15 @@ INFO is a plist holding contextual information. See
(if (equal type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
- ((nil)
+ (pcase (org-element-type destination)
+ (`nil
(format org-texinfo-link-with-unknown-path-format
(org-texinfo--sanitize-content path)))
;; Id link points to an external file.
- (plain-text
+ (`plain-text
(if desc (format "@uref{file://%s,%s}" destination desc)
(format "@uref{file://%s}" destination)))
- (headline
+ (`headline
(format "@ref{%s,%s}"
(org-texinfo--get-node destination info)
(cond
@@ -995,7 +981,7 @@ INFO is a plist holding contextual information. See
(org-export-get-headline-number destination info) "."))
(t (org-export-data
(org-element-property :title destination) info)))))
- (otherwise
+ (_
(format "@ref{%s,,%s}"
(org-texinfo--get-node destination info)
(cond
@@ -1113,7 +1099,7 @@ is an integer, build the menu recursively, down to this depth."
(org-export-data (org-export-get-alt-title h info) info)
(org-texinfo--format-entries entries info))
(org-texinfo--build-menu h info (1- level))))))
- (org-texinfo--menu-entries scope info) "")))))
+ (org-texinfo--menu-entries scope info) "\n")))))
(defun org-texinfo--format-entries (entries info)
"Format all direct menu entries in SCOPE, as a string.
@@ -1156,7 +1142,7 @@ holding contextual information."
;;;; Node Property
-(defun org-texinfo-node-property (node-property contents info)
+(defun org-texinfo-node-property (node-property _contents _info)
"Transcode a NODE-PROPERTY element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1167,7 +1153,7 @@ information."
;;;; Paragraph
-(defun org-texinfo-paragraph (paragraph contents info)
+(defun org-texinfo-paragraph (_paragraph contents _info)
"Transcode a PARAGRAPH element from Org to Texinfo.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
@@ -1227,7 +1213,7 @@ contextual information."
;;;; Planning
-(defun org-texinfo-planning (planning contents info)
+(defun org-texinfo-planning (planning _contents info)
"Transcode a PLANNING element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1260,7 +1246,7 @@ information."
;;;; Property Drawer
-(defun org-texinfo-property-drawer (property-drawer contents info)
+(defun org-texinfo-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element from Org to Texinfo.
CONTENTS holds the contents of the drawer. INFO is a plist
holding contextual information."
@@ -1269,7 +1255,7 @@ holding contextual information."
;;;; Quote Block
-(defun org-texinfo-quote-block (quote-block contents info)
+(defun org-texinfo-quote-block (quote-block contents _info)
"Transcode a QUOTE-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -1295,27 +1281,34 @@ contextual information."
"Transcode a SECTION element from Org to Texinfo.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
- (concat contents
- (let ((parent (org-export-get-parent-headline section)))
- (and parent (org-texinfo-make-menu parent info)))))
+ (org-trim
+ (concat contents
+ "\n"
+ (let ((parent (org-export-get-parent-headline section)))
+ (and parent (org-texinfo-make-menu parent info))))))
;;;; Special Block
-(defun org-texinfo-special-block (special-block contents info)
+(defun org-texinfo-special-block (special-block contents _info)
"Transcode a SPECIAL-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist used
as a communication channel."
- (let ((type (org-element-property :type special-block)))
- (format "@%s\n%s@end %s" type contents type)))
+ (let ((opt (org-export-read-attribute :attr_texinfo special-block :options))
+ (type (org-element-property :type special-block)))
+ (format "@%s%s\n%s@end %s"
+ type
+ (if opt (concat " " opt) opt)
+ (or contents "")
+ type)))
;;;; Src Block
-(defun org-texinfo-src-block (src-block contents info)
+(defun org-texinfo-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((lisp (org-string-match-p "lisp"
- (org-element-property :language src-block)))
+ (let* ((lisp (string-match-p "lisp"
+ (org-element-property :language src-block)))
(code (org-texinfo--sanitize-content
(org-export-format-code-default src-block info)))
(value (format
@@ -1333,14 +1326,23 @@ contextual information."
;;;; Statistics Cookie
-(defun org-texinfo-statistics-cookie (statistics-cookie contents info)
+(defun org-texinfo-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-element-property :value statistics-cookie))
+
+;;;; Strike-through
+
+(defun org-texinfo-strike-through (_strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to Texinfo.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (org-texinfo--text-markup contents 'strike-through info))
+
;;;; Subscript
-(defun org-texinfo-subscript (subscript contents info)
+(defun org-texinfo-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to Texinfo.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1348,7 +1350,7 @@ contextual information."
;;;; Superscript
-(defun org-texinfo-superscript (superscript contents info)
+(defun org-texinfo-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to Texinfo.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1398,7 +1400,7 @@ a communication channel."
(let ((w (- (org-element-property :contents-end cell)
(org-element-property :contents-begin cell))))
(aset widths idx (max w (aref widths idx))))
- (incf idx))
+ (cl-incf idx))
info)))
info)
(format "{%s}" (mapconcat (lambda (w) (make-string w ?a)) widths "} {"))))
@@ -1441,7 +1443,7 @@ a communication channel."
;;;; Target
-(defun org-texinfo-target (target contents info)
+(defun org-texinfo-target (target _contents info)
"Transcode a TARGET object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1449,22 +1451,30 @@ information."
;;;; Timestamp
-(defun org-texinfo-timestamp (timestamp contents info)
+(defun org-texinfo-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((value (org-texinfo-plain-text
(org-timestamp-translate timestamp) info)))
- (case (org-element-property :type timestamp)
- ((active active-range)
+ (pcase (org-element-property :type timestamp)
+ ((or `active `active-range)
(format (plist-get info :texinfo-active-timestamp-format) value))
- ((inactive inactive-range)
+ ((or `inactive `inactive-range)
(format (plist-get info :texinfo-inactive-timestamp-format) value))
- (t (format (plist-get info :texinfo-diary-timestamp-format) value)))))
+ (_ (format (plist-get info :texinfo-diary-timestamp-format) value)))))
+
+;;;; Underline
+
+(defun org-texinfo-underline (_underline contents info)
+ "Transcode UNDERLINE from Org to Texinfo.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (org-texinfo--text-markup contents 'underline info))
;;;; Verbatim
-(defun org-texinfo-verbatim (verbatim contents info)
+(defun org-texinfo-verbatim (verbatim _contents info)
"Transcode a VERBATIM object from Org to Texinfo.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -1473,7 +1483,7 @@ channel."
;;;; Verse Block
-(defun org-texinfo-verse-block (verse-block contents info)
+(defun org-texinfo-verse-block (_verse-block contents _info)
"Transcode a VERSE-BLOCK element from Org to Texinfo.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
@@ -1567,100 +1577,36 @@ Return output file name."
;;;###autoload
(defun org-texinfo-convert-region-to-texinfo ()
- "Assume the current region has org-mode syntax, and convert it to Texinfo.
+ "Assume the current region has Org syntax, and convert it to Texinfo.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an Texinfo buffer and use
-this command to convert it."
+itemized list in Org syntax in an Texinfo buffer and use this
+command to convert it."
(interactive)
(org-export-replace-region-by 'texinfo))
(defun org-texinfo-compile (file)
"Compile a texinfo file.
-FILE is the name of the file being compiled. Processing is
-done through the command specified in `org-texinfo-info-process'.
+FILE is the name of the file being compiled. Processing is done
+through the command specified in `org-texinfo-info-process',
+which see. Output is redirected to \"*Org INFO Texinfo Output*\"
+buffer.
Return INFO file name or an error if it couldn't be produced."
- (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
- (full-name (file-truename file))
- (out-dir (file-name-directory file))
- ;; Properly set working directory for compilation.
- (default-directory (if (file-name-absolute-p file)
- (file-name-directory full-name)
- default-directory))
- errors)
- (message "Processing Texinfo file %s..." file)
- (save-window-excursion
- ;; Replace %b, %f and %o with appropriate values in each command
- ;; before applying it. Output is redirected to "*Org INFO
- ;; Texinfo Output*" buffer.
- (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*")))
- (with-current-buffer outbuf (compilation-mode))
- (dolist (command org-texinfo-info-process)
- (shell-command
- (replace-regexp-in-string
- "%b" (shell-quote-argument base-name)
- (replace-regexp-in-string
- "%f" (shell-quote-argument full-name)
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-dir) command t t) t t) t t)
- outbuf))
- ;; Collect standard errors from output buffer.
- (setq errors (org-texinfo-collect-errors outbuf)))
- (let ((infofile (concat out-dir base-name ".info")))
- ;; Check for process failure. Provide collected errors if
- ;; possible.
- (if (not (file-exists-p infofile))
- (error "INFO file %s wasn't produced%s" infofile
- (if errors (concat ": " errors) ""))
- ;; Else remove log files, when specified, and signal end of
- ;; process to user, along with any error encountered.
- (when org-texinfo-remove-logfiles
- (dolist (ext org-texinfo-logfiles-extensions)
- (let ((file (concat out-dir base-name "." ext)))
- (when (file-exists-p file) (delete-file file)))))
- (message (concat "Process completed"
- (if (not errors) "."
- (concat " with errors: " errors)))))
- ;; Return output file name.
- infofile))))
-
-(defun org-texinfo-collect-errors (buffer)
- "Collect some kind of errors from \"makeinfo\" command output.
-
-BUFFER is the buffer containing output.
-
-Return collected error types as a string, or nil if there was
-none."
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-min))
- ;; Find final "makeinfo" run.
- (when t
- (let ((case-fold-search t)
- (errors ""))
- (when (save-excursion
- (re-search-forward "perhaps incorrect sectioning?" nil t))
- (setq errors (concat errors " [incorrect sectioning]")))
- (when (save-excursion
- (re-search-forward "missing close brace" nil t))
- (setq errors (concat errors " [syntax error]")))
- (when (save-excursion
- (re-search-forward "Unknown command" nil t))
- (setq errors (concat errors " [undefined @command]")))
- (when (save-excursion
- (re-search-forward "No matching @end" nil t))
- (setq errors (concat errors " [block incomplete]")))
- (when (save-excursion
- (re-search-forward "requires a sectioning" nil t))
- (setq errors (concat errors " [invalid section command]")))
- (when (save-excursion
- (re-search-forward "\\[unexpected\ ]" nil t))
- (setq errors (concat errors " [unexpected error]")))
- (when (save-excursion
- (re-search-forward "misplaced " nil t))
- (setq errors (concat errors " [syntax error]")))
- (and (org-string-nw-p errors) (org-trim errors)))))))
+ (message "Processing Texinfo file %s..." file)
+ (let* ((log-name "*Org INFO Texinfo Output*")
+ (log (get-buffer-create log-name))
+ (output
+ (org-compile-file file org-texinfo-info-process "info"
+ (format "See %S for details" log-name)
+ log)))
+ (when org-texinfo-remove-logfiles
+ (let ((base (file-name-sans-extension output)))
+ (dolist (ext org-texinfo-logfiles-extensions)
+ (let ((file (concat base "." ext)))
+ (when (file-exists-p file) (delete-file file))))))
+ (message "Process completed.")
+ output))
(provide 'ox-texinfo)
diff --git a/lisp/ox.el b/lisp/ox.el
index b9c99eb..d3d1a0e 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -1,4 +1,4 @@
-;;; ox.el --- Generic Export Engine for Org Mode
+;;; ox.el --- Export Framework for Org Mode -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@@ -71,17 +71,18 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
+(require 'ob-exp)
(require 'org-element)
(require 'org-macro)
-(require 'ob-exp)
+(require 'tabulated-list)
(declare-function org-publish "ox-publish" (project &optional force async))
(declare-function org-publish-all "ox-publish" (&optional force async))
-(declare-function
- org-publish-current-file "ox-publish" (&optional force async))
-(declare-function org-publish-current-project "ox-publish"
- (&optional force async))
+(declare-function org-publish-current-file "ox-publish" (&optional force async))
+(declare-function org-publish-current-project "ox-publish" (&optional force async))
+(declare-function org-src-coderef-format "org-src" (&optional element))
+(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(defvar org-publish-project-alist)
(defvar org-table-number-fraction)
@@ -112,6 +113,7 @@
(:time-stamp-file nil "timestamp" org-export-time-stamp-file)
(:with-archived-trees nil "arch" org-export-with-archived-trees)
(:with-author nil "author" org-export-with-author)
+ (:with-broken-links nil "broken-links" org-export-with-broken-links)
(:with-clocks nil "c" org-export-with-clocks)
(:with-creator nil "creator" org-export-with-creator)
(:with-date nil "date" org-export-with-date)
@@ -345,21 +347,24 @@ e.g. \"arch:nil\"."
:type '(choice
(const :tag "Not at all" nil)
(const :tag "Headline only" headline)
- (const :tag "Entirely" t)))
+ (const :tag "Entirely" t))
+ :safe (lambda (x) (memq x '(t nil headline))))
(defcustom org-export-with-author t
"Non-nil means insert author name into the exported file.
This option can also be set with the OPTIONS keyword,
e.g. \"author:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-clocks nil
"Non-nil means export CLOCK keywords.
This option can also be set with the OPTIONS keyword,
e.g. \"c:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-creator nil
"Non-nil means the postamble should contain a creator sentence.
@@ -370,16 +375,18 @@ see.
This option can also be set with the OPTIONS keyword, e.g.,
\"creator:t\"."
:group 'org-export-general
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-date t
"Non-nil means insert date in the exported document.
This option can also be set with the OPTIONS keyword,
e.g. \"date:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-date-timestamp-format nil
"Time-stamp format string to use for DATE keyword.
@@ -392,7 +399,8 @@ string."
:group 'org-export-general
:type '(choice
(string :tag "Time-stamp format string")
- (const :tag "No format string" nil)))
+ (const :tag "No format string" nil))
+ :safe (lambda (x) (or (null x) (stringp x))))
(defcustom org-export-creator-string
(format "Emacs %s (Org mode %s)"
@@ -401,7 +409,8 @@ string."
"Information about the creator of the document.
This option can also be set on with the CREATOR keyword."
:group 'org-export-general
- :type '(string :tag "Creator string"))
+ :type '(string :tag "Creator string")
+ :safe #'stringp)
(defcustom org-export-with-drawers '(not "LOGBOOK")
"Non-nil means export contents of standard drawers.
@@ -427,14 +436,20 @@ e.g. \"d:nil\"."
(const :format "" not)
(repeat :tag "Specify names of drawers to ignore during export"
:inline t
- (string :tag "Drawer name")))))
+ (string :tag "Drawer name"))))
+ :safe (lambda (x) (or (booleanp x)
+ (and (listp x)
+ (or (cl-every #'stringp x)
+ (and (eq (nth 0 x) 'not)
+ (cl-every #'stringp (cdr x))))))))
(defcustom org-export-with-email nil
"Non-nil means insert author email into the exported file.
This option can also be set with the OPTIONS keyword,
e.g. \"email:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-emphasize t
"Non-nil means interpret *word*, /word/, _word_ and +word+.
@@ -446,7 +461,8 @@ respectively.
This option can also be set with the OPTIONS keyword,
e.g. \"*:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-exclude-tags '("noexport")
"Tags that exclude a tree from export.
@@ -457,7 +473,8 @@ carry one of the `org-export-select-tags' will be removed.
This option can also be set with the EXCLUDE_TAGS keyword."
:group 'org-export-general
- :type '(repeat (string :tag "Tag")))
+ :type '(repeat (string :tag "Tag"))
+ :safe (lambda (x) (and (listp x) (cl-every #'stringp x))))
(defcustom org-export-with-fixed-width t
"Non-nil means export lines starting with \":\".
@@ -466,14 +483,16 @@ e.g. \"::nil\"."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-footnotes t
"Non-nil means Org footnotes should be exported.
This option can also be set with the OPTIONS keyword,
e.g. \"f:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-latex t
"Non-nil means process LaTeX environments and fragments.
@@ -490,7 +509,8 @@ t Allow export of math snippets."
:type '(choice
(const :tag "Do not process math in any way" nil)
(const :tag "Interpret math snippets" t)
- (const :tag "Leave math verbatim" verbatim)))
+ (const :tag "Leave math verbatim" verbatim))
+ :safe (lambda (x) (memq x '(t nil verbatim))))
(defcustom org-export-headline-levels 3
"The last level which is still exported as a headline.
@@ -501,7 +521,8 @@ when exported, but back-end behavior may differ.
This option can also be set with the OPTIONS keyword,
e.g. \"H:2\"."
:group 'org-export-general
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom org-export-default-language "en"
"The default language for export and clocktable translations, as a string.
@@ -510,14 +531,16 @@ This may have an association in
`org-export-smart-quotes-alist' and `org-export-dictionary'.
This option can also be set with the LANGUAGE keyword."
:group 'org-export-general
- :type '(string :tag "Language"))
+ :type '(string :tag "Language")
+ :safe #'stringp)
(defcustom org-export-preserve-breaks nil
"Non-nil means preserve all line breaks when exporting.
This option can also be set with the OPTIONS keyword,
e.g. \"\\n:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-entities t
"Non-nil means interpret entities when exporting.
@@ -531,7 +554,8 @@ and the user option `org-entities-user'.
This option can also be set with the OPTIONS keyword,
e.g. \"e:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-inlinetasks t
"Non-nil means inlinetasks should be exported.
@@ -540,7 +564,8 @@ e.g. \"inline:nil\"."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-planning nil
"Non-nil means include planning info in export.
@@ -553,14 +578,16 @@ e.g. \"p:t\"."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-priority nil
"Non-nil means include priority cookies in export.
This option can also be set with the OPTIONS keyword,
e.g. \"pri:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-properties nil
"Non-nil means export contents of properties drawers.
@@ -577,7 +604,9 @@ e.g. \"prop:t\"."
(const :tag "All properties" t)
(const :tag "None" nil)
(repeat :tag "Selected properties"
- (string :tag "Property name"))))
+ (string :tag "Property name")))
+ :safe (lambda (x) (or (booleanp x)
+ (and (listp x) (cl-every #'stringp x)))))
(defcustom org-export-with-section-numbers t
"Non-nil means add section numbers to headlines when exporting.
@@ -588,7 +617,8 @@ headlines whose relative level is higher or equal to n.
This option can also be set with the OPTIONS keyword,
e.g. \"num:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-select-tags '("export")
"Tags that select a tree for export.
@@ -600,7 +630,8 @@ tagging it with one of the `org-export-exclude-tags'.
This option can also be set with the SELECT_TAGS keyword."
:group 'org-export-general
- :type '(repeat (string :tag "Tag")))
+ :type '(repeat (string :tag "Tag"))
+ :safe (lambda (x) (and (listp x) (cl-every #'stringp x))))
(defcustom org-export-with-smart-quotes nil
"Non-nil means activate smart quotes during export.
@@ -615,7 +646,8 @@ E.g., you can load Babel for french like this:
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-special-strings t
"Non-nil means interpret \"\\-\", \"--\" and \"---\" for export.
@@ -632,7 +664,8 @@ When this option is turned on, these strings will be exported as:
This option can also be set with the OPTIONS keyword,
e.g. \"-:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-statistics-cookies t
"Non-nil means include statistics cookies in export.
@@ -641,7 +674,8 @@ e.g. \"stat:nil\""
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-sub-superscripts t
"Non-nil means interpret \"_\" and \"^\" for export.
@@ -678,7 +712,8 @@ frequently in plain text."
:type '(choice
(const :tag "Interpret them" t)
(const :tag "Curly brackets only" {})
- (const :tag "Do not interpret them" nil)))
+ (const :tag "Do not interpret them" nil))
+ :safe (lambda (x) (memq x '(t nil {}))))
(defcustom org-export-with-toc t
"Non-nil means create a table of contents in exported files.
@@ -696,7 +731,9 @@ e.g. \"toc:nil\" or \"toc:3\"."
:type '(choice
(const :tag "No Table of Contents" nil)
(const :tag "Full Table of Contents" t)
- (integer :tag "TOC to level")))
+ (integer :tag "TOC to level"))
+ :safe (lambda (x) (or (booleanp x)
+ (integerp x))))
(defcustom org-export-with-tables t
"Non-nil means export tables.
@@ -705,7 +742,8 @@ e.g. \"|:nil\"."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-tags t
"If nil, do not export tags, just remove them from headlines.
@@ -720,7 +758,8 @@ e.g. \"tags:nil\"."
:type '(choice
(const :tag "Off" nil)
(const :tag "Not in TOC" not-in-toc)
- (const :tag "On" t)))
+ (const :tag "On" t))
+ :safe (lambda (x) (memq x '(t nil not-in-toc))))
(defcustom org-export-with-tasks t
"Non-nil means include TODO items for export.
@@ -741,23 +780,28 @@ e.g. \"tasks:nil\"."
(const :tag "Not-done tasks" todo)
(const :tag "Only done tasks" done)
(repeat :tag "Specific TODO keywords"
- (string :tag "Keyword"))))
+ (string :tag "Keyword")))
+ :safe (lambda (x) (or (memq x '(nil t todo done))
+ (and (listp x)
+ (cl-every #'stringp x)))))
(defcustom org-export-with-title t
"Non-nil means print title into the exported file.
This option can also be set with the OPTIONS keyword,
e.g. \"title:nil\"."
:group 'org-export-general
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-time-stamp-file t
"Non-nil means insert a time stamp into the exported file.
The time stamp shows when the file was created. This option can
also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-timestamps t
"Non nil means allow timestamps in export.
@@ -779,7 +823,8 @@ This option can also be set with the OPTIONS keyword, e.g.
(const :tag "All timestamps" t)
(const :tag "Only active timestamps" active)
(const :tag "Only inactive timestamps" inactive)
- (const :tag "No timestamp" nil)))
+ (const :tag "No timestamp" nil))
+ :safe (lambda (x) (memq x '(t nil active inactive))))
(defcustom org-export-with-todo-keywords t
"Non-nil means include TODO keywords in export.
@@ -797,6 +842,27 @@ is nil. You can also allow them through local buffer variables."
:package-version '(Org . "8.0")
:type 'boolean)
+(defcustom org-export-with-broken-links nil
+ "Non-nil means do not raise an error on broken links.
+
+When this variable is non-nil, broken links are ignored, without
+stopping the export process. If it is set to `mark', broken
+links are marked as such in the output, with a string like
+
+ [BROKEN LINK: path]
+
+where PATH is the un-resolvable reference.
+
+This option can also be set with the OPTIONS keyword, e.g.,
+\"broken-links:mark\"."
+ :group 'org-export-general
+ :version "25.2"
+ :package-version '(Org . "9.0")
+ :type '(choice
+ (const :tag "Ignore broken links" t)
+ (const :tag "Mark broken links in output" mark)
+ (const :tag "Raise an error" nil)))
+
(defcustom org-export-snippet-translation-alist nil
"Alist between export snippets back-ends and exporter back-ends.
@@ -810,7 +876,12 @@ HTML code while every other back-end will ignore it."
:package-version '(Org . "8.0")
:type '(repeat
(cons (string :tag "Shortcut")
- (string :tag "Back-end"))))
+ (string :tag "Back-end")))
+ :safe (lambda (x)
+ (and (listp x)
+ (cl-every #'consp x)
+ (cl-every #'stringp (mapcar #'car x))
+ (cl-every #'stringp (mapcar #'cdr x)))))
(defcustom org-export-coding-system nil
"Coding system for the exported file."
@@ -823,7 +894,7 @@ HTML code while every other back-end will ignore it."
"Non-nil means pushing export output to the kill ring.
This variable is ignored during asynchronous export."
:group 'org-export-general
- :version "25.1"
+ :version "25.2"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "Always" t)
@@ -851,7 +922,7 @@ these cases."
(defcustom org-export-in-background nil
"Non-nil means export and publishing commands will run in background.
Results from an asynchronous export are never displayed
-automatically. But you can retrieve them with \\[org-export-stack]."
+automatically. But you can retrieve them with `\\[org-export-stack]'."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
@@ -921,8 +992,8 @@ mode."
;; Eventually `org-export-barf-if-invalid-backend' returns an error
;; when a given back-end hasn't been registered yet.
-(defstruct (org-export-backend (:constructor org-export-create-backend)
- (:copier nil))
+(cl-defstruct (org-export-backend (:constructor org-export-create-backend)
+ (:copier nil))
name parent transcoders options filters blocks menu)
(defun org-export-get-backend (name)
@@ -943,10 +1014,6 @@ BACKEND is a structure with `org-export-backend' type."
(let ((parent (org-export-backend-parent backend)))
(when (and parent (not (org-export-get-backend parent)))
(error "Cannot use unknown \"%s\" back-end as a parent" parent)))
- ;; Register dedicated export blocks in the parser.
- (dolist (name (org-export-backend-blocks backend))
- (add-to-list 'org-element-block-name-alist
- (cons name 'org-element-export-block-parser)))
;; If a back-end with the same name as BACKEND is already
;; registered, replace it with BACKEND. Otherwise, simply add
;; BACKEND to the list of registered back-ends.
@@ -1073,14 +1140,6 @@ back-end.
BODY can start with pre-defined keyword arguments. The following
keywords are understood:
- :export-block
-
- String, or list of strings, representing block names that
- will not be parsed. This is used to specify blocks that will
- contain raw code specific to the back-end. These blocks
- still have to be handled by the relative `export-block' type
- translator.
-
:filters-alist
Alist between filters and function, or list of functions,
@@ -1150,23 +1209,19 @@ keywords are understood:
`org-export-options-alist' for more information about
structure of the values."
(declare (indent 1))
- (let (blocks filters menu-entry options contents)
+ (let (filters menu-entry options)
(while (keywordp (car body))
(let ((keyword (pop body)))
- (case keyword
- (:export-block (let ((names (pop body)))
- (setq blocks (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
+ (pcase keyword
(:filters-alist (setq filters (pop body)))
(:menu-entry (setq menu-entry (pop body)))
(:options-alist (setq options (pop body)))
- (t (error "Unknown keyword: %s" keyword)))))
+ (_ (error "Unknown keyword: %s" keyword)))))
(org-export-register-backend
(org-export-create-backend :name backend
:transcoders transcoders
:options options
:filters filters
- :blocks blocks
:menu menu-entry))))
(defun org-export-define-derived-backend (child parent &rest body)
@@ -1178,14 +1233,6 @@ the parent back-end.
BODY can start with pre-defined keyword arguments. The following
keywords are understood:
- :export-block
-
- String, or list of strings, representing block names that
- will not be parsed. This is used to specify blocks that will
- contain raw code specific to the back-end. These blocks
- still have to be handled by the relative `export-block' type
- translator.
-
:filters-alist
Alist of filters that will overwrite or complete filters
@@ -1222,25 +1269,21 @@ The back-end could then be called with, for example:
(org-export-to-buffer \\='my-latex \"*Test my-latex*\")"
(declare (indent 2))
- (let (blocks filters menu-entry options transcoders contents)
+ (let (filters menu-entry options transcoders)
(while (keywordp (car body))
(let ((keyword (pop body)))
- (case keyword
- (:export-block (let ((names (pop body)))
- (setq blocks (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
+ (pcase keyword
(:filters-alist (setq filters (pop body)))
(:menu-entry (setq menu-entry (pop body)))
(:options-alist (setq options (pop body)))
(:translate-alist (setq transcoders (pop body)))
- (t (error "Unknown keyword: %s" keyword)))))
+ (_ (error "Unknown keyword: %s" keyword)))))
(org-export-register-backend
(org-export-create-backend :name child
:parent parent
:transcoders transcoders
:options options
:filters filters
- :blocks blocks
:menu menu-entry))))
@@ -1259,7 +1302,7 @@ The back-end could then be called with, for example:
;; `org-export-options-alist' variable.
;;
;; 2. Tree properties are extracted directly from the parsed tree,
-;; just before export, by `org-export-collect-tree-properties'.
+;; just before export, by `org-export--collect-tree-properties'.
;;;; Environment Options
;;
@@ -1304,7 +1347,7 @@ inferior to file-local settings."
;; First install #+BIND variables since these must be set before
;; global options are read.
(dolist (pair (org-export--list-bound-variables))
- (org-set-local (car pair) (nth 1 pair)))
+ (set (make-local-variable (car pair)) (nth 1 pair)))
;; Get and prioritize export options...
(org-combine-plists
;; ... from global variables...
@@ -1314,25 +1357,7 @@ inferior to file-local settings."
;; ... from in-buffer settings...
(org-export--get-inbuffer-options backend)
;; ... and from subtree, when appropriate.
- (and subtreep (org-export--get-subtree-options backend))
- ;; Eventually add misc. properties.
- (list
- :back-end
- backend
- :translate-alist (org-export-get-all-transcoders backend)
- :id-alist
- ;; Collect id references.
- (let (alist)
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t)
- (let ((link (org-element-context)))
- (when (eq (org-element-type link) 'link)
- (let* ((id (org-element-property :path link))
- (file (car (org-id-find id))))
- (when file
- (push (cons id (file-relative-name file)) alist)))))))
- alist))))
+ (and subtreep (org-export--get-subtree-options backend))))
(defun org-export--parse-option-keyword (options &optional backend)
"Parse an OPTIONS line and return values as a plist.
@@ -1380,8 +1405,9 @@ for export. Return options as a plist."
(cache (list
(cons "TITLE"
(or (org-entry-get (point) "EXPORT_TITLE" 'selective)
- (progn (looking-at org-complex-heading-regexp)
- (org-match-string-no-properties 4))))))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp)
+ (match-string-no-properties 4))))))
;; Look for both general keywords and back-end specific
;; options, with priority given to the latter.
(options (append (and backend (org-export-get-all-options backend))
@@ -1401,7 +1427,7 @@ for export. Return options as a plist."
(setq plist
(plist-put plist
property
- (case (nth 4 option)
+ (cl-case (nth 4 option)
(parse
(org-element-parse-secondary-string
value (org-element-restriction 'keyword)))
@@ -1417,9 +1443,7 @@ which back-end specific options should also be read in the
process.
Assume buffer is in Org mode. Narrowing, if any, is ignored."
- (let* (plist
- get-options ; For byte-compiler.
- (case-fold-search t)
+ (let* ((case-fold-search t)
(options (append
;; Priority is given to back-end specific options.
(and backend (org-export-get-all-options backend))
@@ -1427,110 +1451,124 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(regexp (format "^[ \t]*#\\+%s:"
(regexp-opt (nconc (delq nil (mapcar #'cadr options))
org-export-special-keywords))))
- (find-properties
- (lambda (keyword)
- ;; Return all properties associated to KEYWORD.
- (let (properties)
- (dolist (option options properties)
- (when (equal (nth 1 option) keyword)
- (pushnew (car option) properties))))))
- to-parse
- (get-options
- (lambda (&optional files plist)
- ;; Recursively read keywords in buffer. FILES is a list
- ;; of files read so far. PLIST is the current property
- ;; list obtained.
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (let ((key (org-element-property :key element))
- (val (org-element-property :value element)))
- (cond
- ;; Options in `org-export-special-keywords'.
- ((equal key "SETUPFILE")
- (let ((file (expand-file-name
- (org-remove-double-quotes (org-trim val)))))
- ;; Avoid circular dependencies.
- (unless (member file files)
- (with-temp-buffer
- (setq default-directory
+ plist to-parse)
+ (letrec ((find-properties
+ (lambda (keyword)
+ ;; Return all properties associated to KEYWORD.
+ (let (properties)
+ (dolist (option options properties)
+ (when (equal (nth 1 option) keyword)
+ (cl-pushnew (car option) properties))))))
+ (get-options
+ (lambda (&optional files)
+ ;; Recursively read keywords in buffer. FILES is
+ ;; a list of files read so far. PLIST is the current
+ ;; property list obtained.
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let ((key (org-element-property :key element))
+ (val (org-element-property :value element)))
+ (cond
+ ;; Options in `org-export-special-keywords'.
+ ((equal key "SETUPFILE")
+ (let ((file
+ (expand-file-name
+ (org-unbracket-string "\"" "\"" (org-trim val)))))
+ ;; Avoid circular dependencies.
+ (unless (member file files)
+ (with-temp-buffer
+ (setq default-directory
(file-name-directory file))
- (insert (org-file-contents file 'noerror))
- (let ((org-inhibit-startup t)) (org-mode))
- (setq plist (funcall get-options
- (cons file files) plist))))))
- ((equal key "OPTIONS")
- (setq plist
- (org-combine-plists
- plist
- (org-export--parse-option-keyword val backend))))
- ((equal key "FILETAGS")
- (setq plist
- (org-combine-plists
+ (insert (org-file-contents file 'noerror))
+ (let ((org-inhibit-startup t)) (org-mode))
+ (funcall get-options (cons file files))))))
+ ((equal key "OPTIONS")
+ (setq plist
+ (org-combine-plists
+ plist
+ (org-export--parse-option-keyword
+ val backend))))
+ ((equal key "FILETAGS")
+ (setq plist
+ (org-combine-plists
+ plist
+ (list :filetags
+ (org-uniquify
+ (append
+ (org-split-string val ":")
+ (plist-get plist :filetags)))))))
+ (t
+ ;; Options in `org-export-options-alist'.
+ (dolist (property (funcall find-properties key))
+ (setq
plist
- (list :filetags
- (org-uniquify
- (append (org-split-string val ":")
- (plist-get plist :filetags)))))))
- (t
- ;; Options in `org-export-options-alist'.
- (dolist (property (funcall find-properties key))
- (setq
- plist
- (plist-put
- plist property
- ;; Handle value depending on specified
- ;; BEHAVIOR.
- (case (nth 4 (assq property options))
- (parse
- (unless (memq property to-parse)
- (push property to-parse))
- ;; Even if `parse' implies `space'
- ;; behavior, we separate line with "\n"
- ;; so as to preserve line-breaks.
- ;; However, empty lines are forbidden
- ;; since `parse' doesn't allow more than
- ;; one paragraph.
- (let ((old (plist-get plist property)))
- (cond ((not (org-string-nw-p val)) old)
- (old (concat old "\n" val))
- (t val))))
- (space
- (if (not (plist-get plist property))
- (org-trim val)
- (concat (plist-get plist property)
- " "
- (org-trim val))))
- (newline
- (org-trim
- (concat (plist-get plist property)
- "\n"
- (org-trim val))))
- (split `(,@(plist-get plist property)
- ,@(org-split-string val)))
- ((t) val)
- (otherwise
- (if (not (plist-member plist property)) val
- (plist-get plist property)))))))))))))
- plist))))
- ;; Read options in the current buffer and return value.
- (let ((options (funcall get-options
- (and buffer-file-name (list buffer-file-name))
- nil)))
+ (plist-put
+ plist property
+ ;; Handle value depending on specified
+ ;; BEHAVIOR.
+ (cl-case (nth 4 (assq property options))
+ (parse
+ (unless (memq property to-parse)
+ (push property to-parse))
+ ;; Even if `parse' implies `space'
+ ;; behavior, we separate line with
+ ;; "\n" so as to preserve
+ ;; line-breaks. However, empty
+ ;; lines are forbidden since `parse'
+ ;; doesn't allow more than one
+ ;; paragraph.
+ (let ((old (plist-get plist property)))
+ (cond ((not (org-string-nw-p val)) old)
+ (old (concat old "\n" val))
+ (t val))))
+ (space
+ (if (not (plist-get plist property))
+ (org-trim val)
+ (concat (plist-get plist property)
+ " "
+ (org-trim val))))
+ (newline
+ (org-trim
+ (concat (plist-get plist property)
+ "\n"
+ (org-trim val))))
+ (split `(,@(plist-get plist property)
+ ,@(org-split-string val)))
+ ((t) val)
+ (otherwise
+ (if (not (plist-member plist property)) val
+ (plist-get plist property)))))))))))))))))
+ ;; Read options in the current buffer and return value.
+ (funcall get-options (and buffer-file-name (list buffer-file-name)))
;; Parse properties in TO-PARSE. Remove newline characters not
;; involved in line breaks to simulate `space' behavior.
;; Finally return options.
- (dolist (p to-parse options)
+ (dolist (p to-parse plist)
(let ((value (org-element-parse-secondary-string
- (plist-get options p)
+ (plist-get plist p)
(org-element-restriction 'keyword))))
(org-element-map value 'plain-text
(lambda (s)
(org-element-set-element
s (replace-regexp-in-string "\n" " " s))))
- (setq options (plist-put options p value)))))))
+ (setq plist (plist-put plist p value)))))))
+
+(defun org-export--get-export-attributes
+ (&optional backend subtreep visible-only body-only)
+ "Return properties related to export process, as a plist.
+Optional arguments BACKEND, SUBTREEP, VISIBLE-ONLY and BODY-ONLY
+are like the arguments with the same names of function
+`org-export-as'."
+ (list :export-options (delq nil
+ (list (and subtreep 'subtree)
+ (and visible-only 'visible-only)
+ (and body-only 'body-only)))
+ :back-end backend
+ :translate-alist (org-export-get-all-transcoders backend)
+ :exported-data (make-hash-table :test #'eq :size 4001)))
(defun org-export--get-buffer-attributes ()
"Return properties related to buffer attributes, as a plist."
@@ -1566,37 +1604,37 @@ process."
Also look for BIND keywords in setup files. The return value is
an alist where associations are (VARIABLE-NAME VALUE)."
(when org-export-allow-bind-keywords
- (let* (collect-bind ; For byte-compiler.
- (collect-bind
- (lambda (files alist)
- ;; Return an alist between variable names and their
- ;; value. FILES is a list of setup files names read so
- ;; far, used to avoid circular dependencies. ALIST is
- ;; the alist collected so far.
- (let ((case-fold-search t))
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (let ((val (org-element-property :value element)))
- (if (equal (org-element-property :key element) "BIND")
- (push (read (format "(%s)" val)) alist)
- ;; Enter setup file.
- (let ((file (expand-file-name
- (org-remove-double-quotes val))))
- (unless (member file files)
- (with-temp-buffer
- (setq default-directory
- (file-name-directory file))
- (let ((org-inhibit-startup t)) (org-mode))
- (insert (org-file-contents file 'noerror))
- (setq alist
- (funcall collect-bind
- (cons file files)
- alist))))))))))
- alist)))))
+ (letrec ((collect-bind
+ (lambda (files alist)
+ ;; Return an alist between variable names and their
+ ;; value. FILES is a list of setup files names read
+ ;; so far, used to avoid circular dependencies. ALIST
+ ;; is the alist collected so far.
+ (let ((case-fold-search t))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let ((val (org-element-property :value element)))
+ (if (equal (org-element-property :key element)
+ "BIND")
+ (push (read (format "(%s)" val)) alist)
+ ;; Enter setup file.
+ (let ((file (expand-file-name
+ (org-unbracket-string "\"" "\"" val))))
+ (unless (member file files)
+ (with-temp-buffer
+ (setq default-directory
+ (file-name-directory file))
+ (let ((org-inhibit-startup t)) (org-mode))
+ (insert (org-file-contents file 'noerror))
+ (setq alist
+ (funcall collect-bind
+ (cons file files)
+ alist))))))))))
+ alist)))))
;; Return value in appropriate order of appearance.
(nreverse (funcall collect-bind nil nil)))))
@@ -1612,7 +1650,7 @@ BLOB is the element or object considered."
;;
;; Tree properties are information extracted from parse tree. They
;; are initialized at the beginning of the transcoding process by
-;; `org-export-collect-tree-properties'.
+;; `org-export--collect-tree-properties'.
;;
;; Dedicated functions focus on computing the value of specific tree
;; properties during initialization. Thus,
@@ -1623,7 +1661,7 @@ BLOB is the element or object considered."
;; `org-export--collect-headline-numbering' builds an alist between
;; headlines and their numbering.
-(defun org-export-collect-tree-properties (data info)
+(defun org-export--collect-tree-properties (data info)
"Extract tree properties from parse tree.
DATA is the parse tree from which information is retrieved. INFO
@@ -1631,17 +1669,17 @@ is a list holding export options.
Following tree properties are set or updated:
-`:exported-data' Hash table used to memoize results from
- `org-export-data'.
-
`:headline-offset' Offset between true level of headlines and
local level. An offset of -1 means a headline
of level 2 should be considered as a level
1 headline in the context.
-`:headline-numbering' Alist of all headlines as key an the
+`:headline-numbering' Alist of all headlines as key and the
associated numbering as value.
+`:id-alist' Alist of all ID references as key and associated file
+ as value.
+
Return updated plist."
;; Install the parse tree in the communication channel.
(setq info (plist-put info :parse-tree data))
@@ -1651,12 +1689,18 @@ Return updated plist."
(plist-put info
:headline-offset
(- 1 (org-export--get-min-level data info))))
- ;; Properties order doesn't matter: get the rest of the tree
- ;; properties.
- (nconc
- `(:headline-numbering ,(org-export--collect-headline-numbering data info)
- :exported-data ,(make-hash-table :test 'eq :size 4001))
- info))
+ ;; From now on, properties order doesn't matter: get the rest of the
+ ;; tree properties.
+ (org-combine-plists
+ info
+ (list :headline-numbering (org-export--collect-headline-numbering data info)
+ :id-alist
+ (org-element-map data 'link
+ (lambda (l)
+ (and (string= (org-element-property :type l) "id")
+ (let* ((id (org-element-property :path l))
+ (file (car (org-id-find id))))
+ (and file (cons id (file-relative-name file))))))))))
(defun org-export--get-min-level (data options)
"Return minimum exportable headline's level in DATA.
@@ -1664,14 +1708,12 @@ DATA is parsed tree as returned by `org-element-parse-buffer'.
OPTIONS is a plist holding export options."
(catch 'exit
(let ((min-level 10000))
- (mapc
- (lambda (blob)
- (when (and (eq (org-element-type blob) 'headline)
- (not (org-element-property :footnote-section-p blob))
- (not (memq blob (plist-get options :ignore-list))))
- (setq min-level (min (org-element-property :level blob) min-level)))
- (when (= min-level 1) (throw 'exit 1)))
- (org-element-contents data))
+ (dolist (datum (org-element-contents data))
+ (when (and (eq (org-element-type datum) 'headline)
+ (not (org-element-property :footnote-section-p datum))
+ (not (memq datum (plist-get options :ignore-list))))
+ (setq min-level (min (org-element-property :level datum) min-level))
+ (when (= min-level 1) (throw 'exit 1))))
;; If no headline was found, for the sake of consistency, set
;; minimum level to 1 nonetheless.
(if (= min-level 10000) 1 min-level))))
@@ -1694,55 +1736,58 @@ for a footnotes section."
(1- (org-export-get-relative-level headline options))))
(cons
headline
- (loop for n across numbering
- for idx from 0 to org-export-max-depth
- when (< idx relative-level) collect n
- when (= idx relative-level) collect (aset numbering idx (1+ n))
- when (> idx relative-level) do (aset numbering idx 0))))))
+ (cl-loop
+ for n across numbering
+ for idx from 0 to org-export-max-depth
+ when (< idx relative-level) collect n
+ when (= idx relative-level) collect (aset numbering idx (1+ n))
+ when (> idx relative-level) do (aset numbering idx 0))))))
options)))
(defun org-export--selected-trees (data info)
"List headlines and inlinetasks with a select tag in their tree.
DATA is parsed data as returned by `org-element-parse-buffer'.
INFO is a plist holding export options."
- (let* (selected-trees
- walk-data ; For byte-compiler.
- (walk-data
- (function
- (lambda (data genealogy)
- (let ((type (org-element-type data)))
- (cond
- ((memq type '(headline inlinetask))
- (let ((tags (org-element-property :tags data)))
- (if (loop for tag in (plist-get info :select-tags)
- thereis (member tag tags))
- ;; When a select tag is found, mark full
- ;; genealogy and every headline within the tree
- ;; as acceptable.
- (setq selected-trees
- (append
- genealogy
- (org-element-map data '(headline inlinetask)
- #'identity)
- selected-trees))
- ;; If at a headline, continue searching in tree,
- ;; recursively.
- (when (eq type 'headline)
- (dolist (el (org-element-contents data))
- (funcall walk-data el (cons data genealogy)))))))
- ((or (eq type 'org-data)
- (memq type org-element-greater-elements))
- (dolist (el (org-element-contents data))
- (funcall walk-data el genealogy)))))))))
- (funcall walk-data data nil)
- selected-trees))
+ (let ((select (plist-get info :select-tags)))
+ (if (cl-some (lambda (tag) (member tag select)) (plist-get info :filetags))
+ ;; If FILETAGS contains a select tag, every headline or
+ ;; inlinetask is returned.
+ (org-element-map data '(headline inlinetask) #'identity)
+ (letrec ((selected-trees nil)
+ (walk-data
+ (lambda (data genealogy)
+ (let ((type (org-element-type data)))
+ (cond
+ ((memq type '(headline inlinetask))
+ (let ((tags (org-element-property :tags data)))
+ (if (cl-some (lambda (tag) (member tag select)) tags)
+ ;; When a select tag is found, mark full
+ ;; genealogy and every headline within the
+ ;; tree as acceptable.
+ (setq selected-trees
+ (append
+ genealogy
+ (org-element-map data '(headline inlinetask)
+ #'identity)
+ selected-trees))
+ ;; If at a headline, continue searching in
+ ;; tree, recursively.
+ (when (eq type 'headline)
+ (dolist (el (org-element-contents data))
+ (funcall walk-data el (cons data genealogy)))))))
+ ((or (eq type 'org-data)
+ (memq type org-element-greater-elements))
+ (dolist (el (org-element-contents data))
+ (funcall walk-data el genealogy))))))))
+ (funcall walk-data data nil)
+ selected-trees))))
(defun org-export--skip-p (blob options selected)
"Non-nil when element or object BLOB should be skipped during export.
OPTIONS is the plist holding export options. SELECTED, when
non-nil, is a list of headlines or inlinetasks belonging to
a tree with a select tag."
- (case (org-element-type blob)
+ (cl-case (org-element-type blob)
(clock (not (plist-get options :with-clocks)))
(drawer
(let ((with-drawers-p (plist-get options :with-drawers)))
@@ -1764,13 +1809,13 @@ a tree with a select tag."
(todo (org-element-property :todo-keyword blob))
(todo-type (org-element-property :todo-type blob))
(archived (plist-get options :with-archived-trees))
- (tags (org-element-property :tags blob)))
+ (tags (org-export-get-tags blob options nil t)))
(or
(and (eq (org-element-type blob) 'inlinetask)
(not (plist-get options :with-inlinetasks)))
;; Ignore subtrees with an exclude tag.
- (loop for k in (plist-get options :exclude-tags)
- thereis (member k tags))
+ (cl-loop for k in (plist-get options :exclude-tags)
+ thereis (member k tags))
;; When a select tag is present in the buffer, ignore any tree
;; without it.
(and selected (not (memq blob selected)))
@@ -1812,7 +1857,7 @@ a tree with a select tag."
(lambda (obj)
(or (not (stringp obj)) (org-string-nw-p obj)))
options t))))
- (case (plist-get options :with-timestamps)
+ (cl-case (plist-get options :with-timestamps)
((nil) t)
(active
(not (memq (org-element-property :type blob) '(active active-range))))
@@ -1842,7 +1887,7 @@ a tree with a select tag."
INFO is a plist containing export directives."
(let ((type (org-element-type blob)))
;; Return contents only for complete parse trees.
- (if (eq type 'org-data) (lambda (blob contents info) contents)
+ (if (eq type 'org-data) (lambda (_datum contents _info) contents)
(let ((transcoder (cdr (assq type (plist-get info :translate-alist)))))
(and (functionp transcoder) transcoder)))))
@@ -1854,91 +1899,103 @@ string. INFO is a plist holding export options.
Return a string."
(or (gethash data (plist-get info :exported-data))
- (let* ((type (org-element-type data))
- (results
- (cond
- ;; Ignored element/object.
- ((memq data (plist-get info :ignore-list)) nil)
- ;; Plain text.
- ((eq type 'plain-text)
- (org-export-filter-apply-functions
- (plist-get info :filter-plain-text)
- (let ((transcoder (org-export-transcoder data info)))
- (if transcoder (funcall transcoder data info) data))
- info))
- ;; Secondary string.
- ((not type)
- (mapconcat (lambda (obj) (org-export-data obj info)) data ""))
- ;; Element/Object without contents or, as a special
- ;; case, headline with archive tag and archived trees
- ;; restricted to title only.
- ((or (not (org-element-contents data))
- (and (eq type 'headline)
- (eq (plist-get info :with-archived-trees) 'headline)
- (org-element-property :archivedp data)))
- (let ((transcoder (org-export-transcoder data info)))
- (or (and (functionp transcoder)
- (funcall transcoder data nil info))
- ;; Export snippets never return a nil value so
- ;; that white spaces following them are never
- ;; ignored.
- (and (eq type 'export-snippet) ""))))
- ;; Element/Object with contents.
- (t
- (let ((transcoder (org-export-transcoder data info)))
- (when transcoder
- (let* ((greaterp (memq type org-element-greater-elements))
- (objectp
- (and (not greaterp)
- (memq type org-element-recursive-objects)))
- (contents
- (mapconcat
- (lambda (element) (org-export-data element info))
- (org-element-contents
- (if (or greaterp objectp) data
- ;; Elements directly containing
- ;; objects must have their indentation
- ;; normalized first.
- (org-element-normalize-contents
- data
- ;; When normalizing contents of the
- ;; first paragraph in an item or
- ;; a footnote definition, ignore
- ;; first line's indentation: there is
- ;; none and it might be misleading.
- (when (eq type 'paragraph)
- (let ((parent (org-export-get-parent data)))
+ ;; Handle broken links according to
+ ;; `org-export-with-broken-links'.
+ (cl-macrolet
+ ((broken-link-handler
+ (&rest body)
+ `(condition-case err
+ (progn ,@body)
+ (org-link-broken
+ (pcase (plist-get info :with-broken-links)
+ (`nil (user-error "Unable to resolve link: %S" (nth 1 err)))
+ (`mark (org-export-data
+ (format "[BROKEN LINK: %s]" (nth 1 err)) info))
+ (_ nil))))))
+ (let* ((type (org-element-type data))
+ (parent (org-export-get-parent data))
+ (results
+ (cond
+ ;; Ignored element/object.
+ ((memq data (plist-get info :ignore-list)) nil)
+ ;; Plain text.
+ ((eq type 'plain-text)
+ (org-export-filter-apply-functions
+ (plist-get info :filter-plain-text)
+ (let ((transcoder (org-export-transcoder data info)))
+ (if transcoder (funcall transcoder data info) data))
+ info))
+ ;; Secondary string.
+ ((not type)
+ (mapconcat (lambda (obj) (org-export-data obj info)) data ""))
+ ;; Element/Object without contents or, as a special
+ ;; case, headline with archive tag and archived trees
+ ;; restricted to title only.
+ ((or (not (org-element-contents data))
+ (and (eq type 'headline)
+ (eq (plist-get info :with-archived-trees) 'headline)
+ (org-element-property :archivedp data)))
+ (let ((transcoder (org-export-transcoder data info)))
+ (or (and (functionp transcoder)
+ (broken-link-handler
+ (funcall transcoder data nil info)))
+ ;; Export snippets never return a nil value so
+ ;; that white spaces following them are never
+ ;; ignored.
+ (and (eq type 'export-snippet) ""))))
+ ;; Element/Object with contents.
+ (t
+ (let ((transcoder (org-export-transcoder data info)))
+ (when transcoder
+ (let* ((greaterp (memq type org-element-greater-elements))
+ (objectp
+ (and (not greaterp)
+ (memq type org-element-recursive-objects)))
+ (contents
+ (mapconcat
+ (lambda (element) (org-export-data element info))
+ (org-element-contents
+ (if (or greaterp objectp) data
+ ;; Elements directly containing
+ ;; objects must have their indentation
+ ;; normalized first.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing contents of the
+ ;; first paragraph in an item or
+ ;; a footnote definition, ignore
+ ;; first line's indentation: there is
+ ;; none and it might be misleading.
+ (when (eq type 'paragraph)
(and
(eq (car (org-element-contents parent))
data)
(memq (org-element-type parent)
- '(footnote-definition item))))))))
- "")))
- (funcall transcoder data
- (if (not greaterp) contents
- (org-element-normalize-string contents))
- info))))))))
- ;; Final result will be memoized before being returned.
- (puthash
- data
- (cond
- ((not results) "")
- ((memq type '(org-data plain-text nil)) results)
- ;; Append the same white space between elements or objects
- ;; as in the original buffer, and call appropriate filters.
- (t
- (let ((results
- (org-export-filter-apply-functions
- (plist-get info (intern (format ":filter-%s" type)))
- (let ((post-blank (or (org-element-property :post-blank data)
- 0)))
- (if (memq type org-element-all-elements)
- (concat (org-element-normalize-string results)
- (make-string post-blank ?\n))
- (concat results (make-string post-blank ?\s))))
- info)))
- results)))
- (plist-get info :exported-data)))))
+ '(footnote-definition item)))))))
+ "")))
+ (broken-link-handler
+ (funcall transcoder data
+ (if (not greaterp) contents
+ (org-element-normalize-string contents))
+ info)))))))))
+ ;; Final result will be memoized before being returned.
+ (puthash
+ data
+ (cond
+ ((not results) "")
+ ((memq type '(org-data plain-text nil)) results)
+ ;; Append the same white space between elements or objects
+ ;; as in the original buffer, and call appropriate filters.
+ (t
+ (org-export-filter-apply-functions
+ (plist-get info (intern (format ":filter-%s" type)))
+ (let ((blank (or (org-element-property :post-blank data) 0)))
+ (if (eq (org-element-class data parent) 'object)
+ (concat results (make-string blank ?\s))
+ (concat (org-element-normalize-string results)
+ (make-string blank ?\n))))
+ info)))
+ (plist-get info :exported-data))))))
(defun org-export-data-with-backend (data backend info)
"Convert DATA into BACKEND format.
@@ -1972,7 +2029,8 @@ contents, as a string or nil.
When optional argument WITH-AFFILIATED is non-nil, add affiliated
keywords before output."
(let ((type (org-element-type blob)))
- (concat (and with-affiliated (memq type org-element-all-elements)
+ (concat (and with-affiliated
+ (eq (org-element-class blob) 'element)
(org-element--interpret-affiliated-keywords blob))
(funcall (intern (format "org-element-%s-interpreter" type))
blob contents))))
@@ -2437,29 +2495,27 @@ Return the updated communication channel."
(let (plist)
;; Install user-defined filters with `org-export-filters-alist'
;; and filters already in INFO (through ext-plist mechanism).
- (mapc (lambda (p)
- (let* ((prop (car p))
- (info-value (plist-get info prop))
- (default-value (symbol-value (cdr p))))
- (setq plist
- (plist-put plist prop
- ;; Filters in INFO will be called
- ;; before those user provided.
- (append (if (listp info-value) info-value
- (list info-value))
- default-value)))))
- org-export-filters-alist)
+ (dolist (p org-export-filters-alist)
+ (let* ((prop (car p))
+ (info-value (plist-get info prop))
+ (default-value (symbol-value (cdr p))))
+ (setq plist
+ (plist-put plist prop
+ ;; Filters in INFO will be called
+ ;; before those user provided.
+ (append (if (listp info-value) info-value
+ (list info-value))
+ default-value)))))
;; Prepend back-end specific filters to that list.
- (mapc (lambda (p)
- ;; Single values get consed, lists are appended.
- (let ((key (car p)) (value (cdr p)))
- (when value
- (setq plist
- (plist-put
- plist key
- (if (atom value) (cons value (plist-get plist key))
- (append value (plist-get plist key))))))))
- (org-export-get-all-filters (plist-get info :back-end)))
+ (dolist (p (org-export-get-all-filters (plist-get info :back-end)))
+ ;; Single values get consed, lists are appended.
+ (let ((key (car p)) (value (cdr p)))
+ (when value
+ (setq plist
+ (plist-put
+ plist key
+ (if (atom value) (cons value (plist-get plist key))
+ (append value (plist-get plist key))))))))
;; Return new communication channel.
(org-combine-plists info plist)))
@@ -2572,17 +2628,14 @@ The function assumes BUFFER's major mode is `org-mode'."
(goto-char ,(point))
;; Overlays with invisible property.
,@(let (ov-set)
- (mapc
- (lambda (ov)
- (let ((invis-prop (overlay-get ov 'invisible)))
- (when invis-prop
- (push `(overlay-put
- (make-overlay ,(overlay-start ov)
- ,(overlay-end ov))
- 'invisible (quote ,invis-prop))
- ov-set))))
- (overlays-in (point-min) (point-max)))
- ov-set)))))
+ (dolist (ov (overlays-in (point-min) (point-max)) ov-set)
+ (let ((invis-prop (overlay-get ov 'invisible)))
+ (when invis-prop
+ (push `(overlay-put
+ (make-overlay ,(overlay-start ov)
+ ,(overlay-end ov))
+ 'invisible (quote ,invis-prop))
+ ov-set)))))))))
(defun org-export--delete-comments ()
"Delete commented areas in the buffer.
@@ -2598,12 +2651,12 @@ the document. Narrowing, if any, is ignored."
comment-re)))
(while (re-search-forward regexp nil t)
(let ((element (org-element-at-point)))
- (case (org-element-type element)
- ((headline inlinetask)
+ (pcase (org-element-type element)
+ ((or `headline `inlinetask)
(when (org-element-property :commentedp element)
(delete-region (org-element-property :begin element)
(org-element-property :end element))))
- ((comment comment-block)
+ ((or `comment `comment-block)
(let* ((parent (org-element-property :parent element))
(start (org-element-property :begin element))
(end (org-element-property :end element))
@@ -2622,7 +2675,7 @@ the document. Narrowing, if any, is ignored."
end)
(progn
(forward-line -1)
- (or (org-looking-at-p "^[ \t]*$")
+ (or (looking-at-p "^[ \t]*$")
(org-with-limited-levels
(org-at-heading-p)))))))))
(delete-region start end)
@@ -2634,33 +2687,47 @@ DATA is the parse tree to traverse. INFO is the plist holding
export info. Also set `:ignore-list' in INFO to a list of
objects which should be ignored during export, but not removed
from tree."
- (let* (walk-data
- ignore
- ;; First find trees containing a select tag, if any.
- (selected (org-export--selected-trees data info))
- (walk-data
- (lambda (data)
- ;; Prune non-exportable elements and objects from tree.
- ;; As a special case, special rows and cells from tables
- ;; are stored in IGNORE, as they still need to be accessed
- ;; during export.
- (when data
- (let ((type (org-element-type data)))
- (if (org-export--skip-p data info selected)
- (if (memq type '(table-cell table-row)) (push data ignore)
- (org-element-extract-element data))
- (if (and (eq type 'headline)
- (eq (plist-get info :with-archived-trees) 'headline)
- (org-element-property :archivedp data))
- ;; If headline is archived but tree below has to
- ;; be skipped, remove contents.
- (org-element-set-contents data)
- ;; Move into recursive objects/elements.
- (mapc walk-data (org-element-contents data)))
- ;; Move into secondary string, if any.
- (dolist (p (cdr (assq type
- org-element-secondary-value-alist)))
- (mapc walk-data (org-element-property p data)))))))))
+ (letrec ((ignore nil)
+ ;; First find trees containing a select tag, if any.
+ (selected (org-export--selected-trees data info))
+ (walk-data
+ (lambda (data)
+ ;; Prune non-exportable elements and objects from tree.
+ ;; As a special case, special rows and cells from tables
+ ;; are stored in IGNORE, as they still need to be
+ ;; accessed during export.
+ (when data
+ (let ((type (org-element-type data)))
+ (if (org-export--skip-p data info selected)
+ (if (memq type '(table-cell table-row)) (push data ignore)
+ (org-element-extract-element data))
+ (if (and (eq type 'headline)
+ (eq (plist-get info :with-archived-trees)
+ 'headline)
+ (org-element-property :archivedp data))
+ ;; If headline is archived but tree below has
+ ;; to be skipped, remove contents.
+ (org-element-set-contents data)
+ ;; Move into recursive objects/elements.
+ (mapc walk-data (org-element-contents data)))
+ ;; Move into secondary string, if any.
+ (dolist (p (cdr (assq type
+ org-element-secondary-value-alist)))
+ (mapc walk-data (org-element-property p data))))))))
+ (definitions
+ ;; Collect definitions before possibly pruning them so as
+ ;; to avoid parsing them again if they are required.
+ (org-element-map data '(footnote-definition footnote-reference)
+ (lambda (f)
+ (cond
+ ((eq (org-element-type f) 'footnote-definition) f)
+ ((eq (org-element-property :type f) 'standard) nil)
+ (t (let ((label (org-element-property :label f)))
+ (when label ;Skip anonymous references.
+ (apply
+ #'org-element-create
+ 'footnote-definition `(:label ,label :post-blank 1)
+ (org-element-contents f))))))))))
;; If a select tag is active, also ignore the section before the
;; first headline, if any.
(when selected
@@ -2669,16 +2736,156 @@ from tree."
(org-element-extract-element first-element))))
;; Prune tree and communication channel.
(funcall walk-data data)
- (dolist (entry
- (append
- ;; Priority is given to back-end specific options.
- (org-export-get-all-options (plist-get info :back-end))
- org-export-options-alist))
+ (dolist (entry (append
+ ;; Priority is given to back-end specific options.
+ (org-export-get-all-options (plist-get info :back-end))
+ org-export-options-alist))
(when (eq (nth 4 entry) 'parse)
(funcall walk-data (plist-get info (car entry)))))
+ (let ((missing (org-export--missing-definitions data definitions)))
+ (funcall walk-data missing)
+ (org-export--install-footnote-definitions missing data))
;; Eventually set `:ignore-list'.
(plist-put info :ignore-list ignore)))
+(defun org-export--missing-definitions (tree definitions)
+ "List footnote definitions missing from TREE.
+Missing definitions are searched within DEFINITIONS, which is
+a list of footnote definitions or in the widened buffer."
+ (let* ((list-labels
+ (lambda (data)
+ ;; List all footnote labels encountered in DATA. Inline
+ ;; footnote references are ignored.
+ (org-element-map data 'footnote-reference
+ (lambda (reference)
+ (and (eq (org-element-property :type reference) 'standard)
+ (org-element-property :label reference))))))
+ defined undefined missing-definitions)
+ ;; Partition DIRECT-REFERENCES between DEFINED and UNDEFINED
+ ;; references.
+ (let ((known-definitions
+ (org-element-map tree '(footnote-reference footnote-definition)
+ (lambda (f)
+ (and (or (eq (org-element-type f) 'footnote-definition)
+ (eq (org-element-property :type f) 'inline))
+ (org-element-property :label f)))))
+ seen)
+ (dolist (l (funcall list-labels tree))
+ (cond ((member l seen))
+ ((member l known-definitions) (push l defined))
+ (t (push l undefined)))))
+ ;; Complete MISSING-DEFINITIONS by finding the definition of every
+ ;; undefined label, first by looking into DEFINITIONS, then by
+ ;; searching the widened buffer. This is a recursive process
+ ;; since definitions found can themselves contain an undefined
+ ;; reference.
+ (while undefined
+ (let* ((label (pop undefined))
+ (definition
+ (cond
+ ((cl-some
+ (lambda (d) (and (equal (org-element-property :label d) label)
+ d))
+ definitions))
+ ((pcase (org-footnote-get-definition label)
+ (`(,_ ,beg . ,_)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (let ((datum (org-element-context)))
+ (if (eq (org-element-type datum) 'footnote-reference)
+ datum
+ ;; Parse definition with contents.
+ (save-restriction
+ (narrow-to-region
+ (org-element-property :begin datum)
+ (org-element-property :end datum))
+ (org-element-map (org-element-parse-buffer)
+ 'footnote-definition #'identity nil t))))))
+ (_ nil)))
+ (t (user-error "Definition not found for footnote %s" label)))))
+ (push label defined)
+ (push definition missing-definitions)
+ ;; Look for footnote references within DEFINITION, since
+ ;; we may need to also find their definition.
+ (dolist (l (funcall list-labels definition))
+ (unless (or (member l defined) ;Known label
+ (member l undefined)) ;Processed later
+ (push l undefined)))))
+ ;; MISSING-DEFINITIONS may contain footnote references with inline
+ ;; definitions. Make sure those are changed into real footnote
+ ;; definitions.
+ (mapcar (lambda (d)
+ (if (eq (org-element-type d) 'footnote-definition) d
+ (let ((label (org-element-property :label d)))
+ (apply #'org-element-create
+ 'footnote-definition `(:label ,label :post-blank 1)
+ (org-element-contents d)))))
+ missing-definitions)))
+
+(defun org-export--install-footnote-definitions (definitions tree)
+ "Install footnote definitions in tree.
+
+DEFINITIONS is the list of footnote definitions to install. TREE
+is the parse tree.
+
+If there is a footnote section in TREE, definitions found are
+appended to it. If `org-footnote-section' is non-nil, a new
+footnote section containing all definitions is inserted in TREE.
+Otherwise, definitions are appended at the end of the section
+containing their first reference."
+ (cond
+ ((null definitions))
+ ;; If there is a footnote section, insert definitions there.
+ ((let ((footnote-section
+ (org-element-map tree 'headline
+ (lambda (h) (and (org-element-property :footnote-section-p h) h))
+ nil t)))
+ (and footnote-section
+ (apply #'org-element-adopt-elements
+ footnote-section
+ (nreverse definitions)))))
+ ;; If there should be a footnote section, create one containing all
+ ;; the definitions at the end of the tree.
+ (org-footnote-section
+ (org-element-adopt-elements
+ tree
+ (org-element-create 'headline
+ (list :footnote-section-p t
+ :level 1
+ :title org-footnote-section)
+ (apply #'org-element-create
+ 'section
+ nil
+ (nreverse definitions)))))
+ ;; Otherwise add each definition at the end of the section where it
+ ;; is first referenced.
+ (t
+ (letrec ((seen nil)
+ (insert-definitions
+ (lambda (data)
+ ;; Insert footnote definitions in the same section as
+ ;; their first reference in DATA.
+ (org-element-map data 'footnote-reference
+ (lambda (reference)
+ (when (eq (org-element-property :type reference) 'standard)
+ (let ((label (org-element-property :label reference)))
+ (unless (member label seen)
+ (push label seen)
+ (let ((definition
+ (cl-some
+ (lambda (d)
+ (and (equal (org-element-property :label d)
+ label)
+ d))
+ definitions)))
+ (org-element-adopt-elements
+ (org-element-lineage reference '(section))
+ definition)
+ ;; Also insert definitions for nested
+ ;; references, if any.
+ (funcall insert-definitions definition))))))))))
+ (funcall insert-definitions tree)))))
+
(defun org-export--remove-uninterpreted-data (data info)
"Change uninterpreted elements back into Org syntax.
DATA is the parse tree. INFO is a plist containing export
@@ -2705,7 +2912,7 @@ returned by the function."
subscript superscript underline)
(lambda (blob)
(let ((new
- (case (org-element-type blob)
+ (cl-case (org-element-type blob)
;; ... entities...
(entity
(and (not (plist-get info :with-entities))
@@ -2717,7 +2924,7 @@ returned by the function."
;; ... emphasis...
((bold italic strike-through underline)
(and (not (plist-get info :with-emphasize))
- (let ((marker (case (org-element-type blob)
+ (let ((marker (cl-case (org-element-type blob)
(bold "*")
(italic "/")
(strike-through "+")
@@ -2762,131 +2969,6 @@ returned by the function."
;; Return modified parse tree.
data)
-(defun org-export--merge-external-footnote-definitions (tree)
- "Insert footnote definitions outside parsing scope in TREE.
-
-If there is a footnote section in TREE, definitions found are
-appended to it. If `org-footnote-section' is non-nil, a new
-footnote section containing all definitions is inserted in TREE.
-Otherwise, definitions are appended at the end of the section
-containing their first reference.
-
-Only definitions actually referred to within TREE, directly or
-not, are considered."
- (let* ((collect-labels
- (lambda (data)
- (org-element-map data 'footnote-reference
- (lambda (f)
- (and (eq (org-element-property :type f) 'standard)
- (org-element-property :label f))))))
- (referenced-labels (funcall collect-labels tree)))
- (when referenced-labels
- (let* ((definitions)
- (push-definition
- (lambda (datum)
- (case (org-element-type datum)
- (footnote-definition
- (push (save-restriction
- (narrow-to-region (org-element-property :begin datum)
- (org-element-property :end datum))
- (org-element-map (org-element-parse-buffer)
- 'footnote-definition #'identity nil t))
- definitions))
- (footnote-reference
- (let ((label (org-element-property :label datum))
- (cbeg (org-element-property :contents-begin datum)))
- (when (and label cbeg
- (eq (org-element-property :type datum) 'inline))
- (push
- (apply #'org-element-create
- 'footnote-definition
- (list :label label :post-blank 1)
- (org-element-parse-secondary-string
- (buffer-substring
- cbeg (org-element-property :contents-end datum))
- (org-element-restriction 'footnote-reference)))
- definitions))))))))
- ;; Collect all out of scope definitions.
- (save-excursion
- (goto-char (point-min))
- (org-with-wide-buffer
- (while (re-search-backward org-footnote-re nil t)
- (funcall push-definition (org-element-context))))
- (goto-char (point-max))
- (org-with-wide-buffer
- (while (re-search-forward org-footnote-re nil t)
- (funcall push-definition (org-element-context)))))
- ;; Filter out definitions referenced neither in the original
- ;; tree nor in the external definitions.
- (let* ((directly-referenced
- (org-remove-if-not
- (lambda (d)
- (member (org-element-property :label d) referenced-labels))
- definitions))
- (all-labels
- (append (funcall collect-labels directly-referenced)
- referenced-labels)))
- (setq definitions
- (org-remove-if-not
- (lambda (d)
- (member (org-element-property :label d) all-labels))
- definitions)))
- ;; Install definitions in subtree.
- (cond
- ((null definitions))
- ;; If there is a footnote section, insert them here.
- ((let ((footnote-section
- (org-element-map tree 'headline
- (lambda (h)
- (and (org-element-property :footnote-section-p h) h))
- nil t)))
- (and footnote-section
- (apply #'org-element-adopt-elements (nreverse definitions)))))
- ;; If there should be a footnote section, create one containing
- ;; all the definitions at the end of the tree.
- (org-footnote-section
- (org-element-adopt-elements
- tree
- (org-element-create 'headline
- (list :footnote-section-p t
- :level 1
- :title org-footnote-section)
- (apply #'org-element-create
- 'section
- nil
- (nreverse definitions)))))
- ;; Otherwise add each definition at the end of the section where
- ;; it is first referenced.
- (t
- (let* ((seen)
- (insert-definitions) ; For byte-compiler.
- (insert-definitions
- (lambda (data)
- ;; Insert definitions in the same section as their
- ;; first reference in DATA.
- (org-element-map tree 'footnote-reference
- (lambda (f)
- (when (eq (org-element-property :type f) 'standard)
- (let ((label (org-element-property :label f)))
- (unless (member label seen)
- (push label seen)
- (let ((definition
- (catch 'found
- (dolist (d definitions)
- (when (equal
- (org-element-property :label d)
- label)
- (setq definitions
- (delete d definitions))
- (throw 'found d))))))
- (when definition
- (org-element-adopt-elements
- (org-element-lineage f '(section))
- definition)
- (funcall insert-definitions
- definition)))))))))))
- (funcall insert-definitions tree))))))))
-
;;;###autoload
(defun org-export-as
(backend &optional subtreep visible-only body-only ext-plist)
@@ -2934,11 +3016,8 @@ Return code as a string."
;; attributes, unavailable in its copy.
(let* ((org-export-current-backend (org-export-backend-name backend))
(info (org-combine-plists
- (list :export-options
- (delq nil
- (list (and subtreep 'subtree)
- (and visible-only 'visible-only)
- (and body-only 'body-only))))
+ (org-export--get-export-attributes
+ backend subtreep visible-only body-only)
(org-export--get-buffer-attributes)))
(parsed-keywords
(delq nil
@@ -2963,9 +3042,10 @@ Return code as a string."
;; again after executing Babel code.
(org-set-regexps-and-options)
(org-update-radio-target-regexp)
- (org-export-execute-babel-code)
- (org-set-regexps-and-options)
- (org-update-radio-target-regexp)
+ (when org-export-babel-evaluate
+ (org-babel-exp-process-buffer)
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp))
;; Run last hook with current back-end's name as argument.
;; Update buffer properties and radio targets one last time
;; before parsing.
@@ -3013,8 +3093,6 @@ Return code as a string."
parsed-keywords)
;; Parse buffer.
(setq tree (org-element-parse-buffer nil visible-only))
- ;; Merge footnote definitions outside scope into parse tree.
- (org-export--merge-external-footnote-definitions tree)
;; Prune tree from non-exported elements and transform
;; uninterpreted elements or objects in both parse tree and
;; communication channel.
@@ -3026,9 +3104,7 @@ Return code as a string."
(plist-get info :filter-parse-tree) tree info))
;; Now tree is complete, compute its properties and add them
;; to communication channel.
- (setq info
- (org-combine-plists
- info (org-export-collect-tree-properties tree info)))
+ (setq info (org-export--collect-tree-properties tree info))
;; Eventually transcode TREE. Wrap the resulting string into
;; a template.
(let* ((body (org-element-normalize-string
@@ -3146,7 +3222,7 @@ locally for the subtree through node properties."
(< (+ width (length (car items)) 1) fill-column))
(let ((item (pop items)))
(insert " " item)
- (incf width (1+ (length item))))))
+ (cl-incf width (1+ (length item))))))
(insert "\n")))))
;; Then the rest of keywords, in the order specified in either
;; `org-export-options-alist' or respective export back-ends.
@@ -3213,8 +3289,7 @@ storing and resolving footnotes. It is created automatically."
(setq matched
(replace-match "" nil nil matched 1)))
(expand-file-name
- (org-remove-double-quotes
- matched)
+ (org-unbracket-string "\"" "\"" matched)
dir)))
(setq value (replace-match "" nil nil value)))))
(only-contents
@@ -3228,10 +3303,12 @@ storing and resolving footnotes. It is created automatically."
value)
(prog1 (match-string 1 value)
(setq value (replace-match "" nil nil value)))))
- (env (cond ((string-match "\\<example\\>" value)
- 'literal)
- ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
- 'literal)))
+ (env (cond
+ ((string-match "\\<example\\>" value) 'literal)
+ ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value)
+ 'literal)
+ ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
+ 'literal)))
;; Minimal level of included file defaults to the child
;; level of the current headline, if any, or one. It
;; only applies is the file is meant to be included as
@@ -3243,12 +3320,11 @@ storing and resolving footnotes. It is created automatically."
(setq value (replace-match "" nil nil value)))
(get-text-property (point)
:org-include-induced-level))))
- (src-args (and (eq env 'literal)
- (match-string 1 value)))
+ (args (and (eq env 'literal) (match-string 1 value)))
(block (and (string-match "\\<\\(\\S-+\\)\\>" value)
(match-string 1 value))))
;; Remove keyword.
- (delete-region (point) (progn (forward-line) (point)))
+ (delete-region (point) (line-beginning-position 2))
(cond
((not file) nil)
((not (file-readable-p file))
@@ -3262,10 +3338,8 @@ storing and resolving footnotes. It is created automatically."
(cond
((eq env 'literal)
(insert
- (let ((ind-str (make-string ind ? ))
- (arg-str (if (stringp src-args)
- (format " %s" src-args)
- ""))
+ (let ((ind-str (make-string ind ?\s))
+ (arg-str (if (stringp args) (format " %s" args) ""))
(contents
(org-escape-code-in-string
(org-export--prepare-file-contents file lines))))
@@ -3273,7 +3347,7 @@ storing and resolving footnotes. It is created automatically."
ind-str block arg-str contents ind-str block))))
((stringp block)
(insert
- (let ((ind-str (make-string ind ? ))
+ (let ((ind-str (make-string ind ?\s))
(contents
(org-export--prepare-file-contents file lines)))
(format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
@@ -3292,7 +3366,7 @@ storing and resolving footnotes. It is created automatically."
(org-export--prepare-file-contents
file lines ind minlevel
(or (gethash file file-prefix)
- (puthash file (incf current-prefix) file-prefix))
+ (puthash file (cl-incf current-prefix) file-prefix))
footnotes)))
(org-export-expand-include-keyword
(cons (list file lines) included)
@@ -3304,7 +3378,7 @@ storing and resolving footnotes. It is created automatically."
(unless included
(org-with-wide-buffer
(goto-char (point-max))
- (maphash (lambda (k v) (insert (format "\n[%s] %s\n" k v)))
+ (maphash (lambda (k v) (insert (format "\n[fn:%s] %s\n" k v)))
footnotes)))))))))))
(defun org-export--inclusion-absolute-lines (file location only-contents lines)
@@ -3338,7 +3412,7 @@ Return a string of lines to be included in the format expected by
(memq (org-element-type element) '(headline inlinetask)))
;; Skip planning line and property-drawer.
(goto-char (point-min))
- (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at-p org-planning-line-re) (forward-line))
(when (looking-at org-property-drawer-re) (goto-char (match-end 0)))
(unless (bolp) (forward-line))
(narrow-to-region (point) (point-max))))
@@ -3366,7 +3440,7 @@ Return a string of lines to be included in the format expected by
(save-excursion
(+ start-line
(let ((counter 0))
- (while (< (point) end) (incf counter) (forward-line))
+ (while (< (point) end) (cl-incf counter) (forward-line))
counter))))))))
(defun org-export--prepare-file-contents
@@ -3425,7 +3499,7 @@ the included document."
(unless (eq major-mode 'org-mode)
(let ((org-inhibit-startup t)) (org-mode)))
(goto-char (point-min))
- (let ((ind-str (make-string ind ? )))
+ (let ((ind-str (make-string ind ?\s)))
(while (not (or (eobp) (looking-at org-outline-regexp-bol)))
;; Do not move footnote definitions out of column 0.
(unless (and (looking-at org-footnote-definition-re)
@@ -3461,17 +3535,14 @@ the included document."
(marker-max (point-max-marker))
(get-new-label
(lambda (label)
- ;; Generate new label from LABEL. If LABEL is akin to
- ;; [1] convert it to [fn:--ID-1]. Otherwise add "-ID-"
- ;; after "fn:".
- (if (org-string-match-p "\\`[0-9]+\\'" label)
- (format "fn:--%d-%s" id label)
- (format "fn:-%d-%s" id (substring label 3)))))
+ ;; Generate new label from LABEL by prefixing it with
+ ;; "-ID-".
+ (format "-%d-%s" id label)))
(set-new-label
(lambda (f old new)
;; Replace OLD label with NEW in footnote F.
(save-excursion
- (goto-char (1+ (org-element-property :begin f)))
+ (goto-char (+ (org-element-property :begin f) 4))
(looking-at (regexp-quote old))
(replace-match new))))
(seen-alist))
@@ -3507,14 +3578,6 @@ the included document."
(set-marker marker-max nil)))
(org-element-normalize-string (buffer-string))))
-(defun org-export-execute-babel-code ()
- "Execute every Babel code in the visible part of current buffer."
- ;; Get a pristine copy of current buffer so Babel references can be
- ;; properly resolved.
- (let ((reference (org-export-copy-buffer)))
- (unwind-protect (org-babel-exp-process-buffer reference)
- (kill-buffer reference))))
-
(defun org-export--copy-to-kill-ring-p ()
"Return a non-nil value when output should be added to the kill ring.
See also `org-export-copy-to-kill-ring'."
@@ -3666,16 +3729,28 @@ definition can be found, raise an error."
(let ((hash (make-hash-table :test #'equal)))
(plist-put info :footnote-definition-cache hash)
hash))))
- (or (gethash label cache)
- (puthash label
- (org-element-map (plist-get info :parse-tree)
- '(footnote-definition footnote-reference)
- (lambda (f)
- (and (equal (org-element-property :label f) label)
- (org-element-contents f)))
- info t)
- cache)
- (error "Definition not found for footnote %s" label))))))
+ (or
+ (gethash label cache)
+ (puthash label
+ (org-element-map (plist-get info :parse-tree)
+ '(footnote-definition footnote-reference)
+ (lambda (f)
+ (cond
+ ;; Skip any footnote with a different label.
+ ;; Also skip any standard footnote reference
+ ;; with the same label since those cannot
+ ;; contain a definition.
+ ((not (equal (org-element-property :label f) label)) nil)
+ ((eq (org-element-property :type f) 'standard) nil)
+ ((org-element-contents f))
+ ;; Even if the contents are empty, we can not
+ ;; return nil since that would eventually raise
+ ;; the error. Instead, return the equivalent
+ ;; empty string.
+ (t "")))
+ info t)
+ cache)
+ (error "Definition not found for footnote %s" label))))))
(defun org-export--footnote-reference-map
(function data info &optional body-first)
@@ -3684,41 +3759,41 @@ INFO is a plist containing export state. By default, as soon as
a new footnote reference is encountered, FUNCTION is called onto
its definition. However, if BODY-FIRST is non-nil, this step is
delayed until the end of the process."
- (let* ((definitions)
- (seen-refs)
- (search-ref) ; For byte-compiler.
- (search-ref
- (lambda (data delayp)
- ;; Search footnote references through DATA, filling
- ;; SEEN-REFS along the way. When DELAYP is non-nil, store
- ;; footnote definitions so they can be entered later.
- (org-element-map data 'footnote-reference
- (lambda (f)
- (funcall function f)
- (let ((--label (org-element-property :label f)))
- (unless (and --label (member --label seen-refs))
- (when --label (push --label seen-refs))
- ;; Search for subsequent references in footnote
- ;; definition so numbering follows reading logic,
- ;; unless DELAYP in non-nil.
- (cond
- (delayp
- (push (org-export-get-footnote-definition f info)
- definitions))
- ;; Do not force entering inline definitions,
- ;; since `org-element-map' already traverses them
- ;; at the right time.
- ((eq (org-element-property :type f) 'inline))
- (t (funcall search-ref
- (org-export-get-footnote-definition f info)
- nil))))))
- info nil
- ;; Don't enter footnote definitions since it will happen
- ;; when their first reference is found. Moreover, if
- ;; DELAYP is non-nil, make sure we postpone entering
- ;; definitions of inline references.
- (if delayp '(footnote-definition footnote-reference)
- 'footnote-definition)))))
+ (letrec ((definitions nil)
+ (seen-refs nil)
+ (search-ref
+ (lambda (data delayp)
+ ;; Search footnote references through DATA, filling
+ ;; SEEN-REFS along the way. When DELAYP is non-nil,
+ ;; store footnote definitions so they can be entered
+ ;; later.
+ (org-element-map data 'footnote-reference
+ (lambda (f)
+ (funcall function f)
+ (let ((--label (org-element-property :label f)))
+ (unless (and --label (member --label seen-refs))
+ (when --label (push --label seen-refs))
+ ;; Search for subsequent references in footnote
+ ;; definition so numbering follows reading
+ ;; logic, unless DELAYP in non-nil.
+ (cond
+ (delayp
+ (push (org-export-get-footnote-definition f info)
+ definitions))
+ ;; Do not force entering inline definitions,
+ ;; since `org-element-map' already traverses
+ ;; them at the right time.
+ ((eq (org-element-property :type f) 'inline))
+ (t (funcall search-ref
+ (org-export-get-footnote-definition f info)
+ nil))))))
+ info nil
+ ;; Don't enter footnote definitions since it will
+ ;; happen when their first reference is found.
+ ;; Moreover, if DELAYP is non-nil, make sure we
+ ;; postpone entering definitions of inline references.
+ (if delayp '(footnote-definition footnote-reference)
+ 'footnote-definition)))))
(funcall search-ref data body-first)
(funcall search-ref (nreverse definitions) nil)))
@@ -3744,7 +3819,7 @@ for inlined footnotes. Unreferenced definitions are ignored."
;; Collect footnote number, label and definition.
(let ((l (org-element-property :label f)))
(unless (and l (member l labels))
- (incf n)
+ (cl-incf n)
(push (list n l (org-export-get-footnote-definition f info)) alist))
(when l (push l labels))))
(or data (plist-get info :parse-tree)) info body-first)
@@ -3803,8 +3878,8 @@ process, leading to a different order when footnotes are nested."
((and label l (string= label l)) (throw 'exit (1+ count)))
;; Otherwise store label and increase counter if label
;; wasn't encountered yet.
- ((not l) (incf count))
- ((not (member l seen)) (push l seen) (incf count)))))
+ ((not l) (cl-incf count))
+ ((not (member l seen)) (push l seen) (cl-incf count)))))
(or data (plist-get info :parse-tree)) info body-first))))
@@ -3861,7 +3936,7 @@ INFO is a plist holding contextual information."
(defun org-export-numbered-headline-p (headline info)
"Return a non-nil value if HEADLINE element should be numbered.
INFO is a plist used as a communication channel."
- (unless (org-some
+ (unless (cl-some
(lambda (head) (org-not-nil (org-element-property :UNNUMBERED head)))
(org-element-lineage headline nil t))
(let ((sec-num (plist-get info :section-numbers))
@@ -3890,18 +3965,13 @@ INFO is a plist used as a communication channel."
ELEMENT has either an `headline' or an `inlinetask' type. INFO
is a plist used as a communication channel.
-Select tags (see `org-export-select-tags') and exclude tags (see
-`org-export-exclude-tags') are removed from the list.
-
When non-nil, optional argument TAGS should be a list of strings.
Any tag belonging to this list will also be removed.
When optional argument INHERITED is non-nil, tags can also be
inherited from parent headlines and FILETAGS keywords."
- (org-remove-if
- (lambda (tag) (or (member tag (plist-get info :select-tags))
- (member tag (plist-get info :exclude-tags))
- (member tag tags)))
+ (cl-remove-if
+ (lambda (tag) (member tag tags))
(if (not inherited) (org-element-property :tags element)
;; Build complete list of inherited tags.
(let ((current-tag-list (org-element-property :tags element)))
@@ -3926,7 +3996,7 @@ Return value is a string or nil."
(let ((headline (if (eq (org-element-type blob) 'headline) blob
(org-export-get-parent-headline blob))))
(if (not inherited) (org-element-property property blob)
- (let ((parent headline) value)
+ (let ((parent headline))
(catch 'found
(while parent
(when (plist-member (nth 1 parent) property)
@@ -3951,10 +4021,9 @@ fail, the fall-back value is \"???\"."
(and file (file-name-sans-extension (file-name-nondirectory file))))
"???"))
-(defun org-export-get-alt-title (headline info)
+(defun org-export-get-alt-title (headline _)
"Return alternative title for HEADLINE, as a secondary string.
-INFO is a plist used as a communication channel. If no optional
-title is defined, fall-back to the regular title."
+If no optional title is defined, fall-back to the regular title."
(let ((alt (org-element-property :ALT_TITLE headline)))
(if alt (org-element-parse-secondary-string
alt (org-element-restriction 'headline) headline)
@@ -4004,7 +4073,7 @@ meant to be translated with `org-export-data' or alike."
;;;; For Links
;;
;; `org-export-custom-protocol-maybe' handles custom protocol defined
-;; with `org-add-link-type', which see.
+;; in `org-link-parameters'.
;;
;; `org-export-get-coderef-format' returns an appropriate format
;; string for coderefs.
@@ -4014,11 +4083,11 @@ meant to be translated with `org-export-data' or alike."
;;
;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links
;; (i.e. links with "fuzzy" as type) within the parsed tree, and
-;; returns an appropriate unique identifier when found, or nil.
+;; returns an appropriate unique identifier.
;;
;; `org-export-resolve-id-link' returns the first headline with
;; specified id or custom-id in parse tree, the path to the external
-;; file with the id or nil when neither was found.
+;; file with the id.
;;
;; `org-export-resolve-coderef' associates a reference to a line
;; number in the element it belongs, or returns the reference itself
@@ -4026,6 +4095,12 @@ meant to be translated with `org-export-data' or alike."
;;
;; `org-export-file-uri' expands a filename as stored in :path value
;; of a "file" link into a file URI.
+;;
+;; Broken links raise a `org-link-broken' error, which is caught by
+;; `org-export-data' for further processing, depending on
+;; `org-export-with-broken-links' value.
+
+(org-define-error 'org-link-broken "Unable to resolve link; aborting")
(defun org-export-custom-protocol-maybe (link desc backend)
"Try exporting LINK with a dedicated function.
@@ -4041,7 +4116,7 @@ The function ignores links with an implicit type (e.g.,
(let ((type (org-element-property :type link)))
(unless (or (member type '("coderef" "custom-id" "fuzzy" "radio"))
(not backend))
- (let ((protocol (nth 2 (assoc type org-link-protocols))))
+ (let ((protocol (org-link-get-parameter type :export)))
(and (functionp protocol)
(funcall protocol
(org-link-unescape (org-element-property :path link))
@@ -4076,8 +4151,8 @@ This only applies to links without a description."
(catch 'exit
(dolist (rule (or rules org-export-default-inline-image-rule))
(and (string= (org-element-property :type link) (car rule))
- (org-string-match-p (cdr rule)
- (org-element-property :path link))
+ (string-match-p (cdr rule)
+ (org-element-property :path link))
(throw 'exit t)))))))
(defun org-export-resolve-coderef (ref info)
@@ -4103,11 +4178,69 @@ error if no block contains REF."
(when (re-search-backward ref-re nil t)
(cond
((org-element-property :use-labels el) ref)
- ((eq (org-element-property :number-lines el) 'continued)
- (+ (org-export-get-loc el info) (line-number-at-pos)))
- (t (line-number-at-pos)))))))
+ (t (+ (or (org-export-get-loc el info) 0) (line-number-at-pos))))))))
info 'first-match)
- (user-error "Unable to resolve code reference: %s" ref)))
+ (signal 'org-link-broken (list ref))))
+
+(defun org-export-search-cells (datum)
+ "List search cells for element or object DATUM.
+
+A search cell follows the pattern (TYPE . SEARCH) where
+
+ TYPE is a symbol among `headline', `custom-id', `target' and
+ `other'.
+
+ SEARCH is the string a link is expected to match. More
+ accurately, it is
+
+ - headline's title, as a list of strings, if TYPE is
+ `headline'.
+
+ - CUSTOM_ID value, as a string, if TYPE is `custom-id'.
+
+ - target's or radio-target's name as a list of strings if
+ TYPE is `target'.
+
+ - NAME affiliated keyword is TYPE is `other'.
+
+A search cell is the internal representation of a fuzzy link. It
+ignores white spaces and statistics cookies, if applicable."
+ (pcase (org-element-type datum)
+ (`headline
+ (let ((title (split-string
+ (replace-regexp-in-string
+ "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" ""
+ (org-element-property :raw-value datum)))))
+ (delq nil
+ (list
+ (cons 'headline title)
+ (cons 'other title)
+ (let ((custom-id (org-element-property :custom-id datum)))
+ (and custom-id (cons 'custom-id custom-id)))))))
+ (`target
+ (list (cons 'target (split-string (org-element-property :value datum)))))
+ ((and (let name (org-element-property :name datum))
+ (guard name))
+ (list (cons 'other (split-string name))))
+ (_ nil)))
+
+(defun org-export-string-to-search-cell (s)
+ "Return search cells associated to string S.
+S is either the path of a fuzzy link or a search option, i.e., it
+tries to match either a headline (through custom ID or title),
+a target or a named element."
+ (pcase (string-to-char s)
+ (?* (list (cons 'headline (split-string (substring s 1)))))
+ (?# (list (cons 'custom-id (substring s 1))))
+ ((let search (split-string s))
+ (list (cons 'target search) (cons 'other search)))))
+
+(defun org-export-match-search-cell-p (datum cells)
+ "Non-nil when DATUM matches search cells CELLS.
+DATUM is an element or object. CELLS is a list of search cells,
+as returned by `org-export-search-cells'."
+ (let ((targets (org-export-search-cells datum)))
+ (and targets (cl-some (lambda (cell) (member cell targets)) cells))))
(defun org-export-resolve-fuzzy-link (link info)
"Return LINK destination.
@@ -4128,54 +4261,37 @@ Return value can be an object or an element:
Assume LINK type is \"fuzzy\". White spaces are not
significant."
- (let* ((raw-path (org-link-unescape (org-element-property :path link)))
- (headline-only (eq (string-to-char raw-path) ?*))
- ;; Split PATH at white spaces so matches are space
- ;; insensitive.
- (path (org-split-string
- (if headline-only (substring raw-path 1) raw-path)))
+ (let* ((search-cells (org-export-string-to-search-cell
+ (org-link-unescape (org-element-property :path link))))
(link-cache
(or (plist-get info :resolve-fuzzy-link-cache)
(plist-get (plist-put info
:resolve-fuzzy-link-cache
(make-hash-table :test #'equal))
:resolve-fuzzy-link-cache)))
- (cached (gethash path link-cache 'not-found)))
+ (cached (gethash search-cells link-cache 'not-found)))
(if (not (eq cached 'not-found)) cached
- (let ((ast (plist-get info :parse-tree)))
+ (let ((matches
+ (org-element-map (plist-get info :parse-tree)
+ (cons 'target org-element-all-elements)
+ (lambda (datum)
+ (and (org-export-match-search-cell-p datum search-cells)
+ datum)))))
+ (unless matches
+ (signal 'org-link-broken
+ (list (org-element-property :raw-path link))))
(puthash
- path
- (cond
- ;; First try to find a matching "<<path>>" unless user
- ;; specified he was looking for a headline (path starts with
- ;; a "*" character).
- ((and (not headline-only)
- (org-element-map ast 'target
- (lambda (datum)
- (and (equal (org-split-string
- (org-element-property :value datum))
- path)
- datum))
- info 'first-match)))
- ;; Then try to find an element with a matching "#+NAME: path"
- ;; affiliated keyword.
- ((and (not headline-only)
- (org-element-map ast org-element-all-elements
- (lambda (datum)
- (let ((name (org-element-property :name datum)))
- (and name (equal (org-split-string name) path) datum)))
- info 'first-match)))
- ;; Try to find a matching headline.
- ((org-element-map ast 'headline
- (lambda (h)
- (and (equal (org-split-string
- (replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (org-element-property :raw-value h)))
- path)
- h))
- info 'first-match))
- (t (user-error "Unable to resolve link \"%s\"" raw-path)))
+ search-cells
+ ;; There can be multiple matches for un-typed searches, i.e.,
+ ;; for searches not starting with # or *. In this case,
+ ;; prioritize targets and names over headline titles.
+ ;; Matching both a name and a target is not valid, and
+ ;; therefore undefined.
+ (or (cl-some (lambda (datum)
+ (and (not (eq (org-element-type datum) 'headline))
+ datum))
+ matches)
+ (car matches))
link-cache)))))
(defun org-export-resolve-id-link (link info)
@@ -4196,7 +4312,7 @@ tree or a file name. Assume LINK type is either \"id\" or
info 'first-match)
;; Otherwise, look for external files.
(cdr (assoc id (plist-get info :id-alist)))
- (user-error "Unable to resolve ID \"%s\"" id))))
+ (signal 'org-link-broken (list id)))))
(defun org-export-resolve-radio-link (link info)
"Return radio-target object referenced as LINK destination.
@@ -4219,7 +4335,7 @@ has type \"radio\"."
(defun org-export-file-uri (filename)
"Return file URI associated to FILENAME."
- (cond ((org-string-match-p "\\`//" filename) (concat "file:" filename))
+ (cond ((string-match-p "\\`//" filename) (concat "file:" filename))
((not (file-name-absolute-p filename)) filename)
((org-file-remote-p filename) (concat "file:/" filename))
(t (concat "file://" (expand-file-name filename)))))
@@ -4228,29 +4344,63 @@ has type \"radio\"."
;;;; For References
;;
;; `org-export-get-reference' associate a unique reference for any
-;; object or element.
+;; object or element. It uses `org-export-new-reference' and
+;; `org-export-format-reference' to, respectively, generate new
+;; internal references and turn them into a string suitable for
+;; output.
;;
;; `org-export-get-ordinal' associates a sequence number to any object
;; or element.
+(defun org-export-new-reference (references)
+ "Return a unique reference, among REFERENCES.
+REFERENCES is an alist whose values are in-use references, as
+numbers. Returns a number, which is the internal representation
+of a reference. See also `org-export-format-reference'."
+ ;; Generate random 7 digits hexadecimal numbers. Collisions
+ ;; increase exponentially with the numbers of references. However,
+ ;; the odds for encountering at least one collision with 1000 active
+ ;; references in the same document are roughly 0.2%, so this
+ ;; shouldn't be the bottleneck.
+ (let ((new (random #x10000000)))
+ (while (rassq new references) (setq new (random #x10000000)))
+ new))
+
+(defun org-export-format-reference (reference)
+ "Format REFERENCE into a string.
+REFERENCE is a number representing a reference, as returned by
+`org-export-new-reference', which see."
+ (format "org%07x" reference))
+
(defun org-export-get-reference (datum info)
"Return a unique reference for DATUM, as a string.
+
DATUM is either an element or an object. INFO is the current
-export state, as a plist. Returned reference consists of
-alphanumeric characters only."
- (let ((type (org-element-type datum))
- (cache (or (plist-get info :internal-references)
- (let ((h (make-hash-table :test #'eq)))
- (plist-put info :internal-references h)
- h))))
- (or (gethash datum cache)
- (puthash datum
- (format "org%s%d"
- (if type
- (replace-regexp-in-string "-" "" (symbol-name type))
- "secondarystring")
- (incf (gethash type cache 0)))
- cache))))
+export state, as a plist.
+
+This function checks `:crossrefs' property in INFO for search
+cells matching DATUM before creating a new reference. Returned
+reference consists of alphanumeric characters only."
+ (let ((cache (plist-get info :internal-references)))
+ (or (car (rassq datum cache))
+ (let* ((crossrefs (plist-get info :crossrefs))
+ (cells (org-export-search-cells datum))
+ ;; If any other published document relies on an
+ ;; association between a search cell and a reference,
+ ;; make sure to preserve it. See
+ ;; `org-publish-resolve-external-link' for details.
+ (new (or (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells))
+ (org-export-new-reference cache)))
+ (reference-string (org-export-format-reference new)))
+ ;; Cache contains both data already associated to
+ ;; a reference and in-use internal references, so as to make
+ ;; unique references.
+ (dolist (cell cells) (push (cons cell new) cache))
+ ;; Keep an associated related to DATUM as not every object
+ ;; and element can be associated to a search cell.
+ (push (cons reference-string datum) cache)
+ (plist-put info :internal-references cache)
+ reference-string))))
(defun org-export-get-ordinal (element info &optional types predicate)
"Return ordinal number of an element or object.
@@ -4282,7 +4432,7 @@ objects of the same type."
(org-element-lineage
element
'(footnote-definition footnote-reference headline item table))))
- (case (org-element-type element)
+ (cl-case (org-element-type element)
;; Special case 1: A headline returns its number as a list.
(headline (org-export-get-headline-number element info))
;; Special case 2: An item returns its number as a list.
@@ -4302,8 +4452,8 @@ objects of the same type."
(lambda (el)
(cond
((eq element el) (1+ counter))
- ((not predicate) (incf counter) nil)
- ((funcall predicate el info) (incf counter) nil)))
+ ((not predicate) (cl-incf counter) nil)
+ ((funcall predicate el info) (cl-incf counter) nil)))
info 'first-match)))))
@@ -4330,32 +4480,34 @@ objects of the same type."
;; code in a format suitable for plain text or verbatim output.
(defun org-export-get-loc (element info)
- "Return accumulated lines of code up to ELEMENT.
-
-INFO is the plist used as a communication channel.
-
-ELEMENT is excluded from count."
- (let ((loc 0))
- (org-element-map (plist-get info :parse-tree)
- `(src-block example-block ,(org-element-type element))
- (lambda (el)
- (cond
- ;; ELEMENT is reached: Quit the loop.
- ((eq el element))
- ;; Only count lines from src-block and example-block elements
- ;; with a "+n" or "-n" switch. A "-n" switch resets counter.
- ((not (memq (org-element-type el) '(src-block example-block))) nil)
- ((let ((linums (org-element-property :number-lines el)))
- (when linums
- ;; Accumulate locs or reset them.
- (let ((lines (org-count-lines
- (org-trim (org-element-property :value el)))))
- (setq loc (if (eq linums 'new) lines (+ loc lines))))))
- ;; Return nil to stay in the loop.
- nil)))
- info 'first-match)
- ;; Return value.
- loc))
+ "Return count of lines of code before ELEMENT.
+
+ELEMENT is an example-block or src-block element. INFO is the
+plist used as a communication channel.
+
+Count includes every line of code in example-block or src-block
+with a \"+n\" or \"-n\" switch before block. Return nil if
+ELEMENT doesn't allow line numbering."
+ (pcase (org-element-property :number-lines element)
+ (`(new . ,n) n)
+ (`(continued . ,n)
+ (let ((loc 0))
+ (org-element-map (plist-get info :parse-tree) '(src-block example-block)
+ (lambda (el)
+ ;; ELEMENT is reached: Quit loop and return locs.
+ (if (eq el element) (+ loc n)
+ ;; Only count lines from src-block and example-block
+ ;; elements with a "+n" or "-n" switch.
+ (let ((linum (org-element-property :number-lines el)))
+ (when linum
+ (let ((lines (org-count-lines
+ (org-trim (org-element-property :value el)))))
+ ;; Accumulate locs or reset them.
+ (pcase linum
+ (`(new . ,n) (setq loc (+ n lines)))
+ (`(continued . ,n) (cl-incf loc (+ n lines)))))))
+ nil)) ;Return nil to stay in the loop.
+ info 'first-match)))))
(defun org-export-unravel-code (element)
"Clean source code and extract references out of it.
@@ -4377,24 +4529,17 @@ reference on that line (string)."
(if (or org-src-preserve-indentation
(org-element-property :preserve-indent element))
value
- (org-element-remove-indentation value)))))
- ;; Get format used for references.
- (label-fmt (regexp-quote
- (or (org-element-property :label-fmt element)
- org-coderef-label-format)))
+ (org-remove-indentation value)))))
;; Build a regexp matching a loc with a reference.
- (with-ref-re
- (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$"
- (replace-regexp-in-string
- "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t))))
+ (ref-re (org-src-coderef-regexp (org-src-coderef-format element))))
;; Return value.
(cons
;; Code with references removed.
(org-element-normalize-string
(mapconcat
(lambda (loc)
- (incf line)
- (if (not (string-match with-ref-re loc)) loc
+ (cl-incf line)
+ (if (not (string-match ref-re loc)) loc
;; Ref line: remove ref, and signal its position in REFS.
(push (cons line (match-string 3 loc)) refs)
(replace-match "" nil nil loc 1)))
@@ -4426,7 +4571,7 @@ be nil. It can be obtained through the use of
(org-element-normalize-string
(mapconcat
(lambda (--loc)
- (incf --line)
+ (cl-incf --line)
(let ((--ref (cdr (assq --line ref-alist))))
(funcall fun --loc (and num-lines (+ num-lines --line)) --ref)))
--locs "\n"))))
@@ -4451,9 +4596,7 @@ code."
(let* ((refs (and (org-element-property :retain-labels element)
(cdr code-info)))
;; Handle line numbering.
- (num-start (case (org-element-property :number-lines element)
- (continued (org-export-get-loc element info))
- (new 0)))
+ (num-start (org-export-get-loc element info))
(num-fmt
(and num-start
(format "%%%ds "
@@ -4517,16 +4660,14 @@ All special columns will be ignored during export."
;; only empty cells as special.
(let ((special-column-p 'empty))
(catch 'exit
- (mapc
- (lambda (row)
- (when (eq (org-element-property :type row) 'standard)
- (let ((value (org-element-contents
- (car (org-element-contents row)))))
- (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
- (setq special-column-p 'special))
- ((not value))
- (t (throw 'exit nil))))))
- (org-element-contents table))
+ (dolist (row (org-element-contents table))
+ (when (eq (org-element-property :type row) 'standard)
+ (let ((value (org-element-contents
+ (car (org-element-contents row)))))
+ (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
+ (setq special-column-p 'special))
+ ((not value))
+ (t (throw 'exit nil))))))
(eq special-column-p 'special))))
(defun org-export-table-has-header-p (table info)
@@ -4549,18 +4690,15 @@ A table has a header when it contains at least two row groups."
(cond
((> rowgroup 1) t)
((and row-flag (eq (org-element-property :type row) 'rule))
- (incf rowgroup) (setq row-flag nil))
+ (cl-incf rowgroup) (setq row-flag nil))
((and (not row-flag) (eq (org-element-property :type row)
'standard))
(setq row-flag t) nil)))
info 'first-match)
cache)))))
-(defun org-export-table-row-is-special-p (table-row info)
+(defun org-export-table-row-is-special-p (table-row _)
"Non-nil if TABLE-ROW is considered special.
-
-INFO is a plist used as the communication channel.
-
All special rows will be ignored during export."
(when (eq (org-element-property :type table-row) 'standard)
(let ((first-cell (org-element-contents
@@ -4577,19 +4715,17 @@ All special rows will be ignored during export."
;; ... it contains only alignment cookies and empty cells.
(let ((special-row-p 'empty))
(catch 'exit
- (mapc
- (lambda (cell)
- (let ((value (org-element-contents cell)))
- ;; Since VALUE is a secondary string, the following
- ;; checks avoid expanding it with `org-export-data'.
- (cond ((not value))
- ((and (not (cdr value))
- (stringp (car value))
- (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
- (car value)))
- (setq special-row-p 'cookie))
- (t (throw 'exit nil)))))
- (org-element-contents table-row))
+ (dolist (cell (org-element-contents table-row))
+ (let ((value (org-element-contents cell)))
+ ;; Since VALUE is a secondary string, the following
+ ;; checks avoid expanding it with `org-export-data'.
+ (cond ((not value))
+ ((and (not (cdr value))
+ (stringp (car value))
+ (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
+ (car value)))
+ (setq special-row-p 'cookie))
+ (t (throw 'exit nil)))))
(eq special-row-p 'cookie)))))))
(defun org-export-table-row-group (table-row info)
@@ -4612,7 +4748,7 @@ header."
(lambda (row)
(if (eq (org-element-property :type row) 'rule)
(setq row-flag nil)
- (unless row-flag (incf group) (setq row-flag t)))
+ (unless row-flag (cl-incf group) (setq row-flag t)))
(when (eq table-row row) (puthash table-row group cache)))
info 'first-match))))))
@@ -4712,14 +4848,14 @@ Possible values are `left', `right' and `center'."
(org-element-contents
(elt (org-element-contents row) column))
info)))
- (incf total-cells)
+ (cl-incf total-cells)
;; Treat an empty cell as a number if it follows
;; a number.
(if (not (or (string-match org-table-number-regexp value)
(and (string= value "") previous-cell-number-p)))
(setq previous-cell-number-p nil)
(setq previous-cell-number-p t)
- (incf number-cells))))))
+ (cl-incf number-cells))))))
;; Return value. Alignment specified by cookies has
;; precedence over alignment deduced from cell's contents.
(aset align-vector
@@ -4752,14 +4888,13 @@ Returned borders ignore special rows."
;; another regular row has to be found above that rule.
(let (rule-flag)
(catch 'exit
- (mapc (lambda (row)
- (cond ((eq (org-element-property :type row) 'rule)
- (setq rule-flag t))
- ((not (org-export-table-row-is-special-p row info))
- (if rule-flag (throw 'exit (push 'above borders))
- (throw 'exit nil)))))
- ;; Look at every row before the current one.
- (cdr (memq row (reverse (org-element-contents table)))))
+ ;; Look at every row before the current one.
+ (dolist (row (cdr (memq row (reverse (org-element-contents table)))))
+ (cond ((eq (org-element-property :type row) 'rule)
+ (setq rule-flag t))
+ ((not (org-export-table-row-is-special-p row info))
+ (if rule-flag (throw 'exit (push 'above borders))
+ (throw 'exit nil)))))
;; No rule above, or rule found starts the table (ignoring any
;; special row): TABLE-CELL is at the top of the table.
(when rule-flag (push 'above borders))
@@ -4768,14 +4903,13 @@ Returned borders ignore special rows."
;; non-regular row below is a rule.
(let (rule-flag)
(catch 'exit
- (mapc (lambda (row)
- (cond ((eq (org-element-property :type row) 'rule)
- (setq rule-flag t))
- ((not (org-export-table-row-is-special-p row info))
- (if rule-flag (throw 'exit (push 'below borders))
- (throw 'exit nil)))))
- ;; Look at every row after the current one.
- (cdr (memq row (org-element-contents table))))
+ ;; Look at every row after the current one.
+ (dolist (row (cdr (memq row (org-element-contents table))))
+ (cond ((eq (org-element-property :type row) 'rule)
+ (setq rule-flag t))
+ ((not (org-export-table-row-is-special-p row info))
+ (if rule-flag (throw 'exit (push 'below borders))
+ (throw 'exit nil)))))
;; No rule below, or rule found ends the table (modulo some
;; special row): TABLE-CELL is at the bottom of the table.
(when rule-flag (push 'below borders))
@@ -4787,37 +4921,35 @@ Returned borders ignore special rows."
(catch 'exit
(let ((column (let ((cells (org-element-contents row)))
(- (length cells) (length (memq table-cell cells))))))
- (mapc
- (lambda (row)
- (unless (eq (org-element-property :type row) 'rule)
- (when (equal (org-element-contents
- (car (org-element-contents row)))
- '("/"))
- (let ((column-groups
- (mapcar
- (lambda (cell)
- (let ((value (org-element-contents cell)))
- (when (member value '(("<") ("<>") (">") nil))
- (car value))))
- (org-element-contents row))))
- ;; There's a left border when previous cell, if
- ;; any, ends a group, or current one starts one.
- (when (or (and (not (zerop column))
- (member (elt column-groups (1- column))
- '(">" "<>")))
- (member (elt column-groups column) '("<" "<>")))
- (push 'left borders))
- ;; There's a right border when next cell, if any,
- ;; starts a group, or current one ends one.
- (when (or (and (/= (1+ column) (length column-groups))
- (member (elt column-groups (1+ column))
- '("<" "<>")))
- (member (elt column-groups column) '(">" "<>")))
- (push 'right borders))
- (throw 'exit nil)))))
- ;; Table rows are read in reverse order so last column groups
- ;; row has precedence over any previous one.
- (reverse (org-element-contents table)))))
+ ;; Table rows are read in reverse order so last column groups
+ ;; row has precedence over any previous one.
+ (dolist (row (reverse (org-element-contents table)))
+ (unless (eq (org-element-property :type row) 'rule)
+ (when (equal (org-element-contents
+ (car (org-element-contents row)))
+ '("/"))
+ (let ((column-groups
+ (mapcar
+ (lambda (cell)
+ (let ((value (org-element-contents cell)))
+ (when (member value '(("<") ("<>") (">") nil))
+ (car value))))
+ (org-element-contents row))))
+ ;; There's a left border when previous cell, if
+ ;; any, ends a group, or current one starts one.
+ (when (or (and (not (zerop column))
+ (member (elt column-groups (1- column))
+ '(">" "<>")))
+ (member (elt column-groups column) '("<" "<>")))
+ (push 'left borders))
+ ;; There's a right border when next cell, if any,
+ ;; starts a group, or current one ends one.
+ (when (or (and (/= (1+ column) (length column-groups))
+ (member (elt column-groups (1+ column))
+ '("<" "<>")))
+ (member (elt column-groups column) '(">" "<>")))
+ (push 'right borders))
+ (throw 'exit nil)))))))
;; Return value.
borders))
@@ -4892,7 +5024,7 @@ special columns and separators."
(lambda (row)
(cond ((eq row table-row) number)
((eq (org-element-property :type row) 'standard)
- (incf number) nil)))
+ (cl-incf number) nil)))
info 'first-match))))
(defun org-export-table-dimensions (table info)
@@ -4908,10 +5040,10 @@ rows (resp. columns)."
(org-element-map table 'table-row
(lambda (row)
(when (eq (org-element-property :type row) 'standard)
- (incf rows)
+ (cl-incf rows)
(unless first-row (setq first-row row)))) info)
;; Set number of columns.
- (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info)
+ (org-element-map first-row 'table-cell (lambda (_) (cl-incf columns)) info)
;; Return value.
(cons rows columns)))
@@ -4931,7 +5063,7 @@ function returns nil for other cells."
(let ((col-count 0))
(org-element-map table-row 'table-cell
(lambda (cell)
- (if (eq cell table-cell) col-count (incf col-count) nil))
+ (if (eq cell table-cell) col-count (cl-incf col-count) nil))
info 'first-match))))))
(defun org-export-get-table-cell-at (address table info)
@@ -4951,12 +5083,12 @@ return nil."
(lambda (row)
(cond ((eq (org-element-property :type row) 'rule) nil)
((= row-count row-pos) row)
- (t (incf row-count) nil)))
+ (t (cl-incf row-count) nil)))
info 'first-match))
'table-cell
(lambda (cell)
(if (= column-count column-pos) cell
- (incf column-count) nil))
+ (cl-incf column-count) nil))
info 'first-match)))
@@ -5064,10 +5196,6 @@ Return a list of src-block elements with a caption."
;;
;; Dictionary for smart quotes is stored in
;; `org-export-smart-quotes-alist'.
-;;
-;; Internally, regexps matching potential smart quotes (checks at
-;; string boundaries are also necessary) are defined in
-;; `org-export-smart-quotes-regexps'.
(defconst org-export-smart-quotes-alist
'(("da"
@@ -5122,6 +5250,16 @@ Return a list of src-block elements with a caption."
(secondary-closing :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
:texinfo "@tie{}@guillemetright{}")
(apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("is"
+ (primary-opening
+ :utf-8 "„" :html "&bdquo;" :latex "\"`" :texinfo "@quotedblbase{}")
+ (primary-closing
+ :utf-8 "“" :html "&ldquo;" :latex "\"'" :texinfo "@quotedblleft{}")
+ (secondary-opening
+ :utf-8 "‚" :html "&sbquo;" :latex "\\glq{}" :texinfo "@quotesinglbase{}")
+ (secondary-closing
+ :utf-8 "‘" :html "&lsquo;" :latex "\\grq{}" :texinfo "@quoteleft{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
("no"
;; https://nn.wikipedia.org/wiki/Sitatteikn
(primary-opening
@@ -5200,7 +5338,11 @@ INFO is the current export state, as a plist."
(value (gethash parent cache 'missing-data)))
(if (not (eq value 'missing-data)) (cdr (assq s value))
(let (level1-open full-status)
- (org-element-map parent 'plain-text
+ (org-element-map
+ (let ((secondary (org-element-secondary-p s)))
+ (if secondary (org-element-property secondary parent)
+ (org-element-contents parent)))
+ 'plain-text
(lambda (text)
(let ((start 0) current-status)
(while (setq start (string-match "['\"]" text start))
@@ -5223,7 +5365,7 @@ INFO is the current export state, as a plist."
(let ((p (org-export-get-previous-element
text info)))
(cond ((not p) nil)
- ((stringp p) (substring p (1- (length p))))
+ ((stringp p) (substring p -1))
((memq (org-element-property :post-blank p)
'(0 nil))
'no-blank)
@@ -5257,7 +5399,7 @@ INFO is the current export state, as a plist."
(allow-close 'secondary-closing)
(t 'apostrophe)))))
current-status)
- (setq start (1+ start)))
+ (cl-incf start))
(when current-status
(push (cons text (nreverse current-status)) full-status))))
info nil org-element-recursive-objects)
@@ -5303,9 +5445,6 @@ Return the new string."
;; defsubst org-export-get-parent must be defined before first use
-(define-obsolete-function-alias
- 'org-export-get-genealogy 'org-element-lineage "25.1")
-
(defun org-export-get-parent-headline (blob)
"Return BLOB parent headline or nil.
BLOB is the element or object being considered."
@@ -5344,7 +5483,7 @@ all of them."
((null n) (throw 'exit obj))
((not (wholenump n)) (push obj prev))
((zerop n) (throw 'exit prev))
- (t (decf n) (push obj prev)))))))
+ (t (cl-decf n) (push obj prev)))))))
(defun org-export-get-next-element (blob info &optional n)
"Return next element or object.
@@ -5370,7 +5509,7 @@ them."
((null n) (throw 'exit obj))
((not (wholenump n)) (push obj next))
((zerop n) (throw 'exit (nreverse next)))
- (t (decf n) (push obj next)))))))
+ (t (cl-decf n) (push obj next)))))))
;;;; Translation
@@ -5457,6 +5596,7 @@ them."
("es" :ascii "Ecuacion" :html "Ecuaci&oacute;n" :default "Ecuación")
("et" :html "V&#245;rrand" :utf-8 "Võrrand")
("fr" :ascii "Equation" :default "Équation")
+ ("is" :default "Jafna")
("ja" :default "方程式")
("no" :default "Ligning")
("nb" :default "Ligning")
@@ -5471,6 +5611,7 @@ them."
("de" :default "Abbildung")
("es" :default "Figura")
("et" :default "Joonis")
+ ("is" :default "Mynd")
("ja" :default "図" :html "&#22259;")
("no" :default "Illustrasjon")
("nb" :default "Illustrasjon")
@@ -5485,6 +5626,7 @@ them."
("es" :default "Figura %d:")
("et" :default "Joonis %d:")
("fr" :default "Figure %d :" :html "Figure&nbsp;%d&nbsp;:")
+ ("is" :default "Mynd %d")
("ja" :default "図%d: " :html "&#22259;%d: ")
("no" :default "Illustrasjon %d")
("nb" :default "Illustrasjon %d")
@@ -5537,6 +5679,7 @@ them."
("es" :ascii "Indice de tablas" :html "&Iacute;ndice de tablas" :default "Índice de tablas")
("et" :default "Tabelite nimekiri")
("fr" :default "Liste des tableaux")
+ ("is" :default "Töfluskrá" :html "T&ouml;fluskr&aacute;")
("ja" :default "表目次")
("no" :default "Tabeller")
("nb" :default "Tabeller")
@@ -5593,6 +5736,7 @@ them."
("es" :default "Tabla")
("et" :default "Tabel")
("fr" :default "Tableau")
+ ("is" :default "Tafla")
("ja" :default "表" :html "&#34920;")
("pt_BR" :default "Tabela")
("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072;"
@@ -5604,6 +5748,7 @@ them."
("es" :default "Tabla %d")
("et" :default "Tabel %d")
("fr" :default "Tableau %d :")
+ ("is" :default "Tafla %d")
("ja" :default "表%d:" :html "&#34920;%d:")
("no" :default "Tabell %d")
("nb" :default "Tabell %d")
@@ -5938,24 +6083,17 @@ Return file name as a string."
(let* ((visited-file (buffer-file-name (buffer-base-buffer)))
(base-name
;; File name may come from EXPORT_FILE_NAME subtree
- ;; property, assuming point is at beginning of said
- ;; sub-tree.
+ ;; property.
(file-name-sans-extension
- (or (and subtreep
- (org-entry-get
- (save-excursion
- (ignore-errors (org-back-to-heading) (point)))
- "EXPORT_FILE_NAME" 'selective))
+ (or (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective))
;; File name may be extracted from buffer's associated
;; file, if any.
(and visited-file (file-name-nondirectory visited-file))
;; Can't determine file name on our own: Ask user.
- (let ((read-file-name-function
- (and org-completion-use-ido 'ido-read-file-name)))
- (read-file-name
- "Output file: " pub-dir nil nil nil
- (lambda (name)
- (string= (file-name-extension name t) extension)))))))
+ (read-file-name
+ "Output file: " pub-dir nil nil nil
+ (lambda (name)
+ (string= (file-name-extension name t) extension))))))
(output-file
;; Build file name. Enforce EXTENSION over whatever user
;; may have come up with. PUB-DIR, if defined, always has
@@ -5969,7 +6107,7 @@ Return file name as a string."
(t (concat (file-name-as-directory ".") base-name extension)))))
;; If writing to OUTPUT-FILE would overwrite original file, append
;; EXTENSION another time to final name.
- (if (and visited-file (org-file-equal-p visited-file output-file))
+ (if (and visited-file (file-equal-p visited-file output-file))
(concat output-file extension)
output-file)))
@@ -5990,68 +6128,21 @@ removed beforehand. Return the new stack."
"Menu for asynchronous export results and running processes."
(interactive)
(let ((buffer (get-buffer-create "*Org Export Stack*")))
- (set-buffer buffer)
- (when (zerop (buffer-size)) (org-export-stack-mode))
- (org-export-stack-refresh)
+ (with-current-buffer buffer
+ (org-export-stack-mode)
+ (tabulated-list-print t))
(pop-to-buffer buffer))
(message "Type \"q\" to quit, \"?\" for help"))
-(defun org-export--stack-source-at-point ()
- "Return source from export results at point in stack."
- (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents))))
- (if (not source) (error "Source unavailable, please refresh buffer")
- (let ((source-name (if (stringp source) source (buffer-name source))))
- (if (save-excursion
- (beginning-of-line)
- (looking-at (concat ".* +" (regexp-quote source-name) "$")))
- source
- ;; SOURCE is not consistent with current line. The stack
- ;; view is outdated.
- (error "Source unavailable; type `g' to update buffer"))))))
-
(defun org-export-stack-clear ()
"Remove all entries from export stack."
(interactive)
(setq org-export-stack-contents nil))
-(defun org-export-stack-refresh (&rest dummy)
- "Refresh the asynchronous export stack.
-DUMMY is ignored. Unavailable sources are removed from the list.
-Return the new stack."
- (let ((inhibit-read-only t))
- (org-preserve-lc
- (erase-buffer)
- (insert (concat
- (let ((counter 0))
- (mapconcat
- (lambda (entry)
- (let ((proc-p (processp (nth 2 entry))))
- (concat
- ;; Back-end.
- (format " %-12s " (or (nth 1 entry) ""))
- ;; Age.
- (let ((data (nth 2 entry)))
- (if proc-p (format " %6s " (process-status data))
- ;; Compute age of the results.
- (org-format-seconds
- "%4h:%.2m "
- (float-time (time-since data)))))
- ;; Source.
- (format " %s"
- (let ((source (car entry)))
- (if (stringp source) source
- (buffer-name source)))))))
- ;; Clear stack from exited processes, dead buffers or
- ;; non-existent files.
- (setq org-export-stack-contents
- (org-remove-if-not
- (lambda (el)
- (if (processp (nth 2 el))
- (buffer-live-p (process-buffer (nth 2 el)))
- (let ((source (car el)))
- (if (bufferp source) (buffer-live-p source)
- (file-exists-p source)))))
- org-export-stack-contents)) "\n")))))))
+(defun org-export-stack-refresh ()
+ "Refresh the export stack."
+ (interactive)
+ (tabulated-list-print t))
(defun org-export-stack-remove (&optional source)
"Remove export results at point from stack.
@@ -6059,7 +6150,7 @@ If optional argument SOURCE is non-nil, remove it instead."
(interactive)
(let ((source (or source (org-export--stack-source-at-point))))
(setq org-export-stack-contents
- (org-remove-if (lambda (el) (equal (car el) source))
+ (cl-remove-if (lambda (el) (equal (car el) source))
org-export-stack-contents))))
(defun org-export-stack-view (&optional in-emacs)
@@ -6075,11 +6166,10 @@ within Emacs."
(defvar org-export-stack-mode-map
(let ((km (make-sparse-keymap)))
+ (set-keymap-parent km tabulated-list-mode-map)
(define-key km " " 'next-line)
- (define-key km "n" 'next-line)
(define-key km "\C-n" 'next-line)
(define-key km [down] 'next-line)
- (define-key km "p" 'previous-line)
(define-key km "\C-p" 'previous-line)
(define-key km "\C-?" 'previous-line)
(define-key km [up] 'previous-line)
@@ -6090,31 +6180,85 @@ within Emacs."
km)
"Keymap for Org Export Stack.")
-(define-derived-mode org-export-stack-mode special-mode "Org-Stack"
+(define-derived-mode org-export-stack-mode tabulated-list-mode "Org-Stack"
"Mode for displaying asynchronous export stack.
-Type \\[org-export-stack] to visualize the asynchronous export
+Type `\\[org-export-stack]' to visualize the asynchronous export
stack.
-In an Org Export Stack buffer, use \\<org-export-stack-mode-map>\\[org-export-stack-view] to view export output
-on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear
+In an Org Export Stack buffer, use \
+\\<org-export-stack-mode-map>`\\[org-export-stack-view]' to view export output
+on current line, `\\[org-export-stack-remove]' to remove it from the stack and \
+`\\[org-export-stack-clear]' to clear
stack completely.
-Removing entries in an Org Export Stack buffer doesn't affect
-files or buffers, only the display.
+Removing entries in a stack buffer does not affect files
+or buffers, only display.
\\{org-export-stack-mode-map}"
- (abbrev-mode 0)
- (auto-fill-mode 0)
- (setq buffer-read-only t
- buffer-undo-list t
- truncate-lines t
- header-line-format
- '(:eval
- (format " %-12s | %6s | %s" "Back-End" "Age" "Source")))
- (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t)
- (set (make-local-variable 'revert-buffer-function)
- 'org-export-stack-refresh))
+ (setq tabulated-list-format
+ (vector (list "#" 4 #'org-export--stack-num-predicate)
+ (list "Back-End" 12 t)
+ (list "Age" 6 nil)
+ (list "Source" 0 nil)))
+ (setq tabulated-list-sort-key (cons "#" nil))
+ (setq tabulated-list-entries #'org-export--stack-generate)
+ (add-hook 'tabulated-list-revert-hook #'org-export--stack-generate nil t)
+ (add-hook 'post-command-hook #'org-export-stack-refresh nil t)
+ (tabulated-list-init-header))
+
+(defun org-export--stack-generate ()
+ "Generate the asynchronous export stack for display.
+Unavailable sources are removed from the list. Return a list
+appropriate for `tabulated-list-print'."
+ ;; Clear stack from exited processes, dead buffers or non-existent
+ ;; files.
+ (setq org-export-stack-contents
+ (cl-remove-if-not
+ (lambda (el)
+ (if (processp (nth 2 el))
+ (buffer-live-p (process-buffer (nth 2 el)))
+ (let ((source (car el)))
+ (if (bufferp source) (buffer-live-p source)
+ (file-exists-p source)))))
+ org-export-stack-contents))
+ ;; Update `tabulated-list-entries'.
+ (let ((counter 0))
+ (mapcar
+ (lambda (entry)
+ (let ((source (car entry)))
+ (list source
+ (vector
+ ;; Counter.
+ (number-to-string (cl-incf counter))
+ ;; Back-End.
+ (if (nth 1 entry) (symbol-name (nth 1 entry)) "")
+ ;; Age.
+ (let ((info (nth 2 entry)))
+ (if (processp info) (symbol-name (process-status info))
+ (format-seconds "%h:%.2m" (float-time (time-since info)))))
+ ;; Source.
+ (if (stringp source) source (buffer-name source))))))
+ org-export-stack-contents)))
+
+(defun org-export--stack-num-predicate (a b)
+ (< (string-to-number (aref (nth 1 a) 0))
+ (string-to-number (aref (nth 1 b) 0))))
+
+(defun org-export--stack-source-at-point ()
+ "Return source from export results at point in stack."
+ (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents))))
+ (if (not source) (error "Source unavailable, please refresh buffer")
+ (let ((source-name (if (stringp source) source (buffer-name source))))
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at-p (concat ".* +" (regexp-quote source-name) "$")))
+ source
+ ;; SOURCE is not consistent with current line. The stack
+ ;; view is outdated.
+ (error (substitute-command-keys
+ "Source unavailable; type `\\[org-export-stack-refresh]' \
+to refresh buffer")))))))
@@ -6140,10 +6284,12 @@ SPC and DEL (resp. C-n and C-p) keys.
Set variable `org-export-dispatch-use-expert-ui' to switch to one
flavor or the other.
-When ARG is \\[universal-argument], repeat the last export action, with the same set
-of options used back then, on the current buffer.
+When ARG is `\\[universal-argument]', repeat the last export action, with the\
+ same
+set of options used back then, on the current buffer.
-When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack."
+When ARG is `\\[universal-argument] \\[universal-argument]', display the \
+asynchronous export stack."
(interactive "P")
(let* ((input
(cond ((equal arg '(16)) '(stack))
@@ -6168,7 +6314,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron
(optns (cdr input)))
(unless (memq 'subtree optns)
(move-marker org-export-dispatch-last-position nil))
- (case action
+ (cl-case action
;; First handle special hard-coded actions.
(template (org-export-insert-default-template nil optns))
(stack (org-export-stack))
@@ -6177,7 +6323,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron
(publish-current-project
(org-publish-current-project (memq 'force optns) (memq 'async optns)))
(publish-choose-project
- (org-publish (assoc (org-icompleting-read
+ (org-publish (assoc (completing-read
"Publish project: "
org-publish-project-alist nil t)
org-publish-project-alist)
@@ -6228,12 +6374,12 @@ back to standard interface."
;; on the first key, if any. A nil value means KEY will
;; only be activated at first level.
(if (or (eq access-key t) (eq access-key first-key))
- (org-propertize key 'face 'org-warning)
+ (propertize key 'face 'org-warning)
key)))
(fontify-value
(lambda (value)
;; Fontify VALUE string.
- (org-propertize value 'face 'font-lock-variable-name-face)))
+ (propertize value 'face 'font-lock-variable-name-face)))
;; Prepare menu entries by extracting them from registered
;; back-ends and sorting them by access key and by ordinal,
;; if any.
@@ -6307,7 +6453,7 @@ back to standard interface."
(concat
(mapconcat
(lambda (sub-entry)
- (incf index)
+ (cl-incf index)
(format
(if (zerop (mod index 2)) " [%s] %-26s"
"[%s] %s\n")
@@ -6378,7 +6524,7 @@ back to standard interface."
standard-prompt allowed-keys entries options first-key expertp))))
(defun org-export--dispatch-action
- (prompt allowed-keys entries options first-key expertp)
+ (prompt allowed-keys entries options first-key expertp)
"Read a character from command input and act accordingly.
PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is
@@ -6396,7 +6542,7 @@ options as CDR."
(while (and (setq key (read-char-exclusive prompt))
(not expertp)
(memq key '(14 16 ?\s ?\d)))
- (case key
+ (cl-case key
(14 (if (not (pos-visible-in-window-p (point-max)))
(ignore-errors (scroll-up 1))
(message "End of buffer")
@@ -6433,8 +6579,8 @@ options as CDR."
;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1).
((memq key '(2 22 19 6 1))
(org-export--dispatch-ui
- (let ((option (case key (2 'body) (22 'visible) (19 'subtree)
- (6 'force) (1 'async))))
+ (let ((option (cl-case key (2 'body) (22 'visible) (19 'subtree)
+ (6 'force) (1 'async))))
(if (memq option options) (remq option options)
(cons option options)))
first-key expertp))
@@ -6446,7 +6592,7 @@ options as CDR."
;; Publishing actions are hard-coded. Send a special
;; signal to `org-export-dispatch'.
((eq first-key ?P)
- (case key
+ (cl-case key
(?f 'publish-current-file)
(?p 'publish-current-project)
(?x 'publish-choose-project)
@@ -6455,10 +6601,9 @@ options as CDR."
;; path. Indeed, derived backends can share the same
;; FIRST-KEY.
(t (catch 'found
- (mapc (lambda (entry)
- (let ((match (assq key (nth 2 entry))))
- (when match (throw 'found (nth 2 match)))))
- (member (assq first-key entries) entries)))))
+ (dolist (entry (member (assq first-key entries) entries))
+ (let ((match (assq key (nth 2 entry))))
+ (when match (throw 'found (nth 2 match))))))))
options))
;; Otherwise, enter sub-menu.
(t (org-export--dispatch-ui options key expertp)))))