summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile1
-rw-r--r--contrib/README11
-rw-r--r--contrib/lisp/ob-eukleides.el2
-rw-r--r--contrib/lisp/ob-mathematica.el79
-rw-r--r--contrib/lisp/ob-oz.el2
-rw-r--r--contrib/lisp/ob-stata.el313
-rw-r--r--contrib/lisp/ob-tcl.el4
-rw-r--r--contrib/lisp/org-annotate-file.el114
-rw-r--r--contrib/lisp/org-bibtex-extras.el24
-rw-r--r--contrib/lisp/org-collector.el8
-rw-r--r--contrib/lisp/org-colview-xemacs.el101
-rw-r--r--contrib/lisp/org-contacts.el153
-rw-r--r--contrib/lisp/org-download.el392
-rw-r--r--contrib/lisp/org-drill.el942
-rw-r--r--contrib/lisp/org-ebib.el47
-rw-r--r--contrib/lisp/org-effectiveness.el298
-rw-r--r--contrib/lisp/org-eldoc.el165
-rw-r--r--contrib/lisp/org-eww.el171
-rw-r--r--contrib/lisp/org-expiry.el5
-rwxr-xr-xcontrib/lisp/org-favtable.el1701
-rw-r--r--contrib/lisp/org-git-link.el27
-rw-r--r--contrib/lisp/org-index.el2497
-rw-r--r--contrib/lisp/org-jira.el64
-rw-r--r--contrib/lisp/org-license.el540
-rw-r--r--contrib/lisp/org-mac-link.el613
-rw-r--r--contrib/lisp/org-mew.el4
-rw-r--r--contrib/lisp/org-mime.el123
-rw-r--r--contrib/lisp/org-mtags.el255
-rw-r--r--contrib/lisp/org-notmuch.el36
-rw-r--r--contrib/lisp/org-passwords.el384
-rw-r--r--contrib/lisp/org-toc.el4
-rw-r--r--contrib/lisp/org-velocity.el309
-rw-r--r--contrib/lisp/org-wikinodes.el18
-rw-r--r--contrib/lisp/ox-bibtex.el357
-rw-r--r--contrib/lisp/ox-confluence.el30
-rw-r--r--contrib/lisp/ox-deck.el21
-rw-r--r--contrib/lisp/ox-extra.el190
-rw-r--r--contrib/lisp/ox-freemind.el2
-rw-r--r--contrib/lisp/ox-gfm.el193
-rw-r--r--contrib/lisp/ox-groff.el66
-rw-r--r--contrib/lisp/ox-koma-letter.el671
-rw-r--r--contrib/lisp/ox-rss.el75
-rw-r--r--contrib/lisp/ox-s5.el10
-rw-r--r--contrib/lisp/ox-taskjuggler.el61
-rw-r--r--contrib/scripts/ditaa.jarbin186095 -> 0 bytes
-rw-r--r--etc/ORG-NEWS633
-rw-r--r--etc/styles/OrgOdtStyles.xml20
-rw-r--r--lisp/ob-C.el396
-rw-r--r--lisp/ob-J.el179
-rw-r--r--lisp/ob-R.el200
-rw-r--r--lisp/ob-abc.el94
-rw-r--r--lisp/ob-asymptote.el5
-rw-r--r--lisp/ob-awk.el23
-rw-r--r--lisp/ob-clojure.el82
-rw-r--r--lisp/ob-comint.el83
-rw-r--r--lisp/ob-coq.el77
-rw-r--r--lisp/ob-core.el972
-rw-r--r--lisp/ob-ditaa.el18
-rw-r--r--lisp/ob-dot.el4
-rw-r--r--lisp/ob-ebnf.el85
-rw-r--r--lisp/ob-emacs-lisp.el5
-rw-r--r--lisp/ob-eval.el7
-rw-r--r--lisp/ob-exp.el349
-rw-r--r--lisp/ob-forth.el86
-rw-r--r--lisp/ob-fortran.el6
-rw-r--r--lisp/ob-gnuplot.el21
-rw-r--r--lisp/ob-groovy.el118
-rw-r--r--lisp/ob-haskell.el8
-rw-r--r--lisp/ob-io.el10
-rw-r--r--lisp/ob-java.el22
-rw-r--r--lisp/ob-js.el9
-rw-r--r--lisp/ob-keys.el1
-rw-r--r--lisp/ob-latex.el96
-rw-r--r--lisp/ob-lilypond.el149
-rw-r--r--lisp/ob-lisp.el34
-rw-r--r--lisp/ob-lob.el35
-rw-r--r--lisp/ob-maxima.el9
-rw-r--r--lisp/ob-ocaml.el65
-rw-r--r--lisp/ob-octave.el12
-rw-r--r--lisp/ob-processing.el197
-rw-r--r--lisp/ob-python.el8
-rw-r--r--lisp/ob-ref.el212
-rw-r--r--lisp/ob-ruby.el43
-rw-r--r--lisp/ob-scala.el10
-rw-r--r--lisp/ob-scheme.el23
-rw-r--r--lisp/ob-sed.el107
-rw-r--r--lisp/ob-shell.el (renamed from lisp/ob-sh.el)130
-rw-r--r--lisp/ob-sql.el24
-rw-r--r--lisp/ob-table.el32
-rw-r--r--lisp/ob-tangle.el146
-rw-r--r--lisp/org-agenda.el936
-rw-r--r--lisp/org-archive.el90
-rw-r--r--lisp/org-attach.el31
-rw-r--r--lisp/org-bbdb.el2
-rw-r--r--lisp/org-bibtex.el41
-rw-r--r--lisp/org-capture.el88
-rw-r--r--lisp/org-clock.el740
-rw-r--r--lisp/org-colview.el531
-rw-r--r--lisp/org-compat.el34
-rw-r--r--lisp/org-ctags.el8
-rw-r--r--lisp/org-docview.el21
-rw-r--r--lisp/org-element.el4857
-rw-r--r--lisp/org-entities.el932
-rw-r--r--lisp/org-faces.el109
-rw-r--r--lisp/org-feed.el12
-rw-r--r--lisp/org-footnote.el675
-rw-r--r--lisp/org-gnus.el16
-rw-r--r--lisp/org-habit.el66
-rw-r--r--lisp/org-info.el32
-rw-r--r--lisp/org-inlinetask.el24
-rw-r--r--lisp/org-list.el573
-rw-r--r--lisp/org-loaddefs.el546
-rw-r--r--lisp/org-macro.el149
-rw-r--r--lisp/org-macs.el75
-rw-r--r--lisp/org-mobile.el11
-rw-r--r--lisp/org-mouse.el13
-rw-r--r--lisp/org-pcomplete.el23
-rw-r--r--lisp/org-plot.el148
-rw-r--r--lisp/org-protocol.el2
-rw-r--r--lisp/org-rmail.el2
-rw-r--r--lisp/org-src.el1407
-rw-r--r--lisp/org-table.el3804
-rw-r--r--lisp/org-timer.el266
-rw-r--r--lisp/org-version.el4
-rwxr-xr-x[-rw-r--r--]lisp/org.el9823
-rw-r--r--lisp/ox-ascii.el754
-rw-r--r--lisp/ox-beamer.el207
-rw-r--r--lisp/ox-html.el1380
-rw-r--r--lisp/ox-icalendar.el349
-rw-r--r--lisp/ox-latex.el1924
-rw-r--r--lisp/ox-man.el120
-rw-r--r--lisp/ox-md.el155
-rw-r--r--lisp/ox-odt.el682
-rw-r--r--lisp/ox-org.el94
-rw-r--r--lisp/ox-publish.el243
-rw-r--r--lisp/ox-texinfo.el463
-rw-r--r--lisp/ox.el2756
-rw-r--r--mk/default.mk51
-rw-r--r--mk/targets.mk11
-rw-r--r--mk/version.mk4
140 files changed, 31251 insertions, 19961 deletions
diff --git a/Makefile b/Makefile
index 7048497..f6312f2 100644
--- a/Makefile
+++ b/Makefile
@@ -29,6 +29,7 @@ help helpall::
$(info make single - build Org ELisp files, single Emacs per source)
$(info make autoloads - create org-loaddefs.el to load Org in-place)
$(info make test - build Org ELisp files and run test suite)
+ $(info make vanilla - run Emacs with this Org-mode and no personal config)
helpall::
$(info make test-dirty - check without building first)
$(info make compile-dirty - build only stale Org ELisp files)
diff --git a/contrib/README b/contrib/README
index bdbdb47..6a8918f 100644
--- a/contrib/README
+++ b/contrib/README
@@ -24,21 +24,23 @@ org-contacts.el --- Contacts management
org-contribdir.el --- Dummy file to mark the org contrib Lisp directory
org-depend.el --- TODO dependencies for Org-mode
org-drill.el --- Self-testing with org-learn
+org-effectiveness.el --- Measuring your personal effectiveness
org-element.el --- Parser and applications for Org syntax
+org-eldoc.el --- Eldoc documentation for SRC blocks
org-elisp-symbol.el --- Org links to emacs-lisp symbols
org-eval-light.el --- Evaluate in-buffer code on demand
org-eval.el --- The <lisp> tag, adapted from Muse
+org-eww.el --- Support link/copy/paste from eww to Org-mode
org-expiry.el --- Expiry mechanism for Org entries
org-export-generic.el --- Export framework for configurable backends
-org-favtable.el --- Lookup table of favorite references and links
org-git-link.el --- Provide org links to specific file version
+org-index.el --- A personal index for org and beyond
org-interactive-query.el --- Interactive modification of tags query
org-invoice.el --- Help manage client invoices in OrgMode
-org-jira.el --- Add a jira:ticket protocol to Org
org-learn.el --- SuperMemo's incremental learning algorithm
+org-license.el --- Insert free licenses to your org documents
org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
-org-mac-link-grabber.el --- Grab links and URLs from various Mac applications
-org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
+org-mac-link.el --- Grab links and URLs from various Mac applications
org-mairix.el --- Hook mairix search into Org for different MUAs
org-man.el --- Support for links to manpages in Org-mode
org-mew.el --- Support for links to Mew messages
@@ -79,6 +81,7 @@ ob-fomus.el --- Org-babel functions for fomus evaluation
ob-julia.el --- Org-babel functions for julia evaluation
ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
ob-oz.el --- Org-babel functions for Oz evaluation
+ob-stata.el --- Org-babel functions for Stata evaluation
ob-tcl.el --- Org-babel functions for tcl evaluation
External libraries
diff --git a/contrib/lisp/ob-eukleides.el b/contrib/lisp/ob-eukleides.el
index c8ce881..cb5bb84 100644
--- a/contrib/lisp/ob-eukleides.el
+++ b/contrib/lisp/ob-eukleides.el
@@ -81,7 +81,7 @@ This function is called by `org-babel-execute-src-block'."
(shell-command (format org-eukleides-eps-to-raster
(concat (file-name-sans-extension out-file) ".eps")
(concat (file-name-sans-extension out-file) ".png")))
- (error "Conversion to PNG not supported. use a file with an EPS name")))
+ (error "Conversion to PNG not supported. Use a file with an EPS name")))
(with-temp-file in-file (insert body))
(message "%s" cmd) (org-babel-eval cmd "")
diff --git a/contrib/lisp/ob-mathematica.el b/contrib/lisp/ob-mathematica.el
new file mode 100644
index 0000000..a796741
--- /dev/null
+++ b/contrib/lisp/ob-mathematica.el
@@ -0,0 +1,79 @@
+;;; ob-mathematica.el --- org-babel functions for Mathematica evaluation
+
+;; Copyright (C) 2014 Yi Wang
+
+;; Authors: Yi Wang
+;; Keywords: literate programming, reproducible research
+;; Homepage: https://github.com/tririver/wy-els/blob/master/ob-mathematica.el
+;; Distributed under the GNU GPL v2 or later
+
+;; Org-Babel support for evaluating Mathematica source code.
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+;; Optionally require mma.el for font lock, etc
+(require 'mma nil 'noerror)
+(add-to-list 'org-src-lang-modes '("mathematica" . "mma"))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("mathematica" . "m"))
+
+(defvar org-babel-default-header-args:mathematica '())
+
+(defvar org-babel-mathematica-command "MathematicaScript -script"
+ "Name of the command for executing Mathematica code.")
+
+(defvar org-babel-mathematica-command-alt "math -noprompt"
+ "Name of the command for executing Mathematica code.")
+
+(defun org-babel-expand-body:mathematica (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (concat
+ (mapconcat ;; define any variables
+ (lambda (pair)
+ (format "%s=%s;"
+ (car pair)
+ (org-babel-mathematica-var-to-mathematica (cdr pair))))
+ vars "\n") "\nPrint[\n" body "\n]\n")))
+
+(defun org-babel-execute:mathematica (body params)
+ "Execute a block of Mathematica code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (full-body (org-babel-expand-body:mathematica body params))
+ (tmp-script-file (org-babel-temp-file "mathematica-"))
+ (cmd org-babel-mathematica-command))
+ ;; actually execute the source-code block
+ (with-temp-file tmp-script-file (insert full-body))
+ ;; (with-temp-file "/tmp/dbg" (insert full-body))
+ ((lambda (raw)
+ (if (or (member "code" result-params)
+ (member "pp" result-params)
+ (and (member "output" result-params)
+ (not (member "table" result-params))))
+ raw
+ (org-babel-script-escape (org-babel-trim raw))))
+ (org-babel-eval (concat cmd " " tmp-script-file) ""))))
+
+(defun org-babel-prep-session:mathematica (session params)
+ "This function does nothing so far"
+ (error "Currently no support for sessions"))
+
+(defun org-babel-prep-session:mathematica (session body params)
+ "This function does nothing so far"
+ (error "Currently no support for sessions"))
+
+(defun org-babel-mathematica-var-to-mathematica (var)
+ "Convert an elisp value to a Mathematica variable.
+Convert an elisp value, VAR, into a string of Mathematica source code
+specifying a variable of the same value."
+ (if (listp var)
+ (concat "{" (mapconcat #'org-babel-mathematica-var-to-mathematica var ", ") "}")
+ (format "%S" var)))
+
+(provide 'ob-mathematica)
+
diff --git a/contrib/lisp/ob-oz.el b/contrib/lisp/ob-oz.el
index 3531d95..fc778f5 100644
--- a/contrib/lisp/ob-oz.el
+++ b/contrib/lisp/ob-oz.el
@@ -226,7 +226,7 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
((member "value" result-params)
(message "Org-babel: executing Oz expression")
(oz-send-string-expression full-body (or wait-time 1)))
- (t (error "either 'output' or 'results' must be members of :results.")))
+ (t (error "either 'output' or 'results' must be members of :results")))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :roname-names params))
diff --git a/contrib/lisp/ob-stata.el b/contrib/lisp/ob-stata.el
new file mode 100644
index 0000000..29aa88d
--- /dev/null
+++ b/contrib/lisp/ob-stata.el
@@ -0,0 +1,313 @@
+;;; ob-stata.el --- org-babel functions for stata code evaluation
+
+;; Copyright (C) 2014 Ista Zahn
+;; Author: Ista Zahn istazahn@gmail.com
+;; G. Jay Kerns
+;; Eric Schulte
+;; Dan Davison
+
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; The file provides Org-Babel support for evaluating stata code.
+;; It is basically result of find-and-replace "stata" for "julia"
+;; in ob-julia.el by G. Jay Kerns. Only ":results output" works: the
+;; header args must include ":results output" (this is the default).
+;; Note that I'm not sure ':results value' makes sense or is useful
+;; but I have left all the value-processing stuff inherited from
+;; ob-julia and ob-R. ':results graphics' would be nice, but I have
+;; not tried to implement it.
+;; --Ista, 07/30/2014
+
+;;; Requirements:
+;; Stata: http://stata.com
+;; ESS: http://ess.r-project.org
+
+;;; Code:
+(require 'ob)
+(eval-when-compile (require 'cl))
+
+(declare-function orgtbl-to-csv "org-table" (table params))
+(declare-function stata "ext:ess-stata" (&optional start-args))
+(declare-function inferior-ess-send-input "ext:ess-inf" ())
+(declare-function ess-make-buffer-current "ext:ess-inf" ())
+(declare-function ess-eval-buffer "ext:ess-inf" (vis))
+(declare-function org-number-sequence "org-compat" (from &optional to inc))
+(declare-function org-remove-if-not "org" (predicate seq))
+
+(defconst org-babel-header-args:stata
+ '((width . :any)
+ (horizontal . :any)
+ (results . ((file list vector table scalar verbatim)
+ (raw org html latex code pp wrap)
+ (replace silent append prepend)
+ ;; NOTE: not sure 'value' makes sense in stata
+ ;; we may want to remove it from the list
+ (output value graphics))))
+ "stata-specific header arguments.")
+
+(add-to-list 'org-babel-tangle-lang-exts '("stata" . "do"))
+
+;; only ':results output' currently works, so make that the default
+(defvar org-babel-default-header-args:stata '((:results . "output")))
+
+(defcustom org-babel-stata-command inferior-STA-program-name
+ "Name of command to use for executing stata code."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type 'string)
+
+(defvar ess-local-process-name) ; dynamically scoped
+(defun org-babel-edit-prep:stata (info)
+ (let ((session (cdr (assoc :session (nth 2 info)))))
+ (when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
+ (save-match-data (org-babel-stata-initiate-session session nil)))))
+
+(defun org-babel-expand-body:stata (body params &optional graphics-file)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((graphics-file
+ (or graphics-file (org-babel-stata-graphical-output-file params))))
+ (mapconcat
+ #'identity
+ ((lambda (inside)
+ (if graphics-file
+ inside
+ inside))
+ (append (org-babel-variable-assignments:stata params)
+ (list body))) "\n")))
+
+(defun org-babel-execute:stata (body params)
+ "Execute a block of stata code.
+This function is called by `org-babel-execute-src-block'."
+ (save-excursion
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (result-type (cdr (assoc :result-type params)))
+ (session (org-babel-stata-initiate-session
+ (cdr (assoc :session params)) params))
+ (colnames-p (cdr (assoc :colnames params)))
+ (rownames-p (cdr (assoc :rownames params)))
+ (graphics-file (org-babel-stata-graphical-output-file params))
+ (full-body (org-babel-expand-body:stata body params graphics-file))
+ (result
+ (org-babel-stata-evaluate
+ session full-body result-type result-params
+ (or (equal "yes" colnames-p)
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) colnames-p))
+ (or (equal "yes" rownames-p)
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) rownames-p)))))
+ (if graphics-file nil result))))
+
+(defun org-babel-prep-session:stata (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (org-babel-stata-initiate-session session params))
+ (var-lines (org-babel-variable-assignments:stata params)))
+ (org-babel-comint-in-buffer session
+ (mapc (lambda (var)
+ (end-of-line 1) (insert var) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)) var-lines))
+ session))
+
+(defun org-babel-load-session:stata (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:stata 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:stata (params)
+ "Return list of stata statements assigning the block's variables."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (mapcar
+ (lambda (pair)
+ (org-babel-stata-assign-elisp
+ (car pair) (cdr pair)
+ (equal "yes" (cdr (assoc :colnames params)))
+ (equal "yes" (cdr (assoc :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)))))))
+
+(defun org-babel-stata-quote-csv-field (s)
+ "Quote field S for export to stata."
+ (if (stringp s)
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
+ (format "%S" s)))
+
+(defun org-babel-stata-assign-elisp (name value colnames-p rownames-p)
+ "Construct stata code assigning the elisp VALUE to a variable named NAME."
+ (if (listp value)
+ (let ((max (apply #'max (mapcar #'length (org-remove-if-not
+ #'sequencep value))))
+ (min (apply #'min (mapcar #'length (org-remove-if-not
+ #'sequencep value))))
+ (transition-file (org-babel-temp-file "stata-import-")))
+ ;; ensure VALUE has an orgtbl structure (depth of at least 2)
+ (unless (listp (car value)) (setq value (list value)))
+ (with-temp-file transition-file
+ (insert
+ (orgtbl-to-csv value '(:fmt org-babel-stata-quote-csv-field))
+ "\n"))
+ (let ((file (org-babel-process-file-name transition-file 'noquote))
+ (header (if (or (eq (nth 1 value) 'hline) colnames-p)
+ "TRUE" "FALSE"))
+ (row-names (if rownames-p "1" "NULL")))
+ (if (= max min)
+ (format "%s = insheet using \"%s\"" name file)
+ (format "%s = insheet using \"%s\""
+ name file))))
+ (format "%s = %s" name (org-babel-stata-quote-csv-field value))))
+
+(defvar ess-ask-for-ess-directory) ; dynamically scoped
+
+(defun org-babel-stata-initiate-session (session params)
+ "If there is not a current stata process then create one."
+ (unless (string= session "none")
+ (let ((session (or session "*stata*"))
+ (ess-ask-for-ess-directory
+ (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
+ (not (cdr (assoc :dir params))))))
+ (if (org-babel-comint-buffer-livep session)
+ session
+ (save-window-excursion
+ (require 'ess) (stata)
+ (rename-buffer
+ (if (bufferp session)
+ (buffer-name session)
+ (if (stringp session)
+ session
+ (buffer-name))))
+ (current-buffer))))))
+
+(defun org-babel-stata-associate-session (session)
+ "Associate stata code buffer with a stata session.
+Make SESSION be the inferior ESS process associated with the
+current code buffer."
+ (setq ess-local-process-name
+ (process-name (get-buffer-process session)))
+ (ess-make-buffer-current))
+
+(defun org-babel-stata-graphical-output-file (params)
+ "Name of file to which stata should send graphical output."
+ (and (member "graphics" (cdr (assq :result-params params)))
+ (cdr (assq :file params))))
+
+(defvar org-babel-stata-eoe-indicator "display \"org_babel_stata_eoe\"")
+(defvar org-babel-stata-eoe-output "org_babel_stata_eoe")
+
+(defvar org-babel-stata-write-object-command "outsheet using \"%s\"")
+
+(defun org-babel-stata-evaluate
+ (session body result-type result-params column-names-p row-names-p)
+ "Evaluate stata code in BODY."
+ (if session
+ (org-babel-stata-evaluate-session
+ session body result-type result-params column-names-p row-names-p)
+ (org-babel-stata-evaluate-external-process
+ body result-type result-params column-names-p row-names-p)))
+
+(defun org-babel-stata-evaluate-external-process
+ (body result-type result-params column-names-p row-names-p)
+ "Evaluate BODY in external stata 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
+ (value
+ (let ((tmp-file (org-babel-temp-file "stata-")))
+ (org-babel-eval org-babel-stata-command
+ (format org-babel-stata-write-object-command
+ (org-babel-process-file-name tmp-file 'noquote)
+ (format "begin\n%s\nend" body)))
+ (org-babel-stata-process-value-result
+ (org-babel-result-cond result-params
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
+ (org-babel-import-elisp-from-file tmp-file '(4)))
+ column-names-p)))
+ (output (org-babel-eval org-babel-stata-command body))))
+
+(defun org-babel-stata-evaluate-session
+ (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
+ (value
+ (with-temp-buffer
+ (insert (org-babel-chomp body))
+ (let ((ess-local-process-name
+ (process-name (get-buffer-process session)))
+ (ess-eval-visibly-p nil))
+ (ess-eval-buffer nil)))
+ (let ((tmp-file (org-babel-temp-file "stata-")))
+ (org-babel-comint-eval-invisibly-and-wait-for-file
+ session tmp-file
+ (format org-babel-stata-write-object-command
+ (org-babel-process-file-name tmp-file 'noquote) "ans"))
+ (org-babel-stata-process-value-result
+ (org-babel-result-cond result-params
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
+ (org-babel-import-elisp-from-file tmp-file '(4)))
+ column-names-p)))
+ (output
+ (mapconcat
+ #'org-babel-chomp
+ (butlast
+ (delq nil
+ (mapcar
+ (lambda (line) (when (> (length line) 0) line))
+ (mapcar
+ (lambda (line) ;; cleanup extra prompts left in output
+ (if (string-match
+ "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
+ (substring line (match-end 1))
+ line))
+ (org-babel-comint-with-output (session org-babel-stata-eoe-output)
+ (insert (mapconcat #'org-babel-chomp
+ (list body org-babel-stata-eoe-indicator)
+ "\n"))
+ (inferior-ess-send-input)))))) "\n"))))
+
+(defun org-babel-stata-process-value-result (result column-names-p)
+ "stata-specific processing of return value.
+Insert hline if column names in output have been requested."
+ (if column-names-p
+ (cons (car result) (cons 'hline (cdr result)))
+ result))
+
+(provide 'ob-stata)
+
+;;; ob-stata.el ends here
diff --git a/contrib/lisp/ob-tcl.el b/contrib/lisp/ob-tcl.el
index 50afe5a..d66357d 100644
--- a/contrib/lisp/ob-tcl.el
+++ b/contrib/lisp/ob-tcl.el
@@ -62,7 +62,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:tcl (session params)
"Prepare SESSION according to the header arguments in PARAMS."
- (error "Sessions are not supported for Tcl."))
+ (error "Sessions are not supported for Tcl"))
(defun org-babel-variable-assignments:tcl (params)
"Return list of tcl statements assigning the block's variables."
@@ -111,7 +111,7 @@ close $o
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."
- (when session (error "Sessions are not supported for Tcl."))
+ (when session (error "Sessions are not supported for Tcl"))
(case result-type
(output (org-babel-eval org-babel-tcl-command body))
(value (let ((tmp-file (org-babel-temp-file "tcl-")))
diff --git a/contrib/lisp/org-annotate-file.el b/contrib/lisp/org-annotate-file.el
index 05cc45f..b8e8bd9 100644
--- a/contrib/lisp/org-annotate-file.el
+++ b/contrib/lisp/org-annotate-file.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; This is yet another implementation to allow the annotation of a
-;; file without modification of the file itself. The annotation is in
+;; file without modification of the file itself. The annotation is in
;; org syntax so you can use all of the org features you are used to.
;; To use you might put the following in your .emacs:
@@ -47,30 +47,41 @@
;; and next time you hit C-c C-l you will hit those notes again.
;;
;; To put a subheading with a text search for the current line set
-;; `org-annotate-file-add-search` to non-nil value. Then when you hit
+;; `org-annotate-file-add-search` to non-nil value. Then when you hit
;; C-c C-l (on the above line for example) you will get:
;; * ~/org-annotate-file.el
-;; ** `org-annotate-file-add-search` to non-nil value. Then whe...
+;; ** `org-annotate-file-add-search` to non-nil value. Then whe...
;; Note that both of the above will be links.
-(require 'org)
-
-(defvar org-annotate-file-storage-file "~/.org-annotate-file.org"
- "File in which to keep annotations.")
+;;; Code:
-(defvar org-annotate-file-add-search nil
- "If non-nil then add a link as a second level to the actual
-location in the file")
-
-(defvar org-annotate-file-always-open t
- "non-nil means always expand the full tree when you visit
-`org-annotate-file-storage-file'.")
+(require 'org)
-(defun org-annotate-file-elipsify-desc (string &optional after)
- "Strip starting and ending whitespace and replace any chars
-that appear after the value in `after' with '...'"
+(defgroup org-annotate-file nil
+ "Org Annotate"
+ :group 'org)
+
+(defcustom org-annotate-file-storage-file "~/.org-annotate-file.org"
+ "File in which to keep annotations."
+ :group 'org-annotate-file
+ :type 'file)
+
+(defcustom org-annotate-file-add-search nil
+ "If non-nil, add a link as a second level to the actual file location."
+ :group 'org-annotate-file
+ :type 'boolean)
+
+(defcustom org-annotate-file-always-open t
+ "If non-nil, always expand the full tree when visiting the annotation file."
+ :group 'org-annotate-file
+ :type 'boolean)
+
+(defun org-annotate-file-ellipsify-desc (string &optional after)
+ "Return shortened STRING with appended ellipsis.
+Trim whitespace at beginning and end of STRING and replace any
+ characters that appear after the occurrence of AFTER with '...'"
(let* ((after (number-to-string (or after 30)))
(replace-map (list (cons "^[ \t]*" "")
(cons "[ \t]*$" "")
@@ -82,46 +93,61 @@ that appear after the value in `after' with '...'"
replace-map)
string))
+;;;###autoload
(defun org-annotate-file ()
- "Put a section for the current file into your annotation file"
+ "Visit `org-annotate-file-storage-file` and add a new annotation section.
+The annotation is opened at the new section which will be referencing
+the point in the current file."
(interactive)
(unless (buffer-file-name)
- (error "This buffer has no associated file"))
- (org-annotate-file-show-section))
-
-(defun org-annotate-file-show-section (&optional buffer)
- "Visit the buffer named `org-annotate-file-storage-file' and
-show the relevant section"
- (let* ((filename (abbreviate-file-name (or buffer (buffer-file-name))))
- (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
- (link (org-make-link-string (concat "file:" filename) filename))
+ (error "This buffer has no associated file!"))
+ (switch-to-buffer
+ (org-annotate-file-show-section org-annotate-file-storage-file)))
+
+;;;###autoload
+(defun org-annotate-file-show-section (storage-file &optional annotated-buffer)
+ "Add or show annotation entry in STORAGE-FILE and return the buffer.
+The annotation will link to ANNOTATED-BUFFER if specified,
+ otherwise the current buffer is used."
+ (let ((filename (abbreviate-file-name (or annotated-buffer
+ (buffer-file-name))))
+ (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ (annotation-buffer (find-file-noselect storage-file)))
+ (with-current-buffer annotation-buffer
+ (org-annotate-file-annotate filename line))
+ annotation-buffer))
+
+(defun org-annotate-file-annotate (filename line)
+ "Add annotation for FILENAME at LINE using current buffer."
+ (let* ((link (org-make-link-string (concat "file:" filename) filename))
(search-link (org-make-link-string
(concat "file:" filename "::" line)
- (org-annotate-file-elipsify-desc line))))
- (with-current-buffer (find-file org-annotate-file-storage-file)
- (unless (eq major-mode 'org-mode)
- (org-mode))
- (goto-char (point-min))
- (widen)
- (when org-annotate-file-always-open
- (show-all))
+ (org-annotate-file-ellipsify-desc line))))
+ (unless (eq major-mode 'org-mode)
+ (org-mode))
+ (goto-char (point-min))
+ (widen)
+ (when org-annotate-file-always-open
+ (show-all))
+ (unless (search-forward-regexp
+ (concat "^* " (regexp-quote link)) nil t)
+ (org-annotate-file-add-upper-level link))
+ (beginning-of-line)
+ (org-narrow-to-subtree)
+ ;; deal with a '::' search if need be
+ (when org-annotate-file-add-search
(unless (search-forward-regexp
- (concat "^* " (regexp-quote link)) nil t)
- (org-annotate-file-add-upper-level link))
- (beginning-of-line)
- (org-narrow-to-subtree)
- ;; deal with a '::' search if need be
- (when org-annotate-file-add-search
- (unless (search-forward-regexp
- (concat "^** " (regexp-quote search-link)) nil t)
- (org-annotate-file-add-second-level search-link))))))
+ (concat "^** " (regexp-quote search-link)) nil t)
+ (org-annotate-file-add-second-level search-link)))))
(defun org-annotate-file-add-upper-level (link)
+ "Add and link heading to LINK."
(goto-char (point-min))
(call-interactively 'org-insert-heading)
(insert link))
(defun org-annotate-file-add-second-level (link)
+ "Add and link subheading to LINK."
(goto-char (point-at-eol))
(call-interactively 'org-insert-subheading)
(insert link))
diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el
index d392d2d..5f05039 100644
--- a/contrib/lisp/org-bibtex-extras.el
+++ b/contrib/lisp/org-bibtex-extras.el
@@ -75,25 +75,14 @@ For example, to point to your `obe-bibtex-file' use the following.
"Return all citations from `obe-bibtex-file'."
(or obe-citations
(save-window-excursion
- (find-file obe-bibtex-file)
+ (find-file (or obe-bibtex-file
+ (error "`obe-bibtex-file' has not been configured")))
(goto-char (point-min))
(while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t)
(push (org-no-properties (match-string 1))
obe-citations))
obe-citations)))
-(defun obe-goto-citation (&optional citation)
- "Visit a citation given its ID."
- (interactive)
- (let ((citation (or citation
- (org-icompleting-read "Citation: "
- (obe-citations)))))
- (find-file obe-bibtex-file)
- (goto-char (point-min))
- (when (re-search-forward (format " :CUSTOM_ID: %s" citation) nil t)
- (outline-previous-visible-heading 1)
- t)))
-
(defun obe-html-export-citations ()
"Convert all \\cite{...} citations in the current file into HTML links."
(save-excursion
@@ -105,15 +94,6 @@ For example, to point to your `obe-bibtex-file' use the following.
(mapcar #'org-babel-trim
(split-string (match-string 1) ",")) ", "))))))
-(defun obe-get-meta-data (citation)
- "Collect meta-data for CITATION."
- (save-excursion
- (when (obe-goto-citation citation)
- (let ((pt (point)))
- `((:authors . ,(split-string (org-entry-get pt "AUTHOR") " and " t))
- (:title . ,(org-no-properties (org-get-heading 1 1)))
- (:journal . ,(org-entry-get pt "JOURNAL")))))))
-
(defun obe-meta-to-json (meta &optional fields)
"Turn a list of META data from citations into a string of json."
(let ((counter 1) nodes links)
diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el
index 7f3b344..5894707 100644
--- a/contrib/lisp/org-collector.el
+++ b/contrib/lisp/org-collector.el
@@ -121,6 +121,7 @@ preceeding the dblock, then update the contents of the dblock."
(scope (plist-get params :scope))
(noquote (plist-get params :noquote))
(colnames (plist-get params :colnames))
+ (defaultval (plist-get params :defaultval))
(content-lines (org-split-string (plist-get params :content) "\n"))
id table line pos)
(save-excursion
@@ -133,9 +134,10 @@ preceeding the dblock, then update the contents of the dblock."
(t (error "Cannot find entry with :ID: %s" id))))
(unless (eq id 'global) (org-narrow-to-subtree))
(setq stringformat (if noquote "%s" "%S"))
- (setq table (org-propview-to-table
- (org-propview-collect cols stringformat conds match scope inherit
- (if colnames colnames cols)) stringformat))
+ (let ((org-propview-default-value (if defaultval defaultval org-propview-default-value)))
+ (setq table (org-propview-to-table
+ (org-propview-collect cols stringformat conds match scope inherit
+ (if colnames colnames cols)) stringformat)))
(widen))
(setq pos (point))
(when content-lines
diff --git a/contrib/lisp/org-colview-xemacs.el b/contrib/lisp/org-colview-xemacs.el
index 67a2aad..a27275e 100644
--- a/contrib/lisp/org-colview-xemacs.el
+++ b/contrib/lisp/org-colview-xemacs.el
@@ -1,6 +1,6 @@
;;; org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version
-;; Copyright (C) 2004-2014
+;; Copyright (C) 2004-2015
;; Carsten Dominik
;; Author: Carsten Dominik <carsten at orgmode dot org>
@@ -303,10 +303,6 @@ This is the compiled version of the format.")
(beginning-of-line 1)
(and (looking-at "\\(\\**\\)\\(\\* \\)")
(org-get-level-face 2))))
- (item (save-match-data
- (org-remove-tabs
- (buffer-substring-no-properties
- (point-at-bol) (point-at-eol)))))
(color (if (featurep 'xemacs)
(save-excursion
(beginning-of-line 1)
@@ -335,10 +331,10 @@ This is the compiled version of the format.")
(while (setq column (pop fmt))
(setq property (car column)
title (nth 1 column)
- ass (if (equal property "ITEM")
- (cons "ITEM" item)
- (assoc property props))
- width (or (cdr (assoc property org-columns-current-maxwidths))
+ ass (assoc-string property props t)
+ width (or (cdr (assoc-string property
+ org-columns-current-maxwidths
+ t))
(nth 2 column)
(length property))
f (format (if (featurep 'xemacs) "%%-%d.%ds |" "%%-%d.%ds | ")
@@ -351,9 +347,7 @@ This is the compiled version of the format.")
(funcall org-columns-modify-value-for-display-function
title val))
((equal property "ITEM")
- (if (derived-mode-p 'org-mode)
- (org-columns-cleanup-item
- val org-columns-current-fmt-compiled)))
+ (org-columns-compact-links val))
((and calc (functionp calc)
(not (string= val ""))
(not (get-text-property 0 'org-computed val)))
@@ -438,7 +432,9 @@ This is the compiled version of the format.")
(while (setq column (pop fmt))
(setq property (car column)
str (or (nth 1 column) property)
- width (or (cdr (assoc property org-columns-current-maxwidths))
+ width (or (cdr (assoc-string property
+ org-columns-current-maxwidths
+ t))
(nth 2 column)
(length str))
widths (push width widths)
@@ -503,26 +499,6 @@ This is the compiled version of the format.")
(current-buffer))
(setq truncate-lines org-colview-initial-truncate-line-value)))))
-
-(defun org-columns-cleanup-item (item fmt)
- "Remove from ITEM what is a column in the format FMT."
- (if (not org-complex-heading-regexp)
- item
- (when (string-match org-complex-heading-regexp item)
- (setq item
- (concat
- (org-add-props (match-string 1 item) nil
- 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
- (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
- " " (save-match-data (org-columns-compact-links (or (match-string 4 item) "")))
- (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
- (add-text-properties
- 0 (1+ (match-end 1))
- (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- item)
- item)))
-
(defun org-columns-compact-links (s)
"Replace [[link][desc]] with [desc] or [link]."
(while (string-match org-bracket-link-regexp s)
@@ -657,7 +633,7 @@ Where possible, use the standard interface for changing this line."
(org-columns-display-here)))
(org-move-to-column col)
(if (and (derived-mode-p 'org-mode)
- (nth 3 (assoc key org-columns-current-fmt-compiled)))
+ (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????
@@ -736,7 +712,9 @@ an integer, select that value."
org-columns-overlays)))
(allowed (or (org-property-get-allowed-values pom key)
(and (memq
- (nth 4 (assoc key org-columns-current-fmt-compiled))
+ (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)))
@@ -785,7 +763,7 @@ an integer, select that value."
(org-columns-eval '(org-entry-put pom key nval)))
(org-columns-display-here)))
(org-move-to-column col)
- (and (nth 3 (assoc key org-columns-current-fmt-compiled))
+ (and (nth 3 (assoc-string key org-columns-current-fmt-compiled t))
(org-columns-update key))))))
(defun org-colview-construct-allowed-dates (s)
@@ -924,7 +902,9 @@ interactive function `org-columns-new'.
"Insert a new column, to the left of the current column."
(interactive)
(let ((n (org-columns-current-column))
- (editp (and prop (assoc prop org-columns-current-fmt-compiled)))
+ (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))
@@ -980,7 +960,9 @@ interactive function `org-columns-new'.
(let* ((n (org-columns-current-column))
(entry (nth n org-columns-current-fmt-compiled))
(width (or (nth 2 entry)
- (cdr (assoc (car entry) org-columns-current-maxwidths)))))
+ (cdr (assoc-string (car entry)
+ org-columns-current-maxwidths
+ t)))))
(setq width (max 1 (+ width arg)))
(setcar (nthcdr 2 entry) width)
(org-columns-store-format)
@@ -1052,11 +1034,14 @@ Don't set this, this is meant for dynamic scoping.")
(push (cons (match-string 1 s) 1) rtn)
(setq start (match-end 0)))
(mapc (lambda (x)
- (setcdr x (apply 'max
+ (setcdr x
+ (apply 'max
+ (let ((prop (car x)))
(mapcar
(lambda (y)
- (length (or (cdr (assoc (car x) (cdr y))) " ")))
- cache))))
+ (length (or (cdr (assoc-string prop (cdr y) t))
+ " ")))
+ cache)))))
rtn)
rtn))
@@ -1081,9 +1066,11 @@ Don't set this, this is meant for dynamic scoping.")
(when (equal (overlay-get ov 'org-columns-key) property)
(setq pos (overlay-start ov))
(goto-char pos)
- (when (setq val (cdr (assoc property
- (get-text-property
- (point-at-bol) 'org-summaries))))
+ (when (setq val (cdr (assoc-string
+ property
+ (get-text-property
+ (point-at-bol) 'org-summaries)
+ t)))
(setq fmt (overlay-get ov 'org-columns-format))
(overlay-put ov 'org-columns-value val)
(if (featurep 'xemacs)
@@ -1098,11 +1085,11 @@ Don't set this, this is meant for dynamic scoping.")
"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???
+ (lmax 30) ; Does anyone use deeper levels???
(lvals (make-vector lmax nil))
(lflag (make-vector lmax nil))
(level 0)
- (ass (assoc property org-columns-current-fmt-compiled))
+ (ass (assoc-string property org-columns-current-fmt-compiled t))
(format (nth 4 ass))
(printf (nth 5 ass))
(fun (nth 6 ass))
@@ -1131,12 +1118,12 @@ Don't set this, this is meant for dynamic scoping.")
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))
- (if (assoc property sum-alist)
- (setcdr (assoc property sum-alist) useval)
- (push (cons property useval) sum-alist)
- (org-unmodified
- (add-text-properties sumpos (1+ sumpos)
- (list 'org-summaries sum-alist))))
+ (let ((old (assoc-string property sum-alist t)))
+ (if old (setcdr old useval)
+ (push (cons property useval) sum-alist)
+ (org-unmodified
+ (add-text-properties sumpos (1+ sumpos)
+ (list 'org-summaries sum-alist)))))
(when (and val (not (equal val (if flag str val))))
(org-entry-put nil property (if flag str val)))
;; add current to current level accumulator
@@ -1553,7 +1540,7 @@ and tailing newline characters."
(org-get-at-bol 'org-marker)))
(setq p (org-entry-properties m))
- (when (or (not (setq a (assoc org-effort-property p)))
+ (when (or (not (setq a (assoc-string org-effort-property p t)))
(not (string-match "\\S-" (or (cdr a) ""))))
;; OK, the property is not defined. Use appointment duration?
(when (and org-agenda-columns-add-appointments-to-effort-sum
@@ -1617,7 +1604,7 @@ This will add overlays to the date lines, to show the summary for each day."
(t ;; do the summary
(setq lsum nil)
(dolist (x entries)
- (setq v (cdr (assoc prop x)))
+ (setq v (cdr (assoc-string prop x t)))
(if v
(push
(funcall
@@ -1667,8 +1654,10 @@ This will add overlays to the date lines, to show the summary for each day."
(if (equal (car fm) "CLOCKSUM")
(org-clock-sum)
(when (and (nth 4 fm)
- (setq a (assoc (car fm)
- org-columns-current-fmt-compiled))
+ (setq a (assoc-string
+ (car fm)
+ org-columns-current-fmt-compiled
+ t))
(equal (nth 4 a) (nth 4 fm)))
(org-columns-compute (car fm)))))))))))
diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index 0bc9cd7..edc09fe 100644
--- a/contrib/lisp/org-contacts.el
+++ b/contrib/lisp/org-contacts.el
@@ -155,6 +155,11 @@ The following replacements are available:
:type 'string
:group 'org-contacts)
+(defcustom org-contacts-tags-props-prefix "#"
+ "Tags and properties prefix."
+ :type 'string
+ :group 'org-contacts)
+
(defcustom org-contacts-matcher
(mapconcat 'identity (list org-contacts-email-property
org-contacts-alias-property
@@ -183,6 +188,12 @@ This overrides `org-email-link-description-format' if set."
:group 'org-contacts
:type 'boolean)
+(defcustom org-contacts-complete-functions
+ '(org-contacts-complete-group org-contacts-complete-tags-props org-contacts-complete-name)
+ "List of functions used to complete contacts in `message-mode'."
+ :group 'org-contacts
+ :type 'hook)
+
;; Decalre external functions and variables
(declare-function org-reverse-string "org")
(declare-function diary-ordinal-suffix "ext:diary-lib")
@@ -244,30 +255,56 @@ to dead or no buffer."
(let* (todo-only
(contacts-matcher
(cdr (org-make-tags-matcher org-contacts-matcher)))
- markers result)
+ result)
(when (org-contacts-db-need-update-p)
(let ((progress-reporter
(make-progress-reporter "Updating Org Contacts Database..." 0 (length org-contacts-files)))
(i 0))
(dolist (file (org-contacts-files))
- (org-check-agenda-file file)
- (with-current-buffer (org-get-agenda-file-buffer file)
- (unless (eq major-mode 'org-mode)
- (error "File %s is no in `org-mode'" file))
- (org-scan-tags
- '(add-to-list 'markers (set-marker (make-marker) (point)))
- contacts-matcher
- todo-only))
+ (if (catch 'nextfile
+ ;; if file doesn't exist and the user agrees to removing it
+ ;; from org-agendas-list, 'nextfile is thrown. Catch it here
+ ;; and skip processing the file.
+ ;;
+ ;; TODO: suppose that the user has set an org-contacts-files
+ ;; list that contains an element that doesn't exist in the
+ ;; file system: in that case, the org-agenda-files list could
+ ;; be updated (and saved to the customizations of the user) if
+ ;; it contained the same file even though the org-agenda-files
+ ;; list wasn't actually used. I don't think it is normal that
+ ;; org-contacts updates org-agenda-files in this case, but
+ ;; short of duplicating org-check-agenda-files and
+ ;; org-remove-files, I don't know how to avoid it.
+ ;;
+ ;; A side effect of the TODO is that the faulty
+ ;; org-contacts-files list never gets updated and thus the
+ ;; user is always queried about the missing files when
+ ;; org-contacts-db-need-update-p returns true.
+ (org-check-agenda-file file))
+ (message "Skipped %s removed from org-agenda-files list."
+ (abbreviate-file-name file))
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (unless (eq major-mode 'org-mode)
+ (error "File %s is not in `org-mode'" file))
+ (setf result
+ (append result
+ (org-scan-tags
+ 'org-contacts-at-point
+ contacts-matcher
+ todo-only)))))
(progress-reporter-update progress-reporter (setq i (1+ i))))
- (dolist (marker markers result)
- (org-with-point-at marker
- (add-to-list 'result
- (list (org-get-heading t) marker (org-entry-properties marker 'all)))))
(setf org-contacts-db result
org-contacts-last-update (current-time))
- (progress-reporter-done progress-reporter)))
+ (progress-reporter-done progress-reporter)))
org-contacts-db))
+(defun org-contacts-at-point (&optional pom)
+ "Return the contacts at point-or-marker POM or current position
+if nil."
+ (setq pom (or pom (point)))
+ (org-with-point-at pom
+ (list (org-get-heading t) (set-marker (make-marker) pom) (org-entry-properties pom 'all))))
+
(defun org-contacts-filter (&optional name-match tags-match prop-match)
"Search for a contact matching any of NAME-MATCH, TAGS-MATCH, PROP-MATCH.
If all match values are nil, return all contacts.
@@ -500,11 +537,12 @@ A group FOO is composed of contacts with the tag FOO."
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
;; Grab the first email of the contact
- for email = (org-contacts-strip-link (car (org-contacts-split-property
- (or
- (cdr (assoc-string org-contacts-email-property
- (caddr contact)))
- ""))))
+ for email = (org-contacts-strip-link
+ (or (car (org-contacts-split-property
+ (or
+ (cdr (assoc-string org-contacts-email-property
+ (caddr contact)))
+ ""))) ""))
;; If the user has an email address, append USER <EMAIL>.
if email collect (org-contacts-format-email contact-name email))
", ")))
@@ -512,6 +550,45 @@ A group FOO is composed of contacts with the tag FOO."
(completion-table-case-fold completion-list
(not org-contacts-completion-ignore-case))))))))
+(defun org-contacts-complete-tags-props (start end string)
+ "Insert emails that match the tags expression.
+
+For example: FOO-BAR will match entries tagged with FOO but not
+with BAR.
+
+See (org) Matching tags and properties for a complete
+description."
+ (let* ((completion-ignore-case org-contacts-completion-ignore-case)
+ (completion-p (org-string-match-p
+ (concat "^" org-contacts-tags-props-prefix) string)))
+ (when completion-p
+ (let ((result
+ (mapconcat
+ 'identity
+ (loop for contact in (org-contacts-db)
+ for contact-name = (car contact)
+ for email = (org-contacts-strip-link (or (car (org-contacts-split-property
+ (or
+ (cdr (assoc-string org-contacts-email-property
+ (caddr contact)))
+ ""))) ""))
+ for tags = (cdr (assoc "TAGS" (nth 2 contact)))
+ for tags-list = (if tags
+ (split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":")
+ '())
+ for marker = (second contact)
+ if (with-current-buffer (marker-buffer marker)
+ (save-excursion
+ (goto-char marker)
+ (let (todo-only)
+ (eval (cdr (org-make-tags-matcher (subseq string 1)))))))
+ collect (org-contacts-format-email contact-name email))
+ ",")))
+ (when (not (string= "" result))
+ ;; return (start end function)
+ (lexical-let* ((to-return result))
+ (list start end
+ (lambda (string pred &optional to-ignore) to-return))))))))
(defun org-contacts-remove-ignored-property-values (ignore-list list)
"Remove all ignore-list's elements from list and you can use
@@ -570,8 +647,8 @@ A group FOO is composed of contacts with the tag FOO."
(goto-char (match-end 0))
(point))))
(string (buffer-substring start end)))
- (or (org-contacts-complete-group start end string)
- (org-contacts-complete-name start end string))))))
+ (run-hook-with-args-until-success
+ 'org-contacts-complete-functions start end string)))))
(defun org-contacts-gnus-get-name-email ()
"Get name and email address from Gnus message."
@@ -826,7 +903,7 @@ address."
(setq email (org-contacts-strip-link email))
(org-contacts-check-mail-address email)
(compose-mail (org-contacts-format-email (org-get-heading t) email)))))
- (error (format "This contact has no mail address set (no %s property)."
+ (error (format "This contact has no mail address set (no %s property)"
org-contacts-email-property)))))))
(defun org-contacts-get-icon (&optional pom)
@@ -946,7 +1023,7 @@ to do our best."
(setq phones-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property tel)))
(setq result "")
(while phones-list
- (setq result (concat result "TEL:" (org-contacts-strip-link (car phones-list)) "\n"))
+ (setq result (concat result "TEL:" (org-link-unescape (org-contacts-strip-link (car phones-list))) "\n"))
(setq phones-list (cdr phones-list)))
result))
(when bday
@@ -960,11 +1037,39 @@ to do our best."
"END:VCARD\n\n")))
(defun org-contacts-export-as-vcard (&optional name file to-buffer)
+ "Export org contacts to V-Card 3.0.
+
+By default, all contacts are exported to `org-contacts-vcard-file'.
+
+When NAME is \\[universal-argument], prompts for a contact name.
+
+When NAME is \\[universal-argument] \\[universal-argument],
+prompts for a contact name and a file name where to export.
+
+When NAME is \\[universal-argument] \\[universal-argument]
+\\[universal-argument], prompts for a contact name and a buffer where to export.
+
+If the function is not called interactively, all parameters are
+passed to `org-contacts-export-as-vcard-internal'."
+ (interactive "P")
+ (when (called-interactively-p 'any)
+ (cl-psetf name
+ (when name
+ (read-string "Contact name: "
+ (first (org-contacts-at-point))))
+ file
+ (when (equal name '(16))
+ (read-file-name "File: " nil org-contacts-vcard-file))
+ to-buffer
+ (when (equal name '(64))
+ (read-buffer "Buffer: "))))
+ (org-contacts-export-as-vcard-internal name file to-buffer))
+
+(defun org-contacts-export-as-vcard-internal (&optional name file to-buffer)
"Export all contacts matching NAME as VCard 3.0.
If TO-BUFFER is nil, the content is written to FILE or
`org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer
is created and the VCard is written into that buffer."
- (interactive) ; TODO ask for name?
(let* ((filename (or file org-contacts-vcard-file))
(buffer (if to-buffer
(get-buffer-create to-buffer)
diff --git a/contrib/lisp/org-download.el b/contrib/lisp/org-download.el
new file mode 100644
index 0000000..6bff649
--- /dev/null
+++ b/contrib/lisp/org-download.el
@@ -0,0 +1,392 @@
+;;; org-download.el --- Image drag-and-drop for Emacs org-mode
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+;; Keywords: images, screenshots, download
+;; Homepage: http://orgmode.org
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This extension facilitates moving images from point A to point B.
+;;
+;; Point A (the source) can be:
+;; 1. An image inside your browser that you can drag to Emacs.
+;; 2. An image on your file system that you can drag to Emacs.
+;; 3. A local or remote image address in kill-ring.
+;; Use the `org-download-yank' command for this.
+;; Remember that you can use "0 w" in `dired' to get an address.
+;; 4. An screenshot taken using `gnome-screenshot' or `scrot' or `gm'.
+;; Use the `org-download-screenshot' command for this.
+;; Customize the backend with `org-download-screenshot-method'.
+;;
+;; Point B (the target) is an Emacs `org-mode' buffer where the inline
+;; link will be inserted. Several customization options will determine
+;; where exactly on the file system the file will be stored.
+;;
+;; They are:
+;; `org-download-method':
+;; a. 'attach => use `org-mode' attachment machinery
+;; b. 'directory => construct the directory in two stages:
+;; 1. first part of the folder name is:
+;; * either "." (current folder)
+;; * or `org-download-image-dir' (if it's not nil).
+;; `org-download-image-dir' becomes buffer-local when set,
+;; so each file can customize this value, e.g with:
+;; # -*- mode: Org; org-download-image-dir: "~/Pictures/foo"; -*-
+;; 2. second part is:
+;; * `org-download-heading-lvl' is nil => ""
+;; * `org-download-heading-lvl' is n => the name of current
+;; heading with level n. Level count starts with 0,
+;; i.e. * is 0, ** is 1, *** is 2 etc.
+;; `org-download-heading-lvl' becomes buffer-local when set,
+;; so each file can customize this value, e.g with:
+;; # -*- mode: Org; org-download-heading-lvl: nil; -*-
+;;
+;; `org-download-timestamp':
+;; optionally add a timestamp to the file name.
+;;
+;; Customize `org-download-backend' to choose between `url-retrieve'
+;; (the default) or `wget' or `curl'.
+;;
+;;; Code:
+
+
+(eval-when-compile
+ (require 'cl))
+(require 'url-parse)
+(require 'url-http)
+
+(defgroup org-download nil
+ "Image drag-and-drop for org-mode."
+ :group 'org
+ :prefix "org-download-")
+
+(defcustom org-download-method 'directory
+ "The way images should be stored."
+ :type '(choice
+ (const :tag "Directory" directory)
+ (const :tag "Attachment" attach))
+ :group 'org-download)
+
+(defcustom org-download-image-dir nil
+ "If set, images will be stored in this directory instead of \".\".
+See `org-download--dir-1' for more info."
+ :type '(choice
+ (const :tag "Default" nil)
+ (string :tag "Directory"))
+ :group 'org-download)
+(make-variable-buffer-local 'org-download-image-dir)
+
+(defcustom org-download-heading-lvl 0
+ "Heading level to be used in `org-download--dir-2'."
+ :group 'org-download)
+(make-variable-buffer-local 'org-download-heading-lvl)
+
+(defcustom org-download-backend t
+ "Method to use for downloading."
+ :type '(choice
+ (const :tag "wget" "wget \"%s\" -O \"%s\"")
+ (const :tag "curl" "curl \"%s\" -o \"%s\"")
+ (const :tag "url-retrieve" t))
+ :group 'org-download)
+
+(defcustom org-download-timestamp "_%Y-%m-%d_%H:%M:%S"
+ "This `format-time-string'-style string will be appended to the file name.
+Set this to \"\" if you don't want time stamps."
+ :type 'string
+ :group 'org-download)
+
+(defcustom org-download-img-regex-list
+ '("<img +src=\"" "<img +\\(class=\"[^\"]+\"\\)? *src=\"")
+ "This regex is used to unalias links that look like images.
+The html to which the links points will be searched for these
+regexes, one by one, until one succeeds. The found image address
+will be used."
+ :group 'org-download)
+
+(defcustom org-download-screenshot-method "gnome-screenshot -a -f %s"
+ "The tool to capture screenshots."
+ :type '(choice
+ (const :tag "gnome-screenshot" "gnome-screenshot -a -f %s")
+ (const :tag "scrot" "scrot -s %s")
+ (const :tag "gm" "gm import %s"))
+ :group 'org-download)
+
+(defcustom org-download-image-width 0
+ "When non-zero add #+attr_html: :width tag to the image."
+ :type 'integer
+ :group 'org-download)
+
+(defun org-download-get-heading (lvl)
+ "Return the heading of the current entry's LVL level parent."
+ (save-excursion
+ (let ((cur-lvl (org-current-level)))
+ (if cur-lvl
+ (progn
+ (unless (= cur-lvl 1)
+ (org-up-heading-all (- (1- (org-current-level)) lvl)))
+ (substring-no-properties
+ (org-get-heading)))
+ ""))))
+
+(defun org-download--dir-1 ()
+ "Return the first part of the directory path for `org-download--dir'.
+It's `org-download-image-dir', unless it's nil. Then it's \".\"."
+ (or org-download-image-dir "."))
+
+(defun org-download--dir-2 ()
+ "Return the second part of the directory path for `org-download--dir'.
+Unless `org-download-heading-lvl' is nil, it's the name of the current
+`org-download-heading-lvl'-leveled heading. Otherwise it's \"\"."
+ (and org-download-heading-lvl
+ (org-download-get-heading
+ org-download-heading-lvl)))
+
+(defun org-download--dir ()
+ "Return the directory path for image storage.
+
+The path is composed from `org-download--dir-1' and `org-download--dir-2'.
+The directory is created if it didn't exist before."
+ (let* ((part1 (org-download--dir-1))
+ (part2 (org-download--dir-2))
+ (dir (if part2
+ (format "%s/%s" part1 part2)
+ part1)))
+ (unless (file-exists-p dir)
+ (make-directory dir t))
+ dir))
+
+(defun org-download--fullname (link)
+ "Return the file name where LINK will be saved to.
+
+It's affected by `org-download-timestamp' and `org-download--dir'."
+ (let ((filename
+ (file-name-nondirectory
+ (car (url-path-and-query
+ (url-generic-parse-url link)))))
+ (dir (org-download--dir)))
+ (when (string-match ".*?\\.\\(?:png\\|jpg\\)\\(.*\\)$" filename)
+ (setq filename (replace-match "" nil nil filename 1)))
+ (abbreviate-file-name
+ (expand-file-name
+ (format "%s%s.%s"
+ (file-name-sans-extension filename)
+ (format-time-string org-download-timestamp)
+ (file-name-extension filename))
+ dir))))
+
+(defun org-download--image (link filename)
+ "Save LINK to FILENAME asynchronously and show inline images in current buffer."
+ (when (string-match "^file://\\(.*\\)" link)
+ (setq link (url-unhex-string (match-string 1 link))))
+ (cond ((and (not (file-remote-p link))
+ (file-exists-p link))
+ (org-download--image/command "cp \"%s\" \"%s\"" link filename))
+ ((eq org-download-backend t)
+ (org-download--image/url-retrieve link filename))
+ (t
+ (org-download--image/command org-download-backend link filename))))
+
+(defun org-download--image/command (command link filename)
+ "Using COMMAND, save LINK to FILENAME.
+COMMAND is a format-style string with two slots for LINK and FILENAME."
+ (require 'async)
+ (async-start
+ `(lambda() (shell-command
+ ,(format command link
+ (expand-file-name filename))))
+ (lexical-let ((cur-buf (current-buffer)))
+ (lambda(x)
+ (with-current-buffer cur-buf
+ (org-display-inline-images))))))
+
+(defun org-download--image/url-retrieve (link filename)
+ "Save LINK to FILENAME using `url-retrieve'."
+ (url-retrieve
+ link
+ (lambda (status filename buffer)
+ ;; Write current buffer to FILENAME
+ ;; and update inline images in BUFFER
+ (let ((err (plist-get status :error)))
+ (if err (error
+ "\"%s\" %s" link
+ (downcase (nth 2 (assq (nth 2 err) url-http-codes))))))
+ (delete-region
+ (point-min)
+ (progn
+ (re-search-forward "\n\n" nil 'move)
+ (point)))
+ (let ((coding-system-for-write 'no-conversion))
+ (write-region nil nil filename nil nil nil 'confirm))
+ (with-current-buffer buffer
+ (org-display-inline-images)))
+ (list
+ (expand-file-name filename)
+ (current-buffer))
+ nil t))
+
+(defun org-download-yank ()
+ "Call `org-download-image' with current kill."
+ (interactive)
+ (org-download-image (current-kill 0)))
+
+(defun org-download-screenshot ()
+ "Capture screenshot and insert the resulting file.
+The screenshot tool is determined by `org-download-screenshot-method'."
+ (interactive)
+ (let ((link "/tmp/screenshot.png"))
+ (shell-command (format org-download-screenshot-method link))
+ (org-download-image link)))
+
+(defun org-download-image (link)
+ "Save image at address LINK to `org-download--dir'."
+ (interactive "sUrl: ")
+ (unless (image-type-from-file-name link)
+ (with-current-buffer
+ (url-retrieve-synchronously link t)
+ (let ((regexes org-download-img-regex-list)
+ lnk)
+ (while (and (not lnk) regexes)
+ (goto-char (point-min))
+ (when (re-search-forward (pop regexes) nil t)
+ (backward-char)
+ (setq lnk (read (current-buffer)))))
+ (if lnk
+ (setq link lnk)
+ (error "link %s does not point to an image; unaliasing failed" link)))))
+ (let ((filename
+ (if (eq org-download-method 'attach)
+ (let ((org-download-image-dir (progn (require 'org-attach)
+ (org-attach-dir t)))
+ org-download-heading-lvl)
+ (org-download--fullname link))
+ (org-download--fullname link))))
+ (when (image-type-from-file-name filename)
+ (org-download--image link filename)
+ (when (eq org-download-method 'attach)
+ (org-attach-attach filename nil 'none))
+ (if (looking-back "^[ \t]+")
+ (delete-region (match-beginning 0) (match-end 0))
+ (newline))
+ (insert
+ (format "#+DOWNLOADED: %s @ %s\n%s [[%s]]"
+ link
+ (format-time-string "%Y-%m-%d %H:%M:%S")
+ (if (= org-download-image-width 0)
+ ""
+ (format
+ "#+attr_html: :width %dpx\n" org-download-image-width))
+ filename))
+ (org-display-inline-images))))
+
+(defun org-download--at-comment-p ()
+ "Check if current line begins with #+DOWLOADED:."
+ (save-excursion
+ (move-beginning-of-line nil)
+ (looking-at "#\\+DOWNLOADED:")))
+
+(defun org-download-delete ()
+ "Delete inline image link on current line, and the file that it points to."
+ (interactive)
+ (cond ((org-download--at-comment-p)
+ (delete-region (line-beginning-position)
+ (line-end-position))
+ (org-download--delete (line-beginning-position)
+ nil
+ 1))
+ ((region-active-p)
+ (org-download--delete (region-beginning)
+ (region-end))
+ (delete-region (region-beginning)
+ (region-end)))
+
+ (t (org-download--delete (line-beginning-position)
+ (line-end-position)))))
+
+(defun org-download--delete (beg end &optional times)
+ "Delete inline image links and the files they point to between BEG and END.
+
+When TIMES isn't nil, delete only TIMES links."
+ (unless times
+ (setq times most-positive-fixnum))
+ (save-excursion
+ (goto-char beg)
+ (while (and (>= (decf times) 0)
+ (re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" end t))
+ (let ((str (match-string-no-properties 1)))
+ (delete-region beg
+ (match-end 0))
+ (when (file-exists-p str)
+ (delete-file str))))))
+
+(defun org-download-dnd (uri action)
+ "When in `org-mode' and URI points to image, download it.
+Otherwise, pass URI and ACTION back to dnd dispatch."
+ (cond ((eq major-mode 'org-mode)
+ ;; probably shouldn't redirect
+ (unless (org-download-image uri)
+ (message "not an image URL")))
+ ((eq major-mode 'dired-mode)
+ (org-download-dired uri))
+ ;; redirect to someone else
+ (t
+ (let ((dnd-protocol-alist
+ (rassq-delete-all
+ 'org-download-dnd
+ (copy-alist dnd-protocol-alist))))
+ (dnd-handle-one-url nil action uri)))))
+
+(defun org-download-dired (uri)
+ "Download URI to current directory."
+ (raise-frame)
+ (let ((filename (file-name-nondirectory
+ (car (url-path-and-query
+ (url-generic-parse-url uri))))))
+ (message "Downloading %s to %s ..."
+ filename
+ (expand-file-name filename))
+ (url-retrieve
+ uri
+ (lambda (status filename)
+ (let ((err (plist-get status :error)))
+ (if err (error
+ "\"%s\" %s" uri
+ (downcase (nth 2 (assq (nth 2 err) url-http-codes))))))
+ (let ((coding-system-for-write 'no-conversion))
+ (write-region nil nil filename nil nil nil 'confirm)))
+ (list
+ (expand-file-name filename))
+ t t)))
+
+(defun org-download-enable ()
+ "Enable org-download."
+ (unless (eq (cdr (assoc "^\\(https?\\|ftp\\|file\\|nfs\\)://" dnd-protocol-alist))
+ 'org-download-dnd)
+ (setq dnd-protocol-alist
+ `(("^\\(https?\\|ftp\\|file\\|nfs\\)://" . org-download-dnd) ,@dnd-protocol-alist))))
+
+(defun org-download-disable ()
+ "Disable org-download."
+ (rassq-delete-all 'org-download-dnd dnd-protocol-alist))
+
+(org-download-enable)
+
+(provide 'org-download)
+
+;;; org-download.el ends here
diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
index 4387161..a78b806 100644
--- a/contrib/lisp/org-drill.el
+++ b/contrib/lisp/org-drill.el
@@ -1,73 +1,91 @@
;; -*- coding: utf-8-unix -*-
;;; org-drill.el - Self-testing using spaced repetition
;;;
-;; Author: Paul Sexton <eeeickythump@gmail.com>
-;; Version: 2.3.7
-;; Repository at http://bitbucket.org/eeeickythump/org-drill/
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, 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 and synopsis:
+;;; Copyright (C) 2010-2015 Paul Sexton
;;;
-;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
-;; "drill sessions", where the material to be remembered is presented to the
-;; student in random order. The student rates his or her recall of each item,
-;; and this information is used to schedule the item for later revision.
-;;
-;; Each drill session can be restricted to topics in the current buffer
-;; (default), one or several files, all agenda files, or a subtree. A single
-;; topic can also be drilled.
-;;
-;; Different "card types" can be defined, which present their information to
-;; the student in different ways.
-;;
-;; See the file README.org for more detailed documentation.
-;;
-;;; Code:
+;;; Author: Paul Sexton <eeeickythump@gmail.com>
+;;; Version: 2.4.7
+;;; Keywords: flashcards, memory, learning, memorization
+;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
+;;;
+;;; This file is not part of GNU Emacs.
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distaributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;;
+;;;
+;;; Synopsis
+;;; ========
+;;;
+;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
+;;; "drill sessions", where the material to be remembered is presented to the
+;;; student in random order. The student rates his or her recall of each item,
+;;; and this information is used to schedule the item for later revision.
+;;;
+;;; Each drill session can be restricted to topics in the current buffer
+;;; (default), one or several files, all agenda files, or a subtree. A single
+;;; topic can also be drilled.
+;;;
+;;; Different "card types" can be defined, which present their information to
+;;; the student in different ways.
+;;;
+;;; See the file README.org for more detailed documentation.
+
(eval-when-compile (require 'cl))
(eval-when-compile (require 'hi-lock))
+(require 'cl-lib)
+(require 'hi-lock)
(require 'org)
(require 'org-id)
(require 'org-learn)
+(require 'savehist)
+
(defgroup org-drill nil
"Options concerning interactive drill sessions in Org mode (org-drill)."
:tag "Org-Drill"
:group 'org-link)
-(defcustom org-drill-question-tag "drill"
+
+
+(defcustom org-drill-question-tag
+ "drill"
"Tag which topics must possess in order to be identified as review topics
by `org-drill'."
:group 'org-drill
:type 'string)
-(defcustom org-drill-maximum-items-per-session 30
+
+(defcustom org-drill-maximum-items-per-session
+ 30
"Each drill session will present at most this many topics for review.
Nil means unlimited."
:group 'org-drill
:type '(choice integer (const nil)))
-(defcustom org-drill-maximum-duration 20
+
+
+(defcustom org-drill-maximum-duration
+ 20
"Maximum duration of a drill session, in minutes.
Nil means unlimited."
:group 'org-drill
:type '(choice integer (const nil)))
-(defcustom org-drill-failure-quality 2
+
+(defcustom org-drill-failure-quality
+ 2
"If the quality of recall for an item is this number or lower,
it is regarded as an unambiguous failure, and the repetition
interval for the card is reset to 0 days. If the quality is higher
@@ -81,7 +99,9 @@ really sensible."
:group 'org-drill
:type '(choice (const 2) (const 1)))
-(defcustom org-drill-forgetting-index 10
+
+(defcustom org-drill-forgetting-index
+ 10
"What percentage of items do you consider it is 'acceptable' to
forget each drill session? The default is 10%. A warning message
is displayed at the end of the session if the percentage forgotten
@@ -89,13 +109,17 @@ climbs above this number."
:group 'org-drill
:type 'integer)
-(defcustom org-drill-leech-failure-threshold 15
+
+(defcustom org-drill-leech-failure-threshold
+ 15
"If an item is forgotten more than this many times, it is tagged
as a 'leech' item."
:group 'org-drill
:type '(choice integer (const nil)))
-(defcustom org-drill-leech-method 'skip
+
+(defcustom org-drill-leech-method
+ 'skip
"How should 'leech items' be handled during drill sessions?
Possible values:
- nil :: Leech items are treated the same as normal items.
@@ -106,60 +130,87 @@ Possible values:
:group 'org-drill
:type '(choice (const warn) (const skip) (const nil)))
+
(defface org-drill-visible-cloze-face
'((t (:foreground "darkseagreen")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
+
(defface org-drill-visible-cloze-hint-face
'((t (:foreground "dark slate blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
+
(defface org-drill-hidden-cloze-face
'((t (:foreground "deep sky blue" :background "blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
-(defcustom org-drill-use-visible-cloze-face-p nil
+
+(defcustom org-drill-use-visible-cloze-face-p
+ nil
"Use a special face to highlight cloze-deleted text in org mode
buffers?"
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-hide-item-headings-p nil
+
+(defcustom org-drill-hide-item-headings-p
+ nil
"Conceal the contents of the main heading of each item during drill
sessions? You may want to enable this behaviour if item headings or tags
contain information that could 'give away' the answer."
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-new-count-color "royal blue"
+
+(defcustom org-drill-new-count-color
+ "royal blue"
"Foreground colour used to display the count of remaining new items
during a drill session."
:group 'org-drill
:type 'color)
-(defcustom org-drill-mature-count-color "green"
+(defcustom org-drill-mature-count-color
+ "green"
"Foreground colour used to display the count of remaining mature items
during a drill session. Mature items are due for review, but are not new."
:group 'org-drill
:type 'color)
-(defcustom org-drill-failed-count-color "red"
+(defcustom org-drill-failed-count-color
+ "red"
"Foreground colour used to display the count of remaining failed items
during a drill session."
:group 'org-drill
:type 'color)
-(defcustom org-drill-done-count-color "sienna"
+(defcustom org-drill-done-count-color
+ "sienna"
"Foreground colour used to display the count of reviewed items
during a drill session."
:group 'org-drill
:type 'color)
+(defcustom org-drill-left-cloze-delimiter
+ "["
+ "String used within org buffers to delimit cloze deletions."
+ :group 'org-drill
+ :type 'string)
+
+(defcustom org-drill-right-cloze-delimiter
+ "]"
+ "String used within org buffers to delimit cloze deletions."
+ :group 'org-drill
+ :type 'string)
+
+
(setplist 'org-drill-cloze-overlay-defaults
- '(display "[...]"
+ `(display ,(format "%s...%s"
+ org-drill-left-cloze-delimiter
+ org-drill-right-cloze-delimiter)
face org-drill-hidden-cloze-face
window t))
@@ -171,21 +222,54 @@ during a drill session."
face default
window t))
+(add-hook 'org-font-lock-set-keywords-hook 'org-drill-add-cloze-fontification)
+
+
(defvar org-drill-hint-separator "||"
"String which, if it occurs within a cloze expression, signifies that the
rest of the expression after the string is a `hint', to be displayed instead of
the hidden cloze during a test.")
-(defvar org-drill-cloze-regexp
- (concat "\\(\\[[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
+(defun org-drill--compute-cloze-regexp ()
+ (concat "\\("
+ (regexp-quote org-drill-left-cloze-delimiter)
+ "[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
(regexp-quote org-drill-hint-separator)
- ".+?\\)\\(\\]\\)"))
+ ".+?\\)\\("
+ (regexp-quote org-drill-right-cloze-delimiter)
+ "\\)"))
+
+(defun org-drill--compute-cloze-keywords ()
+ (list (list (org-drill--compute-cloze-regexp)
+ (copy-list '(1 'org-drill-visible-cloze-face nil))
+ (copy-list '(2 'org-drill-visible-cloze-hint-face t))
+ (copy-list '(3 'org-drill-visible-cloze-face nil))
+ )))
+
+(defvar-local org-drill-cloze-regexp
+ (org-drill--compute-cloze-regexp))
+
+
+(defvar-local org-drill-cloze-keywords
+ (org-drill--compute-cloze-keywords))
+
+
+;; Variables defining what keys can be pressed during drill sessions to quit the
+;; session, edit the item, etc.
+(defvar org-drill--quit-key ?q
+ "If this character is pressed during a drill session, quit the session.")
+(defvar org-drill--edit-key ?e
+ "If this character is pressed during a drill session, suspend the session
+with the cursor at the current item..")
+(defvar org-drill--help-key ??
+ "If this character is pressed during a drill session, show help.")
+(defvar org-drill--skip-key ?s
+ "If this character is pressed during a drill session, skip to the next
+item.")
+(defvar org-drill--tags-key ?t
+ "If this character is pressed during a drill session, edit the tags for
+the current item.")
-(defvar org-drill-cloze-keywords
- `((,org-drill-cloze-regexp
- (1 'org-drill-visible-cloze-face nil)
- (2 'org-drill-visible-cloze-hint-face t)
- (3 'org-drill-visible-cloze-face nil))))
(defcustom org-drill-card-type-alist
'((nil org-drill-present-simple-card)
@@ -234,7 +318,9 @@ even if their bodies are empty."
:type '(alist :key-type (choice string (const nil))
:value-type function))
-(defcustom org-drill-scope 'file
+
+(defcustom org-drill-scope
+ 'file
"The scope in which to search for drill items when conducting a
drill session. This can be any of:
@@ -265,13 +351,25 @@ directory All files with the extension '.org' in the same
(const :tag "All files with the extension '.org' in the same directory as the current file (includes the current file if it is an .org file.)" directory)
(repeat :tag "List of files to scan for drill items." file)))
-(defcustom org-drill-save-buffers-after-drill-sessions-p t
+
+(defcustom org-drill-match
+ nil
+ "If non-nil, a string specifying a tags/property/TODO query. During
+drill sessions, only items that match this query will be considered."
+ :group 'org-drill
+ :type '(choice (const nil) string))
+
+
+(defcustom org-drill-save-buffers-after-drill-sessions-p
+ t
"If non-nil, prompt to save all modified buffers after a drill session
finishes."
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-spaced-repetition-algorithm 'sm5
+
+(defcustom org-drill-spaced-repetition-algorithm
+ 'sm5
"Which SuperMemo spaced repetition algorithm to use for scheduling items.
Available choices are:
- SM2 :: the SM2 algorithm, used in SuperMemo 2.0
@@ -286,26 +384,53 @@ Available choices are:
:group 'org-drill
:type '(choice (const sm2) (const sm5) (const simple8)))
-(defcustom org-drill-optimal-factor-matrix nil
+
+(defcustom org-drill-optimal-factor-matrix
+ nil
+ "Obsolete and will be removed in future. The SM5 optimal factor
+matrix data is now stored in the variable
+`org-drill-sm5-optimal-factor-matrix'."
+ :group 'org-drill
+ :type 'sexp)
+
+
+(defvar org-drill-sm5-optimal-factor-matrix
+ nil
"DO NOT CHANGE THE VALUE OF THIS VARIABLE.
-Persistent matrix of optimal factors, used by the SuperMemo SM5 algorithm.
-The matrix is saved (using the 'customize' facility) at the end of each
-drill session.
+Persistent matrix of optimal factors, used by the SuperMemo SM5
+algorithm. The matrix is saved at the end of each drill session.
Over time, values in the matrix will adapt to the individual user's
-pace of learning."
- :group 'org-drill
- :type 'sexp)
+pace of learning.")
+
+
+(add-to-list 'savehist-additional-variables
+ 'org-drill-sm5-optimal-factor-matrix)
+(unless savehist-mode
+ (savehist-mode 1))
+
+
+(defun org-drill--transfer-optimal-factor-matrix ()
+ (if (and org-drill-optimal-factor-matrix
+ (null org-drill-sm5-optimal-factor-matrix))
+ (setq org-drill-sm5-optimal-factor-matrix
+ org-drill-optimal-factor-matrix)))
+
+(add-hook 'after-init-hook 'org-drill--transfer-optimal-factor-matrix)
+
-(defcustom org-drill-sm5-initial-interval 4.0
+(defcustom org-drill-sm5-initial-interval
+ 4.0
"In the SM5 algorithm, the initial interval after the first
successful presentation of an item is always 4 days. If you wish to change
this, you can do so here."
:group 'org-drill
:type 'float)
-(defcustom org-drill-add-random-noise-to-intervals-p nil
+
+(defcustom org-drill-add-random-noise-to-intervals-p
+ nil
"If true, the number of days until an item's next repetition
will vary slightly from the interval calculated by the SM2
algorithm. The variation is very small when the interval is
@@ -313,7 +438,9 @@ small, but scales up with the interval."
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p nil
+
+(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p
+ nil
"If true, when the student successfully reviews an item 1 or more days
before or after the scheduled review date, this will affect that date of
the item's next scheduled review, according to the algorithm presented at
@@ -328,7 +455,9 @@ is used."
:group 'org-drill
:type 'boolean)
-(defcustom org-drill-cloze-text-weight 4
+
+(defcustom org-drill-cloze-text-weight
+ 4
"For card types 'hide1_firstmore', 'show1_lastmore' and 'show1_firstless',
this number determines how often the 'less favoured' situation
should arise. It will occur 1 in every N trials, where N is the
@@ -347,12 +476,15 @@ all weighted card types are treated as their unweighted equivalents."
:group 'org-drill
:type '(choice integer (const nil)))
-(defcustom org-drill-cram-hours 12
+
+(defcustom org-drill-cram-hours
+ 12
"When in cram mode, items are considered due for review if
they were reviewed at least this many hours ago."
:group 'org-drill
:type 'integer)
+
;;; NEW items have never been presented in a drill session before.
;;; MATURE items HAVE been presented at least once before.
;;; - YOUNG mature items were scheduled no more than
@@ -365,13 +497,17 @@ they were reviewed at least this many hours ago."
;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days,
;;; regardless of young/old status.
-(defcustom org-drill-days-before-old 10
+
+(defcustom org-drill-days-before-old
+ 10
"When an item's inter-repetition interval rises above this value in days,
it is no longer considered a 'young' (recently learned) item."
:group 'org-drill
:type 'integer)
-(defcustom org-drill-overdue-interval-factor 1.2
+
+(defcustom org-drill-overdue-interval-factor
+ 1.2
"An item is considered overdue if its scheduled review date is
more than (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) * LAST-INTERVAL
days in the past. For example, a value of 1.2 means an additional
@@ -383,7 +519,9 @@ should never be less than 1.0."
:group 'org-drill
:type 'float)
-(defcustom org-drill-learn-fraction 0.5
+
+(defcustom org-drill-learn-fraction
+ 0.5
"Fraction between 0 and 1 that governs how quickly the spaces
between successive repetitions increase, for all items. The
default value is 0.5. Higher values make spaces increase more
@@ -393,6 +531,7 @@ exponential effect on inter-repetition spacing."
:group 'org-drill
:type 'float)
+
(defvar drill-answer nil
"Global variable that can be bound to a correct answer when an
item is being presented. If this variable is non-nil, the default
@@ -403,6 +542,7 @@ This variable is useful for card types that compute their answers
-- for example, a card type that asks the student to translate a
random number to another language. ")
+
(defvar *org-drill-session-qualities* nil)
(defvar *org-drill-start-time* 0)
(defvar *org-drill-new-entries* nil)
@@ -431,9 +571,16 @@ for review unless they were already reviewed in the recent past?")
'("LEARN_DATA" "DRILL_LAST_INTERVAL" "DRILL_REPEATS_SINCE_FAIL"
"DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY"
"DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED"))
+(defvar org-drill--lapse-very-overdue-entries-p nil
+ "If non-nil, entries more than 90 days overdue are regarded as 'lapsed'.
+This means that when the item is eventually re-tested it will be
+treated as 'failed' (quality 2) for rescheduling purposes,
+regardless of whether the test was successful.")
+
;;; Make the above settings safe as file-local variables.
+
(put 'org-drill-question-tag 'safe-local-variable 'stringp)
(put 'org-drill-maximum-items-per-session 'safe-local-variable
'(lambda (val) (or (integerp val) (null val))))
@@ -458,15 +605,22 @@ for review unless they were already reviewed in the recent past?")
(put 'org-drill-overdue-interval-factor 'safe-local-variable 'floatp)
(put 'org-drill-scope 'safe-local-variable
'(lambda (val) (or (symbolp val) (listp val))))
+(put 'org-drill-match 'safe-local-variable
+ '(lambda (val) (or (stringp val) (null val))))
(put 'org-drill-save-buffers-after-drill-sessions-p 'safe-local-variable 'booleanp)
(put 'org-drill-cloze-text-weight 'safe-local-variable
'(lambda (val) (or (null val) (integerp val))))
+(put 'org-drill-left-cloze-delimiter 'safe-local-variable 'stringp)
+(put 'org-drill-right-cloze-delimiter 'safe-local-variable 'stringp)
+
;;;; Utilities ================================================================
+
(defun free-marker (m)
(set-marker m nil))
+
(defmacro pop-random (place)
(let ((idx (gensym)))
`(if (null ,place)
@@ -476,18 +630,20 @@ for review unless they were already reviewed in the recent past?")
(setq ,place (append (subseq ,place 0 ,idx)
(subseq ,place (1+ ,idx)))))))))
+
(defmacro push-end (val place)
"Add VAL to the end of the sequence stored in PLACE. Return the new
value."
`(setq ,place (append ,place (list ,val))))
+
(defun shuffle-list (list)
"Randomly permute the elements of LIST (all permutations equally likely)."
;; Adapted from 'shuffle-vector' in cookie1.el
(let ((i 0)
- j
- temp
- (len (length list)))
+ j
+ temp
+ (len (length list)))
(while (< i len)
(setq j (+ i (random* (- len i))))
(setq temp (nth i list))
@@ -496,28 +652,43 @@ value."
(setq i (1+ i))))
list)
+
(defun round-float (floatnum fix)
"Round the floating point number FLOATNUM to FIX decimal places.
Example: (round-float 3.56755765 3) -> 3.568"
(let ((n (expt 10 fix)))
(/ (float (round (* floatnum n))) n)))
+
(defun command-keybinding-to-string (cmd)
"Return a human-readable description of the key/keys to which the command
CMD is bound, or nil if it is not bound to a key."
(let ((key (where-is-internal cmd overriding-local-map t)))
(if key (key-description key))))
+
(defun time-to-inactive-org-timestamp (time)
(format-time-string
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
time))
-(defun org-map-drill-entries (func &optional scope &rest skip)
+
+(defun time-to-active-org-timestamp (time)
+ (format-time-string
+ (concat "<" (substring (cdr org-time-stamp-formats) 1 -1) ">")
+ time))
+
+
+(defun org-map-drill-entries (func &optional scope drill-match &rest skip)
"Like `org-map-entries', but only drill entries are processed."
- (let ((org-drill-scope (or scope org-drill-scope)))
+ (let ((org-drill-scope (or scope org-drill-scope))
+ (org-drill-match (or drill-match org-drill-match)))
(apply 'org-map-entries func
- (concat "+" org-drill-question-tag)
+ (concat "+" org-drill-question-tag
+ (if (and (stringp org-drill-match)
+ (not (member '(?+ ?- ?|) (elt org-drill-match 0))))
+ "+" "")
+ (or org-drill-match ""))
(case org-drill-scope
(file nil)
(file-no-restriction 'file)
@@ -527,6 +698,7 @@ CMD is bound, or nil if it is not bound to a key."
(t org-drill-scope))
skip)))
+
(defmacro with-hidden-cloze-text (&rest body)
`(progn
(org-drill-hide-clozed-text)
@@ -535,6 +707,7 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-clozed-text))))
+
(defmacro with-hidden-cloze-hints (&rest body)
`(progn
(org-drill-hide-cloze-hints)
@@ -543,6 +716,7 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-text))))
+
(defmacro with-hidden-comments (&rest body)
`(progn
(if org-drill-hide-item-headings-p
@@ -553,6 +727,7 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-text))))
+
(defun org-drill-days-since-last-review ()
"Nil means a last review date has not yet been stored for
the item.
@@ -566,6 +741,7 @@ this should never happen."
(time-to-days (apply 'encode-time
(org-parse-time-string datestr)))))))
+
(defun org-drill-hours-since-last-review ()
"Like `org-drill-days-since-last-review', but return value is
in hours rather than days."
@@ -577,6 +753,7 @@ in hours rather than days."
(org-parse-time-string datestr))))
(* 60 60))))))
+
(defun org-drill-entry-p (&optional marker)
"Is MARKER, or the point, in a 'drill item'? This will return nil if
the point is inside a subheading of a drill item -- to handle that
@@ -586,10 +763,12 @@ situation use `org-part-of-drill-entry-p'."
(org-drill-goto-entry marker))
(member org-drill-question-tag (org-get-local-tags))))
+
(defun org-drill-goto-entry (marker)
(switch-to-buffer (marker-buffer marker))
(goto-char marker))
+
(defun org-part-of-drill-entry-p ()
"Is the current entry either the main heading of a 'drill item',
or a subheading within a drill item?"
@@ -597,6 +776,7 @@ or a subheading within a drill item?"
;; Does this heading INHERIT the drill tag
(member org-drill-question-tag (org-get-tags-at))))
+
(defun org-drill-goto-drill-entry-heading ()
"Move the point to the heading which holds the :drill: tag for this
drill entry."
@@ -608,11 +788,14 @@ drill entry."
(unless (org-up-heading-safe)
(error "Cannot find a parent heading that is marked as a drill entry"))))
+
+
(defun org-drill-entry-leech-p ()
"Is the current entry a 'leech item'?"
(and (org-drill-entry-p)
(member "leech" (org-get-local-tags))))
+
;; (defun org-drill-entry-due-p ()
;; (cond
;; (*org-drill-cram-mode*
@@ -630,6 +813,7 @@ drill entry."
;; (- (time-to-days (current-time))
;; (time-to-days item-time))))))))))
+
(defun org-drill-entry-days-overdue ()
"Returns:
- NIL if the item is not to be regarded as scheduled for review at all.
@@ -659,6 +843,7 @@ drill entry."
(- (time-to-days (current-time))
(time-to-days item-time))))))))
+
(defun org-drill-entry-overdue-p (&optional days-overdue last-interval)
"Returns true if entry that is scheduled DAYS-OVERDUE dasy in the past,
and whose last inter-repetition interval was LAST-INTERVAL, should be
@@ -674,28 +859,34 @@ from the entry at point."
(> (/ (+ days-overdue last-interval 1.0) last-interval)
org-drill-overdue-interval-factor)))
+
+
(defun org-drill-entry-due-p ()
(let ((due (org-drill-entry-days-overdue)))
(and (not (null due))
(not (minusp due)))))
+
(defun org-drill-entry-new-p ()
(and (org-drill-entry-p)
(let ((item-time (org-get-scheduled-time (point))))
(null item-time))))
+
(defun org-drill-entry-last-quality (&optional default)
(let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
(if quality
(string-to-number quality)
default)))
+
(defun org-drill-entry-failure-count ()
(let ((quality (org-entry-get (point) "DRILL_FAILURE_COUNT")))
(if quality
(string-to-number quality)
0)))
+
(defun org-drill-entry-average-quality (&optional default)
(let ((val (org-entry-get (point) "DRILL_AVERAGE_QUALITY")))
(if val
@@ -726,16 +917,17 @@ from the entry at point."
(string-to-number val)
default)))
+
;;; From http://www.supermemo.com/english/ol/sm5.htm
(defun org-drill-random-dispersal-factor ()
"Returns a random number between 0.5 and 1.5."
(let ((a 0.047)
(b 0.092)
(p (- (random* 1.0) 0.5)))
- (flet ((sign (n)
- (cond ((zerop n) 0)
- ((plusp n) 1)
- (t -1))))
+ (cl-flet ((sign (n)
+ (cond ((zerop n) 0)
+ ((plusp n) 1)
+ (t -1))))
(/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p)))))
(sign p)))
100.0))))
@@ -748,9 +940,10 @@ from the entry at point."
(- variation)
mean))
+
(defun org-drill-early-interval-factor (optimal-factor
- optimal-interval
- days-ahead)
+ optimal-interval
+ days-ahead)
"Arguments:
- OPTIMAL-FACTOR: interval-factor if the item had been tested
exactly when it was supposed to be.
@@ -767,6 +960,7 @@ in the matrix."
(- optimal-factor
(* delta-ofmax (/ days-ahead (+ days-ahead (* 0.6 optimal-interval)))))))
+
(defun org-drill-get-item-data ()
"Returns a list of 6 items, containing all the stored recall
data for the item at point:
@@ -804,6 +998,7 @@ in the matrix."
(t ; virgin item
(list 0 0 0 0 nil nil)))))
+
(defun org-drill-store-item-data (last-interval repeats failures
total-repeats meanq
ease)
@@ -819,8 +1014,11 @@ in the matrix."
(org-set-property "DRILL_EASE"
(number-to-string (round-float ease 3))))
+
+
;;; SM2 Algorithm =============================================================
+
(defun determine-next-interval-sm2 (last-interval n ef quality
failures meanq total-repeats)
"Arguments:
@@ -840,7 +1038,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
;; When an item is failed, its interval is reset to 0,
;; but its EF is unchanged
(list -1 1 ef (1+ failures) meanq (1+ total-repeats)
- org-drill-optimal-factor-matrix)
+ org-drill-sm5-optimal-factor-matrix)
;; else:
(let* ((next-ef (modify-e-factor ef quality))
(interval
@@ -864,11 +1062,13 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(1+ n)
next-ef
failures meanq (1+ total-repeats)
- org-drill-optimal-factor-matrix))))
+ org-drill-sm5-optimal-factor-matrix))))
;;; SM5 Algorithm =============================================================
+
+
(defun initial-optimal-factor-sm5 (n ef)
(if (= 1 n)
org-drill-sm5-initial-interval
@@ -877,17 +1077,19 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(defun get-optimal-factor-sm5 (n ef of-matrix)
(let ((factors (assoc n of-matrix)))
(or (and factors
- (let ((ef-of (assoc ef (cdr factors))))
- (and ef-of (cdr ef-of))))
- (initial-optimal-factor-sm5 n ef))))
+ (let ((ef-of (assoc ef (cdr factors))))
+ (and ef-of (cdr ef-of))))
+ (initial-optimal-factor-sm5 n ef))))
+
(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix)
(let ((of (get-optimal-factor-sm5 n ef (or of-matrix
- org-drill-optimal-factor-matrix))))
+ org-drill-sm5-optimal-factor-matrix))))
(if (= 1 n)
- of
+ of
(* of last-interval))))
+
(defun determine-next-interval-sm5 (last-interval n ef quality
failures meanq total-repeats
of-matrix &optional delta-days)
@@ -896,12 +1098,14 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(assert (> n 0))
(assert (and (>= quality 0) (<= quality 5)))
(unless of-matrix
- (setq of-matrix org-drill-optimal-factor-matrix))
+ (setq of-matrix org-drill-sm5-optimal-factor-matrix))
(setq of-matrix (cl-copy-tree of-matrix))
+
(setq meanq (if meanq
(/ (+ quality (* meanq total-repeats 1.0))
(1+ total-repeats))
quality))
+
(let ((next-ef (modify-e-factor ef quality))
(old-ef ef)
(new-of (modify-of (get-optimal-factor-sm5 n ef of-matrix)
@@ -914,10 +1118,13 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(inter-repetition-interval-sm5
last-interval n ef of-matrix)
delta-days)))
+
(setq of-matrix
(set-optimal-factor n next-ef of-matrix
(round-float new-of 3))) ; round OF to 3 d.p.
+
(setq ef next-ef)
+
(cond
;; "Failed" -- reset repetitions to 0,
((<= quality org-drill-failure-quality)
@@ -942,8 +1149,10 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(1+ total-repeats)
of-matrix)))))
+
;;; Simple8 Algorithm =========================================================
+
(defun org-drill-simple8-first-interval (failures)
"Arguments:
- FAILURES: integer >= 0. The total number of times the item has
@@ -953,6 +1162,7 @@ Returns the optimal FIRST interval for an item which has previously been
forgotten on FAILURES occasions."
(* 2.4849 (exp (* -0.057 failures))))
+
(defun org-drill-simple8-interval-factor (ease repetition)
"Arguments:
- EASE: floating point number >= 1.2. Corresponds to `AF' in SM8 algorithm.
@@ -963,6 +1173,7 @@ The factor by which the last interval should be
multiplied to give the next interval. Corresponds to `RF' or `OF'."
(+ 1.2 (* (- ease 1.2) (expt org-drill-learn-fraction (log repetition 2)))))
+
(defun org-drill-simple8-quality->ease (quality)
"Returns the ease (`AF' in the SM8 algorithm) which corresponds
to a mean item quality of QUALITY."
@@ -972,6 +1183,7 @@ to a mean item quality of QUALITY."
(* -1.2403 quality)
1.4515))
+
(defun determine-next-interval-simple8 (last-interval repeats quality
failures meanq totaln
&optional delta-days)
@@ -1038,7 +1250,11 @@ See the documentation for `org-drill-get-item-data' for a description of these."
(org-drill-simple8-quality->ease meanq)
failures
meanq
- totaln)))
+ totaln
+ )))
+
+
+
;;; Essentially copied from `org-learn.el', but modified to
;;; optionally call the SM2 or simple8 functions.
@@ -1046,9 +1262,9 @@ See the documentation for `org-drill-get-item-data' for a description of these."
"If DAYS-AHEAD is supplied it must be a positive integer. The
item will be scheduled exactly this many days into the future."
(let ((delta-days (- (time-to-days (current-time))
- (time-to-days (or (org-get-scheduled-time (point))
- (current-time)))))
- (ofmatrix org-drill-optimal-factor-matrix)
+ (time-to-days (or (org-get-scheduled-time (point))
+ (current-time)))))
+ (ofmatrix org-drill-sm5-optimal-factor-matrix)
;; Entries can have weights, 1 by default. Intervals are divided by the
;; item's weight, so an item with a weight of 2 will have all intervals
;; halved, meaning you will end up reviewing it twice as often.
@@ -1087,11 +1303,11 @@ item will be scheduled exactly this many days into the future."
total-repeats meanq ease)
(if (eql 'sm5 org-drill-spaced-repetition-algorithm)
- (setq org-drill-optimal-factor-matrix new-ofmatrix))
+ (setq org-drill-sm5-optimal-factor-matrix new-ofmatrix))
(cond
((= 0 days-ahead)
- (org-schedule t))
+ (org-schedule '(4)))
((minusp days-ahead)
(org-schedule nil (current-time)))
(t
@@ -1117,7 +1333,7 @@ of QUALITY."
(sm5 (determine-next-interval-sm5 last-interval repetitions
ease quality failures
meanq total-repeats
- org-drill-optimal-factor-matrix))
+ org-drill-sm5-optimal-factor-matrix))
(sm2 (determine-next-interval-sm2 last-interval repetitions
ease quality failures
meanq total-repeats))
@@ -1147,11 +1363,19 @@ of QUALITY."
"Returns quality rating (0-5), or nil if the user quit."
(let ((ch nil)
(input nil)
- (next-review-dates (org-drill-hypothetical-next-review-dates)))
+ (next-review-dates (org-drill-hypothetical-next-review-dates))
+ (key-prompt (format "(0-5, %c=help, %c=edit, %c=tags, %c=quit)"
+ org-drill--help-key
+ org-drill--edit-key
+ org-drill--tags-key
+ org-drill--quit-key)))
(save-excursion
- (while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5)))
+ (while (not (memq ch (list org-drill--quit-key
+ org-drill--edit-key
+ 7 ; C-g
+ ?0 ?1 ?2 ?3 ?4 ?5)))
(setq input (read-key-sequence
- (if (eq ch ??)
+ (if (eq ch org-drill--help-key)
(format "0-2 Means you have forgotten the item.
3-5 Means you have remembered the item.
@@ -1162,11 +1386,12 @@ of QUALITY."
4 - After a little bit of thought you remembered. (+%s days)
5 - You remembered the item really easily. (+%s days)
-How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
+How well did you do? %s"
(round (nth 3 next-review-dates))
(round (nth 4 next-review-dates))
- (round (nth 5 next-review-dates)))
- "How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)")))
+ (round (nth 5 next-review-dates))
+ key-prompt)
+ (format "How well did you do? %s" key-prompt))))
(cond
((stringp input)
(setq ch (elt input 0)))
@@ -1183,7 +1408,7 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
(case (car (elt input 0))
(wheel-up (ignore-errors (mwheel-scroll (elt input 0))))
(wheel-down (ignore-errors (mwheel-scroll (elt input 0)))))))
- (if (eql ch ?t)
+ (if (eql ch org-drill--tags-key)
(org-set-tags-command))))
(cond
((and (>= ch ?0) (<= ch ?5))
@@ -1191,8 +1416,9 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
(failures (org-drill-entry-failure-count)))
(unless *org-drill-cram-mode*
(save-excursion
- (org-drill-smart-reschedule quality
- (nth quality next-review-dates)))
+ (let ((quality (if (org-drill--entry-lapsed-p) 2 quality)))
+ (org-drill-smart-reschedule quality
+ (nth quality next-review-dates))))
(push quality *org-drill-session-qualities*)
(cond
((<= quality org-drill-failure-quality)
@@ -1213,11 +1439,12 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
(org-set-property "DRILL_LAST_REVIEWED"
(time-to-inactive-org-timestamp (current-time))))
quality))
- ((= ch ?e)
+ ((= ch org-drill--edit-key)
'edit)
(t
nil))))
+
;; (defun org-drill-hide-all-subheadings-except (heading-list)
;; "Returns a list containing the position of each immediate subheading of
;; the current topic."
@@ -1238,6 +1465,8 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
;; "" 'tree))
;; (reverse drill-sections)))
+
+
(defun org-drill-hide-subheadings-if (test)
"TEST is a function taking no arguments. TEST will be called for each
of the immediate subheadings of the current drill item, with the point
@@ -1260,11 +1489,13 @@ the current topic."
"" 'tree))
(reverse drill-sections)))
+
(defun org-drill-hide-all-subheadings-except (heading-list)
(org-drill-hide-subheadings-if
(lambda () (let ((drill-heading (org-get-heading t)))
(not (member drill-heading heading-list))))))
+
(defun org-drill-presentation-prompt (&rest fmt-and-args)
(let* ((item-start-time (current-time))
(input nil)
@@ -1279,8 +1510,12 @@ the current topic."
(apply 'format
(first fmt-and-args)
(rest fmt-and-args))
- (concat "Press key for answer, "
- "e=edit, t=tags, s=skip, q=quit."))))
+ (format (concat "Press key for answer, "
+ "%c=edit, %c=tags, %c=skip, %c=quit.")
+ org-drill--edit-key
+ org-drill--tags-key
+ org-drill--skip-key
+ org-drill--quit-key))))
(setq prompt
(format "%s %s %s %s %s %s"
(propertize
@@ -1326,7 +1561,7 @@ You seem to be having a lot of trouble memorising this item.
Consider reformulating the item to make it easier to remember.\n"
'face '(:foreground "red"))
prompt)))
- (while (memq ch '(nil ?t))
+ (while (memq ch '(nil org-drill--tags-key))
(setq ch nil)
(while (not (input-pending-p))
(let ((elapsed (time-subtract (current-time) item-start-time)))
@@ -1337,30 +1572,34 @@ Consider reformulating the item to make it easier to remember.\n"
(sit-for 1)))
(setq input (read-key-sequence nil))
(if (stringp input) (setq ch (elt input 0)))
- (if (eql ch ?t)
+ (if (eql ch org-drill--tags-key)
(org-set-tags-command)))
(case ch
- (?q nil)
- (?e 'edit)
- (?s 'skip)
+ (org-drill--quit-key nil)
+ (org-drill--edit-key 'edit)
+ (org-drill--skip-key 'skip)
(otherwise t))))
+
(defun org-pos-in-regexp (pos regexp &optional nlines)
(save-excursion
(goto-char pos)
(org-in-regexp regexp nlines)))
+
(defun org-drill-hide-region (beg end &optional text)
"Hide the buffer region between BEG and END with an 'invisible text'
visual overlay, or with the string TEXT if it is supplied."
(let ((ovl (make-overlay beg end)))
(overlay-put ovl 'category
'org-drill-hidden-text-overlay)
+ (overlay-put ovl 'priority 9999)
(when (stringp text)
(overlay-put ovl 'invisible nil)
(overlay-put ovl 'face 'default)
(overlay-put ovl 'display text))))
+
(defun org-drill-hide-heading-at-point (&optional text)
(unless (org-at-heading-p)
(error "Point is not on a heading."))
@@ -1369,11 +1608,13 @@ visual overlay, or with the string TEXT if it is supplied."
(end-of-line)
(org-drill-hide-region beg (point) text))))
+
(defun org-drill-hide-comments ()
(save-excursion
(while (re-search-forward "^#.*$" nil t)
(org-drill-hide-region (match-beginning 0) (match-end 0)))))
+
(defun org-drill-unhide-text ()
;; This will also unhide the item's heading.
(save-excursion
@@ -1381,16 +1622,23 @@ visual overlay, or with the string TEXT if it is supplied."
(when (eql 'org-drill-hidden-text-overlay (overlay-get ovl 'category))
(delete-overlay ovl)))))
+
(defun org-drill-hide-clozed-text ()
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
- ;; Don't hide org links, partly because they might contain inline
- ;; images which we want to keep visible
+ ;; Don't hide:
+ ;; - org links, partly because they might contain inline
+ ;; images which we want to keep visible.
+ ;; - LaTeX math fragments
+ ;; - the contents of SRC blocks
(unless (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))
+ (or (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1)
+ (org-in-src-block-p)
+ (org-inside-LaTeX-fragment-p)))
(org-drill-hide-matched-cloze-text)))))
+
(defun org-drill-hide-matched-cloze-text ()
"Hide the current match with a 'cloze' visual overlay."
(let ((ovl (make-overlay (match-beginning 0) (match-end 0)))
@@ -1398,6 +1646,7 @@ visual overlay, or with the string TEXT if it is supplied."
(match-string 0))))
(overlay-put ovl 'category
'org-drill-cloze-overlay-defaults)
+ (overlay-put ovl 'priority 9999)
(when (and hint-sep-pos
(> hint-sep-pos 1))
(let ((hint (substring-no-properties
@@ -1411,6 +1660,7 @@ visual overlay, or with the string TEXT if it is supplied."
(format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]")
hint))))))
+
(defun org-drill-hide-cloze-hints ()
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
@@ -1420,6 +1670,7 @@ visual overlay, or with the string TEXT if it is supplied."
(null (match-beginning 2))) ; hint subexpression matched
(org-drill-hide-region (match-beginning 2) (match-end 2))))))
+
(defmacro with-replaced-entry-text (text &rest body)
"During the execution of BODY, the entire text of the current entry is
concealed by an overlay that displays the string TEXT."
@@ -1430,6 +1681,7 @@ concealed by an overlay that displays the string TEXT."
,@body)
(org-drill-unreplace-entry-text))))
+
(defmacro with-replaced-entry-text-multi (replacements &rest body)
"During the execution of BODY, the entire text of the current entry is
concealed by an overlay that displays the overlays in REPLACEMENTS."
@@ -1440,6 +1692,7 @@ concealed by an overlay that displays the overlays in REPLACEMENTS."
,@body)
(org-drill-unreplace-entry-text))))
+
(defun org-drill-replace-entry-text (text &optional multi-p)
"Make an overlay that conceals the entire text of the item, not
including properties or the contents of subheadings. The overlay shows
@@ -1458,16 +1711,19 @@ Note: does not actually alter the item."
(save-excursion
(outline-next-heading)
(point)))))
+ (overlay-put ovl 'priority 9999)
(overlay-put ovl 'category
'org-drill-replaced-text-overlay)
(overlay-put ovl 'display text)))))
+
(defun org-drill-unreplace-entry-text ()
(save-excursion
(dolist (ovl (overlays-in (point-min) (point-max)))
(when (eql 'org-drill-replaced-text-overlay (overlay-get ovl 'category))
(delete-overlay ovl)))))
+
(defun org-drill-replace-entry-text-multi (replacements)
"Make overlays that conceal the entire text of the item, not
including properties or the contents of subheadings. The overlay shows
@@ -1484,10 +1740,12 @@ Note: does not actually alter the item."
(if (= i (1- (length replacements)))
p-max
(+ p-min (* 2 i) 1))))
+ (overlay-put ovl 'priority 9999)
(overlay-put ovl 'category
'org-drill-replaced-text-overlay)
(overlay-put ovl 'display (nth i replacements)))))
+
(defmacro with-replaced-entry-heading (heading &rest body)
`(progn
(org-drill-replace-entry-heading ,heading)
@@ -1496,18 +1754,21 @@ Note: does not actually alter the item."
,@body)
(org-drill-unhide-text))))
+
(defun org-drill-replace-entry-heading (heading)
"Make an overlay that conceals the heading of the item. The overlay shows
the string TEXT.
Note: does not actually alter the item."
(org-drill-hide-heading-at-point heading))
+
(defun org-drill-unhide-clozed-text ()
(save-excursion
(dolist (ovl (overlays-in (point-min) (point-max)))
(when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category))
(delete-overlay ovl)))))
+
(defun org-drill-get-entry-text (&optional keep-properties-p)
(let ((text (org-agenda-get-some-entry-text (point-marker) 100)))
(if keep-properties-p
@@ -1524,12 +1785,15 @@ Note: does not actually alter the item."
(org-back-to-heading t)
(let ((lim (save-excursion
(outline-next-heading) (point))))
- (org-end-of-meta-data-and-drawers)
+ (if (fboundp 'org-end-of-meta-data-and-drawers)
+ (org-end-of-meta-data-and-drawers) ; function removed Feb 2015
+ (org-end-of-meta-data t))
(or (>= (point) lim)
(null (re-search-forward "[[:graph:]]" lim t))))))
(defun org-drill-entry-empty-p () (org-entry-empty-p))
+
;;; Presentation functions ====================================================
;;
;; Each of these is called with point on topic heading. Each needs to show the
@@ -1539,17 +1803,20 @@ Note: does not actually alter the item."
;; topic, and should return t if the user chose to see the answer and rate their
;; recall, nil if they chose to quit.
+
(defun org-drill-present-simple-card ()
(with-hidden-comments
(with-hidden-cloze-hints
(with-hidden-cloze-text
(org-drill-hide-all-subheadings-except nil)
+ (org-drill--show-latex-fragments) ; overlay all LaTeX fragments with images
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p))))))
+
(defun org-drill-present-default-answer (reschedule-fn)
(cond
(drill-answer
@@ -1561,12 +1828,21 @@ Note: does not actually alter the item."
(t
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text)
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(with-hidden-cloze-hints
(funcall reschedule-fn)))))
+
+(defun org-drill--show-latex-fragments ()
+ (org-remove-latex-fragment-image-overlays)
+ (if (fboundp 'org-toggle-latex-fragment)
+ (org-toggle-latex-fragment '(4))
+ (org-preview-latex-fragment '(4))))
+
+
(defun org-drill-present-two-sided-card ()
(with-hidden-comments
(with-hidden-cloze-hints
@@ -1577,12 +1853,15 @@ Note: does not actually alter the item."
(goto-char (nth (random* (min 2 (length drill-sections)))
drill-sections))
(org-show-subtree)))
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
+
+
(defun org-drill-present-multi-sided-card ()
(with-hidden-comments
(with-hidden-cloze-hints
@@ -1592,12 +1871,14 @@ Note: does not actually alter the item."
(save-excursion
(goto-char (nth (random* (length drill-sections)) drill-sections))
(org-show-subtree)))
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
+
(defun org-drill-present-multicloze-hide-n (number-to-hide
&optional
force-show-first
@@ -1632,7 +1913,8 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
(let ((in-regexp? (save-match-data
(org-pos-in-regexp (match-beginning 0)
org-bracket-link-regexp 1))))
- (unless in-regexp?
+ (unless (or in-regexp?
+ (org-inside-LaTeX-fragment-p))
(incf match-count)))))
(if (minusp number-to-hide)
(setq number-to-hide (+ match-count number-to-hide)))
@@ -1659,8 +1941,9 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
(setq cnt 0)
(while (re-search-forward org-drill-cloze-regexp item-end t)
(unless (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))
+ (or (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1)
+ (org-inside-LaTeX-fragment-p)))
(incf cnt)
(if (memq cnt match-nums)
(org-drill-hide-matched-cloze-text)))))))
@@ -1670,6 +1953,7 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
;; while (org-pos-in-regexp (match-beginning 0)
;; org-bracket-link-regexp 1))
;; (org-drill-hide-matched-cloze-text)))))
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1677,6 +1961,7 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text))))))
+
(defun org-drill-present-multicloze-hide-nth (to-hide)
"Hide the TO-HIDE'th piece of clozed text. 1 is the first piece. If
TO-HIDE is negative, count backwards, so -1 means the last item, -2
@@ -1698,7 +1983,8 @@ the second to last, etc."
(let ((in-regexp? (save-match-data
(org-pos-in-regexp (match-beginning 0)
org-bracket-link-regexp 1))))
- (unless in-regexp?
+ (unless (or in-regexp?
+ (org-inside-LaTeX-fragment-p))
(incf match-count)))))
(if (minusp to-hide)
(setq to-hide (+ 1 to-hide match-count)))
@@ -1712,11 +1998,16 @@ the second to last, etc."
(setq cnt 0)
(while (re-search-forward org-drill-cloze-regexp item-end t)
(unless (save-match-data
- (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1))
+ ;; Don't consider this a cloze region if it is part of an
+ ;; org link, or if it occurs inside a LaTeX math
+ ;; fragment
+ (or (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1)
+ (org-inside-LaTeX-fragment-p)))
(incf cnt)
(if (= cnt to-hide)
(org-drill-hide-matched-cloze-text)))))))
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1724,24 +2015,29 @@ the second to last, etc."
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text))))))
+
(defun org-drill-present-multicloze-hide1 ()
"Hides one of the pieces of text that are marked for cloze deletion,
chosen at random."
(org-drill-present-multicloze-hide-n 1))
+
(defun org-drill-present-multicloze-hide2 ()
"Hides two of the pieces of text that are marked for cloze deletion,
chosen at random."
(org-drill-present-multicloze-hide-n 2))
+
(defun org-drill-present-multicloze-hide-first ()
"Hides the first piece of text that is marked for cloze deletion."
(org-drill-present-multicloze-hide-nth 1))
+
(defun org-drill-present-multicloze-hide-last ()
"Hides the last piece of text that is marked for cloze deletion."
(org-drill-present-multicloze-hide-nth -1))
+
(defun org-drill-present-multicloze-hide1-firstmore ()
"Commonly, hides the FIRST piece of text that is marked for
cloze deletion. Uncommonly, hide one of the other pieces of text,
@@ -1771,6 +2067,7 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, hide first item
(org-drill-present-multicloze-hide-first))))
+
(defun org-drill-present-multicloze-show1-lastmore ()
"Commonly, hides all pieces except the last. Uncommonly, shows
any random piece. The effect is similar to 'show1cloze' except
@@ -1795,6 +2092,7 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, show the LAST item
(org-drill-present-multicloze-hide-n -1 nil t))))
+
(defun org-drill-present-multicloze-show1-firstless ()
"Commonly, hides all pieces except one, where the shown piece
is guaranteed NOT to be the first piece. Uncommonly, shows any
@@ -1820,49 +2118,19 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, show any item, except the first
(org-drill-present-multicloze-hide-n -1 nil nil t))))
+
(defun org-drill-present-multicloze-show1 ()
"Similar to `org-drill-present-multicloze-hide1', but hides all
the pieces of text that are marked for cloze deletion, except for one
piece which is chosen at random."
(org-drill-present-multicloze-hide-n -1))
+
(defun org-drill-present-multicloze-show2 ()
"Similar to `org-drill-present-multicloze-show1', but reveals two
pieces rather than one."
(org-drill-present-multicloze-hide-n -2))
-;; (defun org-drill-present-multicloze-show1 ()
-;; "Similar to `org-drill-present-multicloze-hide1', but hides all
-;; the pieces of text that are marked for cloze deletion, except for one
-;; piece which is chosen at random."
-;; (with-hidden-comments
-;; (with-hidden-cloze-hints
-;; (let ((item-end nil)
-;; (match-count 0)
-;; (body-start (or (cdr (org-get-property-block))
-;; (point))))
-;; (org-drill-hide-all-subheadings-except nil)
-;; (save-excursion
-;; (outline-next-heading)
-;; (setq item-end (point)))
-;; (save-excursion
-;; (goto-char body-start)
-;; (while (re-search-forward org-drill-cloze-regexp item-end t)
-;; (incf match-count)))
-;; (when (plusp match-count)
-;; (let ((match-to-hide (random* match-count)))
-;; (save-excursion
-;; (goto-char body-start)
-;; (dotimes (n match-count)
-;; (re-search-forward org-drill-cloze-regexp
-;; item-end t)
-;; (unless (= n match-to-hide)
-;; (org-drill-hide-matched-cloze-text))))))
-;; (org-display-inline-images t)
-;; (org-cycle-hide-drawers 'all)
-;; (prog1 (org-drill-presentation-prompt)
-;; (org-drill-hide-subheadings-if 'org-drill-entry-p)
-;; (org-drill-unhide-clozed-text))))))
(defun org-drill-present-card-using-text (question &optional answer)
"Present the string QUESTION as the only visible content of the card.
@@ -1878,6 +2146,7 @@ If ANSWER is supplied, set the global variable `drill-answer' to its value."
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))
+
(defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
"TEXTS is a list of valid values for the 'display' text property.
Present these overlays, in sequence, as the only
@@ -1894,6 +2163,7 @@ If ANSWER is supplied, set the global variable `drill-answer' to its value."
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))
+
(defun org-drill-entry ()
"Present the current topic for interactive review, as in `org-drill'.
Review will occur regardless of whether the topic is due for review or whether
@@ -1911,7 +2181,7 @@ See `org-drill' for more details."
;; (error "Point is not inside a drill entry"))
;;(unless (org-at-heading-p)
;; (org-back-to-heading))
- (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
+ (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" t))
(answer-fn 'org-drill-present-default-answer)
(present-empty-cards nil)
(cont nil)
@@ -1932,26 +2202,29 @@ See `org-drill' for more details."
'org-drill-present-default-answer)
present-empty-cards (third presentation-fn)
presentation-fn (first presentation-fn)))
- (cond
- ((null presentation-fn)
- (message "%s:%d: Unrecognised card type '%s', skipping..."
- (buffer-name) (point) card-type)
- (sit-for 0.5)
- 'skip)
- (t
- (setq cont (funcall presentation-fn))
- (cond
- ((not cont)
- (message "Quit")
- nil)
- ((eql cont 'edit)
- 'edit)
- ((eql cont 'skip)
- 'skip)
- (t
- (save-excursion
- (funcall answer-fn
- (lambda () (org-drill-reschedule)))))))))))))
+ (prog1
+ (cond
+ ((null presentation-fn)
+ (message "%s:%d: Unrecognised card type '%s', skipping..."
+ (buffer-name) (point) card-type)
+ (sit-for 0.5)
+ 'skip)
+ (t
+ (setq cont (funcall presentation-fn))
+ (cond
+ ((not cont)
+ (message "Quit")
+ nil)
+ ((eql cont 'edit)
+ 'edit)
+ ((eql cont 'skip)
+ 'skip)
+ (t
+ (save-excursion
+ (funcall answer-fn
+ (lambda () (org-drill-reschedule))))))))
+ (org-remove-latex-fragment-image-overlays)))))))
+
(defun org-drill-entries-pending-p ()
(or *org-drill-again-entries*
@@ -1965,6 +2238,7 @@ See `org-drill' for more details."
*org-drill-overdue-entries*
*org-drill-again-entries*))))
+
(defun org-drill-pending-entry-count ()
(+ (if (markerp *org-drill-current-item*) 1 0)
(length *org-drill-new-entries*)
@@ -1974,6 +2248,7 @@ See `org-drill' for more details."
(length *org-drill-overdue-entries*)
(length *org-drill-again-entries*)))
+
(defun org-drill-maximum-duration-reached-p ()
"Returns true if the current drill session has continued past its
maximum duration."
@@ -1983,6 +2258,7 @@ maximum duration."
(> (- (float-time (current-time)) *org-drill-start-time*)
(* org-drill-maximum-duration 60))))
+
(defun org-drill-maximum-item-count-reached-p ()
"Returns true if the current drill session has reached the
maximum number of items."
@@ -1991,6 +2267,7 @@ maximum number of items."
(>= (length *org-drill-done-entries*)
org-drill-maximum-items-per-session)))
+
(defun org-drill-pop-next-pending-entry ()
(block org-drill-pop-next-pending-entry
(let ((m nil))
@@ -2038,6 +2315,7 @@ maximum number of items."
(return-from org-drill-pop-next-pending-entry nil)))))
m)))
+
(defun org-drill-entries (&optional resuming-p)
"Returns nil, t, or a list of markers representing entries that were
'failed' and need to be presented again before the session ends.
@@ -2090,6 +2368,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
(push m *org-drill-done-entries*)))
(setq *org-drill-current-item* nil))))))))))
+
+
(defun org-drill-final-report ()
(let ((pass-percent
(round (* 100 (count-if (lambda (qual)
@@ -2176,7 +2456,10 @@ order to make items appear more frequently over time."
*org-drill-overdue-entry-count*
(round (* 100 *org-drill-overdue-entry-count*)
(+ *org-drill-dormant-entry-count*
- *org-drill-due-entry-count*)))))))
+ *org-drill-due-entry-count*)))
+ ))))
+
+
(defun org-drill-free-markers (markers)
"MARKERS is a list of markers, all of which will be freed (set to
@@ -2194,17 +2477,57 @@ all the markers used by Org-Drill will be freed."
(free-marker m)))
+;;; overdue-data is a list of entries, each entry has the form (POS DUE AGE)
+;;; where POS is a marker pointing to the start of the entry, and
+;;; DUE is a number indicating how many days ago the entry was due.
+;;; AGE is the number of days elapsed since item creation (nil if unknown).
+;;; if age > lapse threshold (default 90), sort by age (oldest first)
+;;; if age < lapse threshold, sort by due (biggest first)
+
+
(defun org-drill-order-overdue-entries (overdue-data)
- (setq *org-drill-overdue-entries*
- (mapcar 'car
- (sort (shuffle-list overdue-data)
- (lambda (a b) (> (cdr a) (cdr b)))))))
+ (let* ((lapsed-days (if org-drill--lapse-very-overdue-entries-p
+ 90 most-positive-fixnum))
+ (not-lapsed (remove-if (lambda (a) (> (or (second a) 0) lapsed-days))
+ overdue-data))
+ (lapsed (remove-if-not (lambda (a) (> (or (second a) 0)
+ lapsed-days)) overdue-data)))
+ (setq *org-drill-overdue-entries*
+ (mapcar 'first
+ (append
+ (sort (shuffle-list not-lapsed)
+ (lambda (a b) (> (second a) (second b))))
+ (sort lapsed
+ (lambda (a b) (> (third a) (third b)))))))))
+
+
+(defun org-drill--entry-lapsed-p ()
+ (let ((lapsed-days 90))
+ (and org-drill--lapse-very-overdue-entries-p
+ (> (or (org-drill-entry-days-overdue) 0) lapsed-days))))
+
+
+
+
+(defun org-drill-entry-days-since-creation (&optional use-last-interval-p)
+ "If USE-LAST-INTERVAL-P is non-nil, and DATE_ADDED is missing, use the
+value of DRILL_LAST_INTERVAL instead (as the item's age must be at least
+that many days)."
+ (let ((timestamp (org-entry-get (point) "DATE_ADDED")))
+ (cond
+ (timestamp
+ (- (org-time-stamp-to-now timestamp)))
+ (use-last-interval-p
+ (+ (or (org-drill-entry-days-overdue) 0)
+ (read (or (org-entry-get (point) "DRILL_LAST_INTERVAL") "0"))))
+ (t nil))))
(defun org-drill-entry-status ()
- "Returns a list (STATUS DUE) where DUE is the number of days overdue,
-zero being due today, -1 being scheduled 1 day in the future. STATUS is
-one of the following values:
+ "Returns a list (STATUS DUE AGE) where DUE is the number of days overdue,
+zero being due today, -1 being scheduled 1 day in the future.
+AGE is the number of days elapsed since the item was created (nil if unknown).
+STATUS is one of the following values:
- nil, if the item is not a drill entry, or has an empty body
- :unscheduled
- :future
@@ -2218,6 +2541,7 @@ one of the following values:
(unless (org-at-heading-p)
(org-back-to-heading))
(let ((due (org-drill-entry-days-overdue))
+ (age (org-drill-entry-days-since-creation t))
(last-int (org-drill-entry-last-interval 1)))
(list
(cond
@@ -2256,7 +2580,7 @@ one of the following values:
:young)
(t
:old))
- due))))
+ due age))))
(defun org-drill-progress-message (collected scanned)
@@ -2265,14 +2589,58 @@ one of the following values:
(sym1 (if (oddp (floor scanned (* 50 meter-width))) ?| ?.))
(sym2 (if (eql sym1 ?.) ?| ?.)))
(message "Collecting due drill items:%4d %s%s"
- collected
- (make-string (% (ceiling scanned 50) meter-width)
- sym2)
- (make-string (- meter-width (% (ceiling scanned 50) meter-width))
- sym1)))))
-
-
-(defun org-drill (&optional scope resume-p)
+ collected
+ (make-string (% (ceiling scanned 50) meter-width)
+ sym2)
+ (make-string (- meter-width (% (ceiling scanned 50) meter-width))
+ sym1)))))
+
+
+(defun org-map-drill-entry-function ()
+ (org-drill-progress-message
+ (+ (length *org-drill-new-entries*)
+ (length *org-drill-overdue-entries*)
+ (length *org-drill-young-mature-entries*)
+ (length *org-drill-old-mature-entries*)
+ (length *org-drill-failed-entries*))
+ (incf cnt))
+ (cond
+ ((not (org-drill-entry-p))
+ nil) ; skip
+ (t
+ (when (and (not warned-about-id-creation)
+ (null (org-id-get)))
+ (message (concat "Creating unique IDs for items "
+ "(slow, but only happens once)"))
+ (sit-for 0.5)
+ (setq warned-about-id-creation t))
+ (org-id-get-create) ; ensure drill entry has unique ID
+ (destructuring-bind (status due age)
+ (org-drill-entry-status)
+ (case status
+ (:unscheduled
+ (incf *org-drill-dormant-entry-count*))
+ ;; (:tomorrow
+ ;; (incf *org-drill-dormant-entry-count*)
+ ;; (incf *org-drill-due-tomorrow-count*))
+ (:future
+ (incf *org-drill-dormant-entry-count*)
+ (if (eq -1 due)
+ (incf *org-drill-due-tomorrow-count*)))
+ (:new
+ (push (point-marker) *org-drill-new-entries*))
+ (:failed
+ (push (point-marker) *org-drill-failed-entries*))
+ (:young
+ (push (point-marker) *org-drill-young-mature-entries*))
+ (:overdue
+ (push (list (point-marker) due age) overdue-data))
+ (:old
+ (push (point-marker) *org-drill-old-mature-entries*))
+ )))))
+
+
+(defun org-drill (&optional scope drill-match resume-p)
"Begin an interactive 'drill session'. The user is asked to
review a series of topics (headers). Each topic is initially
presented as a 'question', often with part of the topic content
@@ -2300,10 +2668,24 @@ SCOPE determines the scope in which to search for
questions. It accepts the same values as `org-drill-scope',
which see.
+DRILL-MATCH, if supplied, is a string specifying a tags/property/
+todo query. Only items matching the query will be considered.
+It accepts the same values as `org-drill-match', which see.
+
If RESUME-P is non-nil, resume a suspended drill session rather
than starting a new one."
(interactive)
+ ;; Check org version. Org 7.9.3f introduced a backwards-incompatible change
+ ;; to the arguments accepted by `org-schedule'. At the time of writing there
+ ;; are still lots of people using versions of org older than this.
+ (let ((majorv (first (mapcar 'string-to-number (split-string (org-release) "[.]")))))
+ (if (and (< majorv 8)
+ (not (string-match-p "universal prefix argument" (documentation 'org-schedule))))
+ (read-char-exclusive
+ (format "Warning: org-drill requires org mode 7.9.3f or newer. Scheduling of failed cards will not
+work correctly with older versions of org mode. Your org mode version (%s) appears to be older than
+7.9.3f. Please consider installing a more recent version of org mode." (org-release)))))
(let ((end-pos nil)
(overdue-data nil)
(cnt 0))
@@ -2331,48 +2713,8 @@ than starting a new one."
(let ((org-trust-scanner-tags t)
(warned-about-id-creation nil))
(org-map-drill-entries
- (lambda ()
- (org-drill-progress-message
- (+ (length *org-drill-new-entries*)
- (length *org-drill-overdue-entries*)
- (length *org-drill-young-mature-entries*)
- (length *org-drill-old-mature-entries*)
- (length *org-drill-failed-entries*))
- (incf cnt))
- (cond
- ((not (org-drill-entry-p))
- nil) ; skip
- (t
- (when (and (not warned-about-id-creation)
- (null (org-id-get)))
- (message (concat "Creating unique IDs for items "
- "(slow, but only happens once)"))
- (sit-for 0.5)
- (setq warned-about-id-creation t))
- (org-id-get-create) ; ensure drill entry has unique ID
- (destructuring-bind (status due) (org-drill-entry-status)
- (case status
- (:unscheduled
- (incf *org-drill-dormant-entry-count*))
- ;; (:tomorrow
- ;; (incf *org-drill-dormant-entry-count*)
- ;; (incf *org-drill-due-tomorrow-count*))
- (:future
- (incf *org-drill-dormant-entry-count*)
- (if (eq -1 due)
- (incf *org-drill-due-tomorrow-count*)))
- (:new
- (push (point-marker) *org-drill-new-entries*))
- (:failed
- (push (point-marker) *org-drill-failed-entries*))
- (:young
- (push (point-marker) *org-drill-young-mature-entries*))
- (:overdue
- (push (cons (point-marker) due) overdue-data))
- (:old
- (push (point-marker) *org-drill-old-mature-entries*))
- )))))
- scope)
+ 'org-map-drill-entry-function
+ scope drill-match)
(org-drill-order-overdue-entries overdue-data)
(setq *org-drill-overdue-entry-count*
(length *org-drill-overdue-entries*))))
@@ -2409,23 +2751,22 @@ than starting a new one."
(org-drill-save-optimal-factor-matrix))
(if org-drill-save-buffers-after-drill-sessions-p
(save-some-buffers))
- (message "Drill session finished!")))))
+ (message "Drill session finished!")
+ ))))
(defun org-drill-save-optimal-factor-matrix ()
- (message "Saving optimal factor matrix...")
- (customize-save-variable 'org-drill-optimal-factor-matrix
- org-drill-optimal-factor-matrix))
+ (savehist-autosave))
-(defun org-drill-cram (&optional scope)
+(defun org-drill-cram (&optional scope drill-match)
"Run an interactive drill session in 'cram mode'. In cram mode,
all drill items are considered to be due for review, unless they
have been reviewed within the last `org-drill-cram-hours'
hours."
(interactive)
(setq *org-drill-cram-mode* t)
- (org-drill scope))
+ (org-drill scope drill-match))
(defun org-drill-tree ()
@@ -2442,7 +2783,7 @@ files in the same directory as the current file."
(org-drill 'directory))
-(defun org-drill-again (&optional scope)
+(defun org-drill-again (&optional scope drill-match)
"Run a new drill session, but try to use leftover due items that
were not reviewed during the last session, rather than scanning for
unreviewed items. If there are no leftover items in memory, a full
@@ -2457,9 +2798,9 @@ scan will be performed."
(setq *org-drill-start-time* (float-time (current-time))
*org-drill-done-entries* nil
*org-drill-current-item* nil)
- (org-drill scope t))
+ (org-drill scope drill-match t))
(t
- (org-drill scope))))
+ (org-drill scope drill-match))))
@@ -2469,7 +2810,7 @@ exiting them with the `edit' or `quit' options."
(interactive)
(cond
((org-drill-entries-pending-p)
- (org-drill nil t))
+ (org-drill nil nil t))
((and (plusp (org-drill-pending-entry-count))
;; Current drill session is finished, but there are still
;; more items which need to be reviewed.
@@ -2482,10 +2823,18 @@ need reviewing. Start a new drill session? "
(message "You have finished the drill session."))))
+(defun org-drill-relearn-item ()
+ "Make the current item due for revision, and set its last interval to 0.
+Makes the item behave as if it has been failed, without actually recording a
+failure. This command can be used to 'reset' repetitions for an item."
+ (interactive)
+ (org-drill-smart-reschedule 4 0))
+
+
(defun org-drill-strip-entry-data ()
(dolist (prop org-drill-scheduling-properties)
(org-delete-property prop))
- (org-schedule t))
+ (org-schedule '(4)))
(defun org-drill-strip-all-data (&optional scope)
@@ -2503,22 +2852,41 @@ values as `org-drill-scope'."
;; `org-delete-property-globally', which is faster.
(dolist (prop org-drill-scheduling-properties)
(org-delete-property-globally prop))
- (org-map-drill-entries (lambda () (org-schedule t)) scope))
+ (org-map-drill-entries (lambda () (org-schedule '(4))) scope))
(t
(org-map-drill-entries 'org-drill-strip-entry-data scope)))
(message "Done.")))
-
(defun org-drill-add-cloze-fontification ()
+ ;; Compute local versions of the regexp for cloze deletions, in case
+ ;; the left and right delimiters are redefined locally.
+ (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp))
+ (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
(when org-drill-use-visible-cloze-face-p
- (font-lock-add-keywords 'org-mode
- org-drill-cloze-keywords
- nil)))
-
-(add-hook 'org-mode-hook 'org-drill-add-cloze-fontification)
-
-(org-drill-add-cloze-fontification)
+ (add-to-list 'org-font-lock-extra-keywords
+ (first org-drill-cloze-keywords))))
+
+
+;; Can't add to org-mode-hook, because local variables won't have been loaded
+;; yet.
+
+;; (defun org-drill-add-cloze-fontification ()
+;; (when (eql major-mode 'org-mode)
+;; ;; Compute local versions of the regexp for cloze deletions, in case
+;; ;; the left and right delimiters are redefined locally.
+;; (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp))
+;; (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
+;; (when org-drill-use-visible-cloze-face-p
+;; (font-lock-add-keywords nil ;'org-mode
+;; org-drill-cloze-keywords
+;; nil))))
+
+;; XXX
+;; (add-hook 'hack-local-variables-hook
+;; 'org-drill-add-cloze-fontification)
+;;
+;; (org-drill-add-cloze-fontification)
;;; Synching card collections =================================================
@@ -2534,18 +2902,18 @@ the tag 'imported'."
(save-excursion
(let ((src (current-buffer))
(m nil))
- (flet ((paste-tree-here (&optional level)
- (org-paste-subtree level)
- (org-drill-strip-entry-data)
- (org-toggle-tag "imported" 'on)
- (org-map-drill-entries
- (lambda ()
- (let ((id (org-id-get)))
- (org-drill-strip-entry-data)
- (unless (gethash id *org-drill-dest-id-table*)
- (puthash id (point-marker)
- *org-drill-dest-id-table*))))
- 'tree)))
+ (cl-flet ((paste-tree-here (&optional level)
+ (org-paste-subtree level)
+ (org-drill-strip-entry-data)
+ (org-toggle-tag "imported" 'on)
+ (org-map-drill-entries
+ (lambda ()
+ (let ((id (org-id-get)))
+ (org-drill-strip-entry-data)
+ (unless (gethash id *org-drill-dest-id-table*)
+ (puthash id (point-marker)
+ *org-drill-dest-id-table*))))
+ 'tree)))
(unless path
(setq path (org-get-outline-path)))
(org-copy-subtree)
@@ -2569,7 +2937,9 @@ the tag 'imported'."
(outline-next-heading)
(newline)
(forward-line -1)
- (paste-tree-here (1+ (or (org-current-level) 0))))))))
+ (paste-tree-here (1+ (or (org-current-level) 0)))
+ )))))
+
(defun org-drill-merge-buffers (src &optional dest ignore-new-items-p)
@@ -2662,12 +3032,15 @@ copy them across."
(free-marker m))
*org-drill-dest-id-table*))))
+
+
;;; Card types for learning languages =========================================
;;; Get spell-number.el from:
;;; http://www.emacswiki.org/emacs/spell-number.el
(autoload 'spelln-integer-in-words "spell-number")
+
;;; `conjugate' card type =====================================================
;;; See spanish.org for usage
@@ -2730,15 +3103,15 @@ the name of the tense.")
(defun org-drill-present-verb-conjugation ()
"Present a drill entry whose card type is 'conjugate'."
- (flet ((tense-and-mood-to-string
- (tense mood)
- (cond
- ((and tense mood)
- (format "%s tense, %s mood" tense mood))
- (tense
- (format "%s tense" tense))
- (mood
- (format "%s mood" mood)))))
+ (cl-flet ((tense-and-mood-to-string
+ (tense mood)
+ (cond
+ ((and tense mood)
+ (format "%s tense, %s mood" tense mood))
+ (tense
+ (format "%s tense" tense))
+ (mood
+ (format "%s mood" mood)))))
(destructuring-bind (infinitive inf-hint translation tense mood)
(org-drill-get-verb-conjugation-info)
(org-drill-present-card-using-text
@@ -2919,6 +3292,7 @@ returns its return value."
'face highlight-face))
(spelln-integer-in-language drilled-number language))))))))
+
;; (defun org-drill-show-answer-translate-number (reschedule-fn)
;; (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
;; (highlight-face 'font-lock-warning-face)
diff --git a/contrib/lisp/org-ebib.el b/contrib/lisp/org-ebib.el
new file mode 100644
index 0000000..2136a13
--- /dev/null
+++ b/contrib/lisp/org-ebib.el
@@ -0,0 +1,47 @@
+;;; org-ebib.el - Support for links to Ebib's entries in Org
+;;
+;; Author: Grégoire Jadi <daimrod@gmail.com>
+;;
+;; This file is not yet 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, 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:
+
+(require 'org)
+
+(org-add-link-type "ebib" 'org-ebib-open)
+
+(add-hook 'org-store-link-functions 'org-ebib-store-link)
+
+(defun org-ebib-open (key)
+ "Open Ebib and jump to KEY."
+ (ebib nil key))
+
+(defun org-ebib-store-link ()
+ "Store a key to an Ebib entry."
+ (when (memq major-mode '(ebib-index-mode ebib-entry-mode))
+ ;; This is an Ebib entry
+ (let* ((key (ebib-cur-entry-key))
+ (link (concat "ebib:" key))
+ (description (ignore-errors (ebib-db-get-field-value 'title key ebib-cur-db))))
+ (org-store-link-props
+ :type "ebib"
+ :link link
+ :description description))))
+
+(provide 'org-ebib)
+
+;;; org-ebib.el ends here
diff --git a/contrib/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el
new file mode 100644
index 0000000..0d830ab
--- /dev/null
+++ b/contrib/lisp/org-effectiveness.el
@@ -0,0 +1,298 @@
+;;; org-effectiveness.el --- Measuring the personal effectiveness
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: David Arroyo Menéndez <davidam@es.gnu.org>
+;; Keywords: effectiveness, plot
+;; Homepage: http://orgmode.org
+;;
+;; This file is not part of GNU Emacs, yet.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements functions to measure the effectiveness in org.
+;; Org-mode doesn't load this module by default - if this is not what
+;; you want, configure the variable `org-modules'. Thanks to #emacs-es
+;; irc channel for your support.
+
+;;; Code:
+
+(require 'org)
+
+(defcustom org-effectiveness-max-todo 50
+ "This variable is useful to advice to the user about
+many TODO pending"
+ :type 'integer
+ :group 'org-effectiveness)
+
+(defun org-effectiveness-advice()
+ "Advicing about a possible excess of TODOS"
+ (interactive)
+ (goto-char (point-min))
+ (if (< org-effectiveness-max-todo (count-matches "* TODO"))
+ (message "An excess of TODOS!")))
+
+;; Check advice starting an org file
+(add-hook 'org-mode-hook 'org-effectiveness-advice)
+
+(defun org-effectiveness-count-keyword(keyword)
+ "Print a message with the number of keyword outline in the current buffer"
+ (interactive "sKeyword: ")
+ (save-excursion
+ (goto-char (point-min))
+ (message "Number of %s: %d" keyword (count-matches (concat "* " keyword)))))
+
+(defun org-effectiveness-count-todo()
+ "Print a message with the number of todo tasks in the current buffer"
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (message "Number of TODO: %d" (count-matches "* TODO"))))
+
+(defun org-effectiveness-count-done()
+ "Print a message with the number of done tasks in the current buffer"
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (message "Number of DONE: %d" (count-matches "* DONE"))))
+
+(defun org-effectiveness-count-canceled()
+ "Print a message with the number of canceled tasks in the current buffer"
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (message "Number of Canceled: %d" (count-matches "* CANCEL+ED"))))
+
+(defun org-effectiveness()
+ "Returns the effectiveness in the current org buffer"
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((done (float (count-matches "* DONE.*\n.*")))
+ (canc (float (count-matches "* CANCEL+ED.*\n.*"))))
+ (if (and (= done canc) (zerop done))
+ (setq effectiveness 0)
+ (setq effectiveness (* 100 (/ done (+ done canc)))))
+ (message "Effectiveness: %f" effectiveness))))
+
+(defun org-effectiveness-keywords-in-date(keyword date)
+ (interactive "sKeyword: \nsDate: " keyword date)
+ (setq count (count-matches (concat keyword ".*\n.*" date)))
+ (message (concat "%sS: %d" keyword count)))
+
+(defun org-effectiveness-dones-in-date(date)
+ (interactive "sGive me a date: " date)
+ (setq count (count-matches (concat "DONE.*\n.*" date)))
+ (message "DONES: %d" count))
+
+(defun org-effectivenes-todos-in-date(date)
+ (interactive "sGive me a date: " date)
+ (setq count (count-matches (concat "TODO.*\n.*" date)))
+ (message "TODOS: %d" count))
+
+(defun org-effectiveness-canceled-in-date(date)
+ (interactive "sGive me a date: " date)
+ (setq count (count-matches (concat "CANCEL+ED.*\n.*" date)))
+ (message "CANCELEDS: %d" count))
+
+(defun org-effectiveness-in-date(date &optional notmessage)
+ (interactive "sGive me a date: " date)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((done (float (count-matches (concat "* DONE.*\n.*" date))))
+ (canc (float (count-matches (concat "* CANCEL+ED.*\n.*" date)))))
+ (if (and (= done canc) (zerop done))
+ (setq effectiveness 0)
+ (setq effectiveness (* 100 (/ done (+ done canc)))))
+ (if (eq notmessage 1)
+ (message "%d" effectiveness)
+ (message "Effectiveness: %d " effectiveness)))))
+
+(defun org-effectiveness-month-to-string (m)
+ (if (< m 10)
+ (concat "0" (number-to-string m))
+ (number-to-string m)))
+
+(defun org-effectiveness-plot(startdate enddate &optional save)
+ (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
+ (setq dates (org-effectiveness-check-dates startdate enddate))
+ (setq syear (cadr (assoc 'startyear dates)))
+ (setq smonth (cadr (assoc 'startmonth dates)))
+ (setq eyear (cadr (assoc 'endyear dates)))
+ (setq emonth (assoc 'endmonth dates))
+;; Checking the format of the dates
+ (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate))
+ (message "The start date must have the next format YYYY-MM"))
+ (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate))
+ (message "The end date must have the next format YYYY-MM"))
+;; Checking if startdate < enddate
+ (if (string-match "^[0-9][0-9][0-9][0-9]" startdate)
+ (setq startyear (string-to-number (match-string 0 startdate))))
+ (if (string-match "[0-9][0-9]$" startdate)
+ (setq startmonth (string-to-number (match-string 0 startdate))))
+ (if (string-match "^[0-9][0-9][0-9][0-9]" enddate)
+ (setq endyear (string-to-number (match-string 0 enddate))))
+ (if (string-match "[0-9][0-9]$" enddate)
+ (setq endmonth (string-to-number (match-string 0 enddate))))
+ (if (> startyear endyear)
+ (message "The start date must be before that end date"))
+ (if (and (= startyear endyear) (> startmonth endmonth))
+ (message "The start date must be before that end date"))
+;; Create a file
+ (let ((month startmonth)
+ (year startyear)
+ (str ""))
+ (while (or (> endyear year) (and (= endyear year) (>= endmonth month)))
+ (setq str (concat str (number-to-string year) "-" (org-effectiveness-month-to-string month) " " (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1) "\n"))
+ (if (= month 12)
+ (progn
+ (setq year (+ 1 year))
+ (setq month 1))
+ (setq month (+ 1 month))))
+ (write-region str nil "/tmp/org-effectiveness"))
+;; Create the bar graph
+ (if (eq save t)
+ (setq strplot "/usr/bin/gnuplot -e 'set term png; set output \"/tmp/org-effectiveness.png\"; plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p")
+ (setq strplot "/usr/bin/gnuplot -e 'plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p"))
+ (if (file-exists-p "/usr/bin/gnuplot")
+ (call-process "/bin/bash" nil t nil "-c" strplot)
+ (message "gnuplot is not installed")))
+
+(defun org-effectiveness-plot-save(startdate enddate &optional save)
+ (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
+ (org-effectiveness-plot startdate enddate t))
+
+;; (defun org-effectiveness-plot(startdate enddate)
+
+
+(defun org-effectiveness-ascii-bar(n &optional label)
+ "Print a bar with the percentage from 0 to 100 printed in ascii"
+ (interactive "nPercentage: \nsLabel: ")
+ (if (or (< n 0) (> n 100))
+ (message "The percentage must be between 0 to 100")
+ (let ((x 0)
+ (y 0)
+ (z 0))
+ (insert (format "\n### %s ###" label))
+ (insert "\n-")
+ (while (< x n)
+ (insert "-")
+ (setq x (+ x 1)))
+ (insert "+\n")
+ (insert (format "%d" n))
+ (if (> n 10)
+ (setq y (+ y 1)))
+ (while (< y n)
+ (insert " ")
+ (setq y (+ y 1)))
+ (insert "|\n")
+ (insert "-")
+ (while (< z n)
+ (insert "-")
+ (setq z (+ z 1)))
+ (insert "+"))))
+
+(defun org-effectiveness-html-bar(n &optional label)
+ "Print a bar with the percentage from 0 to 100 printed in html"
+ (interactive "nPercentage: \nsLabel: ")
+ (if (or (< n 0) (> n 100))
+ (message "The percentage must be between 0 to 100")
+ (let ((x 0)
+ (y 0)
+ (z 0))
+ (insert (format "\n<div class='percentage-%d'>%d</div>" n n))
+)))
+
+
+(defun org-effectiveness-check-dates (startdate enddate)
+ "Generate a list with ((startyear startmonth) (endyear endmonth))"
+ (setq str nil)
+ (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate))
+ (setq str "The start date must have the next format YYYY-MM"))
+ (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate))
+ (setq str "The end date must have the next format YYYY-MM"))
+;; Checking if startdate < enddate
+ (if (string-match "^[0-9][0-9][0-9][0-9]" startdate)
+ (setq startyear (string-to-number (match-string 0 startdate))))
+ (if (string-match "[0-9][0-9]$" startdate)
+ (setq startmonth (string-to-number (match-string 0 startdate))))
+ (if (string-match "^[0-9][0-9][0-9][0-9]" enddate)
+ (setq endyear (string-to-number (match-string 0 enddate))))
+ (if (string-match "[0-9][0-9]$" enddate)
+ (setq endmonth (string-to-number (match-string 0 enddate))))
+ (if (> startyear endyear)
+ (setq str "The start date must be before that end date"))
+ (if (and (= startyear endyear) (> startmonth endmonth))
+ (setq str "The start date must be before that end date"))
+ (if str
+ (message str)
+;; (list (list startyear startmonth) (list endyear endmonth))))
+ (list (list 'startyear startyear) (list 'startmonth startmonth) (list 'endyear endyear) (list 'endmonth endmonth))))
+
+(defun org-effectiveness-plot-ascii (startdate enddate)
+ (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
+ (setq dates (org-effectiveness-check-dates startdate enddate))
+ (let ((syear (cadr (assoc 'startyear dates)))
+ (smonth (cadr (assoc 'startmonth dates)))
+ (year (cadr (assoc 'startyear dates)))
+ (month (cadr (assoc 'startmonth dates)))
+ (emonth (cadr (assoc 'endmonth dates)))
+ (eyear (cadr (assoc 'endyear dates)))
+ (buffer (current-buffer))
+ (str ""))
+ (while (or (> eyear year) (and (= eyear year) (>= emonth month)))
+ (setq str (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
+ (switch-to-buffer "*org-effectiveness*")
+ (org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month))
+ (switch-to-buffer buffer)
+ (if (eq month 12)
+ (progn
+ (setq year (+ 1 year))
+ (setq month 1))
+ (setq month (+ 1 month)))))
+ (switch-to-buffer "*org-effectiveness*"))
+
+(defun org-effectiveness-plot-html (startdate enddate)
+ "Print html bars about the effectiveness in a buffer"
+ (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
+ (setq dates (org-effectiveness-check-dates startdate enddate))
+ (let ((syear (cadr (assoc 'startyear dates)))
+ (smonth (cadr (assoc 'startmonth dates)))
+ (year (cadr (assoc 'startyear dates)))
+ (month (cadr (assoc 'startmonth dates)))
+ (emonth (cadr (assoc 'endmonth dates)))
+ (eyear (cadr (assoc 'endyear dates)))
+ (buffer (current-buffer))
+ (str ""))
+ (switch-to-buffer "*org-effectiveness-html*")
+ (insert "<html><head><title>Graphbar</title><meta http-equiv='Content-type' content='text/html; charset=utf-8'><link rel='stylesheet' type='text/css' href='graphbar.css' title='graphbar'></head><body>")
+ (while (or (> eyear year) (and (= eyear year) (>= emonth month)))
+ (setq str (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
+ (switch-to-buffer "*org-effectiveness-html*")
+ (org-effectiveness-html-bar (string-to-number str) (format "%s-%s" year month))
+ (switch-to-buffer buffer)
+ (format "%s-%s" year month)
+ (if (eq month 12)
+ (progn
+ (setq year (+ 1 year))
+ (setq month 1))
+ (setq month (+ 1 month))))
+ (switch-to-buffer "*org-effectiveness-html*")
+ (insert "</body></html>")))
+
+(provide 'org-effectiveness)
+
diff --git a/contrib/lisp/org-eldoc.el b/contrib/lisp/org-eldoc.el
new file mode 100644
index 0000000..c970b27
--- /dev/null
+++ b/contrib/lisp/org-eldoc.el
@@ -0,0 +1,165 @@
+;;; org-eldoc.el --- display org header and src block info using eldoc
+
+;; Copyright (c) 2014 Free Software Foundation, Inc.
+
+;; Author: Łukasz Gruner <lukasz@gruner.lu>
+;; Maintainer: Łukasz Gruner <lukasz@gruner.lu>
+;; Version: 6
+;; Package-Requires: ((org "8"))
+;; URL: https://bitbucket.org/ukaszg/org-eldoc
+;; Created: 25/05/2014
+;; Keywords: eldoc, outline, breadcrumb, org, babel, minibuffer
+
+;; This file is not part of 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:
+
+;;; Changelog:
+
+;; As of 01/11/14 switching license to GPL3 to allow submission to org-mode.
+;; 08/11/14 switch code to automatically define eldoc-documentation-function, but don't autostart eldoc-mode.
+
+;;; Code:
+
+(require 'org)
+(require 'ob-core)
+(require 'eldoc)
+
+(defgroup org-eldoc nil "" :group 'org)
+
+(defcustom org-eldoc-breadcrumb-separator "/"
+ "Breadcrumb separator."
+ :group 'org-eldoc
+ :type 'string)
+
+(defcustom org-eldoc-test-buffer-name " *Org-eldoc test buffer*"
+ "Name of the buffer used while testing for mode-local variable values."
+ :group 'org-eldoc
+ :type 'string)
+
+(defun org-eldoc-get-breadcrumb ()
+ "Return breadcrumb if on a headline or nil."
+ (let ((case-fold-search t) cur)
+ (save-excursion
+ (beginning-of-line)
+ (save-match-data
+ (when (looking-at org-complex-heading-regexp)
+ (setq cur (match-string 4))
+ (org-format-outline-path
+ (append (org-get-outline-path) (list cur))
+ (frame-width) "" org-eldoc-breadcrumb-separator))))))
+
+(defun org-eldoc-get-src-header ()
+ "Returns lang and list of header properties if on src definition line and nil otherwise."
+ (let ((case-fold-search t) info lang hdr-args)
+ (save-excursion
+ (beginning-of-line)
+ (save-match-data
+ (when (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_src")
+ (setq info (org-babel-get-src-block-info 'light)
+ lang (propertize (nth 0 info) 'face 'font-lock-string-face)
+ hdr-args (nth 2 info))
+ (concat
+ lang
+ ": "
+ (mapconcat
+ (lambda (elem)
+ (when (and (cdr elem) (not (string= "" (cdr elem))))
+ (concat
+ (propertize (symbol-name (car elem)) 'face 'org-list-dt)
+ " "
+ (propertize (cdr elem) 'face 'org-verbatim)
+ " ")))
+ hdr-args " ")))))))
+
+(defun org-eldoc-get-src-lang ()
+ "Return value of lang for the current block if in block body and nil otherwise."
+ (let ((case-fold-search t))
+ (save-match-data
+ (when (org-between-regexps-p ".*#\\+begin_src"
+ ".*#\\+end_src")
+ (save-excursion
+ (goto-char (org-babel-where-is-src-block-head))
+ (car (org-babel-parse-src-block-match)))))))
+
+(defvar org-eldoc-local-functions-cache (make-hash-table :size 40 :test 'equal)
+ "Cache of major-mode's eldoc-documentation-functions,
+ used by \\[org-eldoc-get-mode-local-documentation-function].")
+
+(defun org-eldoc-get-mode-local-documentation-function (lang)
+ "Check if LANG-mode sets eldoc-documentation-function and return its value."
+ (let ((cached-func (gethash lang org-eldoc-local-functions-cache 'empty))
+ (mode-func (intern-soft (format "%s-mode" lang)))
+ doc-func)
+ (if (eq 'empty cached-func)
+ (when (fboundp mode-func)
+ (with-temp-buffer
+ (funcall mode-func)
+ (setq doc-func (and eldoc-documentation-function
+ (symbol-value 'eldoc-documentation-function)))
+ (puthash lang doc-func org-eldoc-local-functions-cache))
+ doc-func)
+ cached-func)))
+
+(declare-function c-eldoc-print-current-symbol-info "c-eldoc" ())
+(declare-function css-eldoc-function "css-eldoc" ())
+(declare-function php-eldoc-function "php-eldoc" ())
+(declare-function go-eldoc--documentation-function "go-eldoc" ())
+
+(defun org-eldoc-documentation-function ()
+ "Return breadcrumbs when on a headline, args for src block header-line,
+ calls other documentation functions depending on lang when inside src body."
+ (or
+ (org-eldoc-get-breadcrumb)
+ (org-eldoc-get-src-header)
+ (let ((lang (org-eldoc-get-src-lang)))
+ (cond ((or
+ (string= lang "emacs-lisp")
+ (string= lang "elisp")) (if (fboundp 'elisp-eldoc-documentation-function)
+ (elisp-eldoc-documentation-function)
+ (let (eldoc-documentation-function)
+ (eldoc-print-current-symbol-info))))
+ ((or
+ (string= lang "c") ;; http://github.com/nflath/c-eldoc
+ (string= lang "C")) (when (require 'c-eldoc nil t)
+ (c-eldoc-print-current-symbol-info)))
+ ;; https://github.com/zenozeng/css-eldoc
+ ((string= lang "css") (when (require 'css-eldoc nil t)
+ (css-eldoc-function)))
+ ;; https://github.com/zenozeng/php-eldoc
+ ((string= lang "php") (when (require 'php-eldoc nil t)
+ (php-eldoc-function)))
+ ((or
+ (string= lang "go")
+ (string= lang "golang")) (when (require 'go-eldoc nil t)
+ (go-eldoc--documentation-function)))
+ (t (let ((doc-fun (org-eldoc-get-mode-local-documentation-function lang)))
+ (when (fboundp doc-fun) (funcall doc-fun))))))))
+
+;;;###autoload
+(defun org-eldoc-load ()
+ "Set up org-eldoc documentation function."
+ (interactive)
+ (setq-local eldoc-documentation-function #'org-eldoc-documentation-function))
+
+;;;###autoload
+(add-hook 'org-mode-hook #'org-eldoc-load)
+
+(provide 'org-eldoc)
+
+;; -*- coding: utf-8-emacs; -*-
+
+;;; org-eldoc.el ends here
diff --git a/contrib/lisp/org-eww.el b/contrib/lisp/org-eww.el
new file mode 100644
index 0000000..a6973e9
--- /dev/null
+++ b/contrib/lisp/org-eww.el
@@ -0,0 +1,171 @@
+;;; org-eww.el --- Store url and kill from Eww mode for Org
+
+;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+
+;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
+;; Keywords: link, eww
+;; Homepage: http://orgmode.org
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with 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-mode 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)
+
+
+;; Store Org-link in eww-mode buffer
+(add-hook 'org-store-link-functions '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 cursor to the start of next link if exists. Else no
+move. Return point."
+ (goto-char
+ (or (next-single-property-change (point) 'shr-url)
+ (point))))
+
+(defun org-eww-no-next-link-p ()
+ "Whether there is no next link after the cursor.
+Return t if there is no next link; otherwise, return nil."
+ (save-excursion
+ (and (eq (point) (org-eww-goto-next-url-property-change)) t)))
+
+(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.
+ (if (fboundp 'deactivate-mark) (deactivate-mark)))
+ (message "Transforming links...")
+ (save-excursion
+ (goto-char transform-start)
+ (while (and (not out-bound) ; still inside region to copy
+ (not (org-eww-no-next-link-p))) ; there is a next link
+ ;; store current point before jump next anchor
+ (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))
+ (assert (org-eww-url-below-point) t
+ "program logic error: point must have an url below but it hasn't")
+ (if (<= (point) transform-end) ; if point is inside transform bound
+ (progn
+ ;; get content between two links.
+ (if (> (point) temp-position)
+ (setq return-content (concat return-content
+ (buffer-substring
+ temp-position (point)))))
+ ;; get link location at current point.
+ (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
+ (if (< (point) transform-end)
+ (setq return-content
+ (concat return-content
+ (buffer-substring (point) transform-end))))
+ ;; quote lines starting with *
+ (org-kill-new
+ (with-temp-buffer
+ (insert return-content)
+ (goto-char 0)
+ (replace-regexp "^\*" ",*")
+ (buffer-string)))
+ (message "Transforming links...done, use C-y to insert text into Org-mode file"))))
+
+
+;; 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
+ (lambda () (org-eww-extend-eww-keymap)))
+
+
+(provide 'org-eww)
+
+;;; org-eww.el ends here
diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el
index d58043f..1506c3b 100644
--- a/contrib/lisp/org-expiry.el
+++ b/contrib/lisp/org-expiry.el
@@ -218,11 +218,12 @@ Return nil if the entry is not expired. Otherwise return the
amount of time between today and the expiry date.
If there is no creation date, use `org-expiry-created-date'.
-If there is no expiry date, use `org-expiry-expiry-date'."
+If there is no expiry date, use `org-expiry-wait'."
(let* ((ex-prop org-expiry-expiry-property-name)
(cr-prop org-expiry-created-property-name)
(ct (current-time))
- (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t) "+0d")))
+ (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t)
+ org-expiry-created-date)))
(ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait))
(ex (if (string-match "^[ \t]?[+-]" ex-field)
(time-add cr (time-subtract (org-read-date nil t ex-field) ct))
diff --git a/contrib/lisp/org-favtable.el b/contrib/lisp/org-favtable.el
deleted file mode 100755
index 3a6bb88..0000000
--- a/contrib/lisp/org-favtable.el
+++ /dev/null
@@ -1,1701 +0,0 @@
-;;; org-favtable.el --- Lookup table of favorite references and links
-
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
-
-;; Author: Marc-Oliver Ihm <org-favtable@ferntreffer.de>
-;; Keywords: hypermedia, matching
-;; Requires: org
-;; Download: http://orgmode.org/worg/code/elisp/org-favtable.el
-;; Version: 2.2.0
-
-;; This file is not part of GNU Emacs.
-
-;;; License:
-
-;; 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, 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:
-
-;; Purpose:
-;;
-;; Mark and find your favorite things and locations in org easily: Create
-;; and update a lookup table of your references and links. Often used
-;; entries bubble to the top and entering some keywords displays only the
-;; matching entries. That way the right entry one can be picked easily.
-;;
-;; References are essentially small numbers (e.g. "R237" or "-455-"),
-;; which are created by this package; they are well suited to be used
-;; outside of org. Links are just normal org-mode links.
-;;
-;;
-;; Setup:
-;;
-;; - Add these lines to your .emacs:
-;;
-;; (require 'org-favtable)
-;; ;; Good enough to start, but later you should probably
-;; ;; change this id, as will be explained below
-;; (setq org-favtable-id "00e26bef-1929-4110-b8b4-7eb9c9ab1fd4")
-;; ;; Optionally assign a key. Pick your own favorite.
-;; (global-set-key (kbd "C-+") 'org-favtable)
-;;
-;; - Just invoke `org-favtable', which will explain how to complete your
-;; setup by creating the necessary table of favorites.
-;;
-;;
-;; Further reading:
-;;
-;; Invoke `org-favtable' and pick one of its help options. You may also
-;; read the documentation of `org-favtable-id' for setup instructions, of
-;; `org-favtable' for regular usage and of `org-favtable--commands' for a
-;; list of available commands.
-;;
-
-;;; Change Log:
-
-;; [2013-02-28 Th] Version 2.2.0:
-;; - Allowed shortcuts like "h237" for command "head" with argument "237"
-;; - Integrated with org-mark-ring-goto
-;;
-;; [2013-01-25 Fr] Version 2.1.0:
-;; - Added full support for links
-;; - New commands "missing" and "statistics"
-;; - Renamed the package from "org-reftable" to "org-favtable"
-;; - Additional columns are required (e.g. "link"). Error messages will
-;; guide you
-;;
-;; [2012-12-07 Fr] Version 2.0.0:
-;; - The format of the table of favorites has changed ! You need to bring
-;; your existing table into the new format by hand (which however is
-;; easy and explained below)
-;; - Reference table can be sorted after usage count or date of last access
-;; - Ask user explicitly, which command to invoke
-;; - Renamed the package from "org-refer-by-number" to "org-reftable"
-
-;; [2012-09-22 Sa] Version 1.5.0:
-;; - New command "sort" to sort a buffer or region by reference number
-;; - New commands "highlight" and "unhighlight" to mark references
-
-;; [2012-07-13 Fr] Version 1.4.0:
-;; - New command "head" to find a headline with a reference number
-
-;; [2012-04-28 Sa] Version 1.3.0:
-;; - New commands occur and multi-occur
-;; - All commands can now be invoked explicitly
-;; - New documentation
-;; - Many bugfixes
-
-;; [2011-12-10 Sa] Version 1.2.0:
-;; - Fixed a bug, which lead to a loss of newly created reference numbers
-;; - Introduced single and double prefix arguments
-;; - Started this Change Log
-
-;;; Code:
-
-(require 'org-table)
-(require 'cl)
-
-(defvar org-favtable--version "2.2.0")
-(defvar org-favtable--preferred-command nil)
-
-(defvar org-favtable--commands '(occur head ref link enter leave goto + help reorder fill sort update highlight unhighlight missing statistics)
- "List of commands known to org-favtable:
-
-Commands known:
-
- occur: If you supply a keyword (text): Apply emacs standard
- occur operation on the table of favorites; ask for a
- string (keyword) to select lines. Occur will only show you
- lines which contain the given keyword, so you can easily find
- the right one. You may supply a list of words seperated by
- comma (\",\"), to select lines that contain any or all of the
- given words.
-
- If you supply a reference number: Apply emacs standard
- multi-occur operation all org-mode buffers to search for a
- specific reference.
-
- You may also read the note at the end of this help on saving
- the keystroke RET to accept this frequent default command.
-
- head: If invoked outside the table of favorites, ask for a
- reference number and search for a heading containing it. If
- invoked within favtable dont ask; rather use the reference or
- link from the current line.
-
- ref: Create a new reference, copy any previously selected text.
- If already within reftable, fill in ref-column.
-
- link: Create a new line in reftable with a link to the current node.
- Do not populate the ref column; this can later be populated by
- calling the \"fill\" command from within the reftable.
-
- leave: Leave the table of favorites. If the last command has
- been \"ref\", the new reference is copied and ready to yank.
- This \"org-mark-ring-goto\" and can be called several times
- in succession.
-
- enter: Just enter the node with the table of favorites.
-
- goto: Search for a specific reference within the table of
- favorites.
-
- help: Show this list of commands.
-
- +: Show all commands including the less frequently used ones
- given below. If \"+\" is followd by enough letters of such a
- command (e.g. \"+fi\"), then this command is invoked
- directly.
-
- reorder: Temporarily reorder the table of favorites, e.g. by
- count, reference or last access.
-
- fill: If either ref or link is missing, fill it.
-
- sort: Sort a set of lines (either the active region or the
- whole buffer) by the references found in each line.
-
- update: For the given reference, update the line in the
- favtable.
-
- highlight: Highlight references in region or buffer.
-
- unhighlight: Remove highlights.
-
- missing : Search for missing reference numbers (which do not
- appear in the reference table). If requested, add additional
- lines for them, so that the command \"new\" is able to reuse
- them.
-
- statistics : Show some statistics (e.g. minimum and maximum
- reference) about favtable.
-
-
-
-Two ways to save keystrokes:
-
-When prompting for a command, org-favtable puts the most likely
-one (e.g. \"occur\" or \"ref\") at the front of the list, so that
-you may just type RET.
-
-If this command needs additional input (like e.g. \"occur\"), you
-may supply this input right away, although you are still beeing
-prompted for the command. So do an occur for the string \"foo\",
-you can just enter \"foo\" without even entering \"occur\".
-
-
-Another way to save keystrokes applies if you want to choose a
-command, that requrires a reference number (and would normally
-prompt for it): In that case you may just enter enough characters
-from your command, so that it appears first in the list of
-matches; then immediately enter the number of the reference you
-are searching for. So the input \"h237\" would execute the
-command \"head\" for reference \"237\" right away.
-
-")
-
-(defvar org-favtable--commands-some '(occur head ref link leave enter goto + help))
-
-(defvar org-favtable--columns nil)
-
-(defvar org-favtable-id nil
- "Id of the Org-mode node, which contains the favorite table.
-
-Read below, on how to set up things. See the help options
-\"usage\" and \"commands\" for normal usage after setup.
-
-Setup requires two steps:
-
- - Adjust your .emacs initialization file
-
- - Create a suitable org-mode node
-
-
-Here are the lines, you need to add to your .emacs:
-
- (require 'org-favtable)
- ;; Good enough to start, but later you should probably
- ;; change this id, as will be explained below
- (setq org-favtable-id \"00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\")
- ;; Optionally assign a key. Pick your own favorite.
- (global-set-key (kbd \"C-+\") 'org-favtable)
-
-Do not forget to restart emacs to make these lines effective.
-
-
-As a second step you need to create the org-mode node, where your
-reference numbers and links will be stored. It may look like
-this:
-
- * org-favtable
- :PROPERTIES:
- :ID: 00e26bef-1929-4110-b8b4-7eb9c9ab1fd4
- :END:
-
-
- | | | Comment, description, details | | | |
- | ref | link | ;c | count;s | created | last-accessed |
- | | <4> | <30> | | | |
- |-----+------+--------------------------------+---------+---------+---------------|
- | R1 | | My first reference | | | |
-
-
-You may just copy this node into one of your org-files. Many
-things however can or should be adjusted:
-
- - The node needs not be a top level node.
-
- - Its name is completely at you choice. The node is found
- through its ID.
-
- - There are three lines of headings above the first hline. The
- first one is ignored by org-favtable, and you can use them to
- give meaningful names to columns; the second line contains
- configuration information for org-favtable; please read
- further below for its format. The third line is optional and
- may contain width-informations (e.g. <30>) only.
-
- - The sequence of columns does not matter. You may reorder them
- any way you like; e.g. make the comment-column the last
- columns within the table. Columns ar found by their name,
- which appears in the second heading-line.
-
- - You can add further columns or even remove the
- \"Comment\"-column. All other columns from the
- example (e.g. \"ref\", \"link\", \"count\", \"created\" and
- \"last-accessed\") are required.
-
- - Your references need not start at \"R1\"; However, having an
- initial row is required (it serves as a template for subsequent
- references).
-
- - Your reference need not have the form \"R1\"; you may just as
- well choose any text, that contains a single number,
- e.g. \"reference-{1}\" or \"#7\" or \"++17++\" or \"-344-\". The
- function `org-favtable' will inspect your first reference and
- create all subsequent references in the same way.
-
- - You may want to change the ID-Property of the node above and
- create a new one, which is unique (and not just a copy of
- mine). You need to change it in the lines copied to your .emacs
- too. However, this is not strictly required to make things
- work, so you may do this later, after trying out this package.
-
-
-Optionally you may tweak the second header line to adjust
-`org-favtable' a bit. In the example above it looks like this
- (with spaces collapsed):
-
-
- | ref | link | ;c | count;s | created | last-accessed |
-
-
-The different fields have different meanings:
-
- - ref : This denotes the column which contains you references
-
- - link : Column for org-mode links, which can be used to access
- locations within your files.
-
- - ;c : The flag \"c\" (\"c\" for \"copy\") denotes this column
- as the one beeing copied on command \"leave\". In the example
- above, it is also the comment-column.
-
- - count;s : this is the column which counts, how many time this
- line has been accessed (which is the key-feature of this
- package). The flag \"s\" stands for \"sort\", so the table is
- sorted after this column. You may also sort after columns
- \"ref\" or \"last-accessed\".
-
- - created : Date when this line was created.
-
- - last-accessed : Date and time, when this line was last accessed.
-
-
-After this two-step setup process you may invoke `org-favtable'
-to create a new favorite. Read the help option \"usage\" for
-instructions on normal usage, read the help option \"commands\"
-for help on single commands.
-
-")
-
-
-(defvar org-favtable--text-to-yank nil)
-(defvar org-favtable--last-action nil)
-(defvar org-favtable--occur-buffer nil)
-(defvar org-favtable--ref-regex nil)
-(defvar org-favtable--ref-format nil)
-
-
-
-(defun org-favtable (&optional what search search-is-link)
- "Mark and find your favorite items and org-locations easily:
-Create and update a lookup table of your favorite references and
-links. Often used entries automatically bubble to the top of the
-table; entering some keywords narrows it to just the matching
-entries; that way the right one can be picked easily.
-
-References are essentially small numbers (e.g. \"R237\" or
-\"-455-\"), as created by this package; links are normal org-mode
-links. Within org-favtable, both are denoted as favorites.
-
-
-Read below for a detailed description of this function. See the
-help option \"setup\" or read the documentation of
-`org-favtable-id' for setup instructions.
-
-The function `org-favtable' operates on a dedicated table (called
-the table or favorites or favtable, for short) within a special
-Org-mode node. The node has to be created as part of your initial
-setup. Each line of the favorite table contains:
-
- - A reference (optional)
-
- - A link (optional)
-
- - A number; counting, how often each reference has been
- used. This number is updated automatically and the table can
- be sorted according to it, so that most frequently used
- references appear at the top of the table and can be spotted
- easily.
-
- - Its respective creation date
-
- - Date and time of last access. This column can alternatively be
- used to sort the table.
-
-To be useful, your table of favorites should probably contain a
-column with comments too, which allows lines to be selected by
-keywords.
-
-The table of favorites is found through the id of the containing
-node; this id should be stored within `org-favtable-id' (see there
-for details).
-
-
-The function `org-favtable' is the only interactive function of
-this package and its sole entry point; it offers several commands
-to create, find and look up these favorites (references and
-links). All of them are explained within org-favtable's help.
-
-
-Finally, org-favtable can also be invoked from elisp; the two
-optional arguments accepted are:
-
- search : string to search for
- what : symbol of the command to invoke
- search-is-link : t, if argument search is actually a link
-
-An example would be:
-
- (org-favtable \"237\" 'head) ;; find heading with ref 237
-
-"
-
- (interactive "P")
-
- (let (within-node ; True, if we are within node with favtable
- result-is-visible ; True, if node or occur is visible in any window
- ref-node-buffer-and-point ; cons with buffer and point of favorites node
- below-cursor ; word below cursor
- active-region ; active region (if any)
- link-id ; link of starting node, if required
- guarded-search ; with guard against additional digits
- search-is-ref ; true, if search is a reference
- commands ; currently active set of selectable commands
- what-adjusted ; True, if we had to adjust what
- what-input ; Input on what question (need not necessary be "what")
- reorder-once ; Column to use for single time sorting
- parts ; Parts of a typical reference number (which
- ; need not be a plain number); these are:
- head ; Any header before number (e.g. "R")
- maxref ; Maximum number from reference table (e.g. "153")
- tail ; Tail after number (e.g. "}" or "")
- ref-regex ; Regular expression to match a reference
- has-reuse ; True, if table contains a line for reuse
- numcols ; Number of columns in favtable
- kill-new-text ; Text that will be appended to kill ring
- message-text ; Text that will be issued as an explanation,
- ; what we have done
- initial-ref-or-link ; Initial position in reftable
- )
-
- ;;
- ;; Examine current buffer and location, before turning to favtable
- ;;
-
- ;; Get the content of the active region or the word under cursor
- (if (and transient-mark-mode
- mark-active)
- (setq active-region (buffer-substring (region-beginning) (region-end))))
- (setq below-cursor (thing-at-point 'symbol))
-
-
- ;; Find out, if we are within favable or not
- (setq within-node (string= (org-id-get) org-favtable-id))
-
- ;; Find out, if point in any window is within node with favtable
- (mapc (lambda (x) (with-current-buffer (window-buffer x)
- (when (or
- (string= (org-id-get) org-favtable-id)
- (eq (window-buffer x)
- org-favtable--occur-buffer))
- (setq result-is-visible t))))
- (window-list))
-
-
-
- ;;
- ;; Get decoration of references and highest reference from favtable
- ;;
-
-
- ;; Save initial ref or link
- (if (and within-node
- (org-at-table-p))
- (setq initial-ref-or-link
- (or (org-favtable--get-field 'ref)
- (org-favtable--get-field 'link))))
-
- ;; Find node
- (setq ref-node-buffer-and-point (org-favtable--id-find))
- (unless ref-node-buffer-and-point
- (org-favtable--report-setup-error
- (format "Cannot find node with id \"%s\"" org-favtable-id)))
-
- ;; Get configuration of reftable; catch errors
- (let ((error-message
- (catch 'content-error
-
- (with-current-buffer (car ref-node-buffer-and-point)
- (save-excursion
- (unless (string= (org-id-get) org-favtable-id)
- (goto-char (cdr ref-node-buffer-and-point)))
-
- ;; parse table while still within buffer
- (setq parts (org-favtable--parse-and-adjust-table)))
-
- nil))))
- (when error-message
- (org-pop-to-buffer-same-window (car ref-node-buffer-and-point))
- (org-reveal)
- (error error-message)))
-
- ;; Give names to parts of configuration
- (setq head (nth 0 parts))
- (setq maxref (nth 1 parts))
- (setq tail (nth 2 parts))
- (setq numcols (nth 3 parts))
- (setq ref-regex (nth 4 parts))
- (setq has-reuse (nth 5 parts))
- (setq org-favtable--ref-regex ref-regex)
- (setq org-favtable--ref-format (concat head "%d" tail))
-
- ;;
- ;; Find out, what we are supposed to do
- ;;
-
- (if (equal what '(4)) (setq what 'leave))
-
- ;; Set preferred action, that will be the default choice
- (setq org-favtable--preferred-command
- (if within-node
- (if (memq org-favtable--last-action '(ref link))
- 'leave
- 'occur)
- (if active-region
- 'ref
- (if (and below-cursor (string-match ref-regex below-cursor))
- 'occur
- nil))))
-
- ;; Ask user, what to do
- (unless what
- (setq commands (copy-list org-favtable--commands-some))
- (while (progn
- (setq what-input
- (org-icompleting-read
- "Please choose: "
- (mapcar 'symbol-name
- ;; Construct unique list of commands with
- ;; preferred one at front
- (delq nil (delete-dups
- (append
- (list org-favtable--preferred-command)
- commands))))
- nil nil))
-
-
- ;; if input starts with "+", any command (not only some) may follow
- ;; this allows input like "+sort" to be accepted
- (when (string= (substring what-input 0 1) "+")
- ;; make all commands available for selection
- (setq commands (copy-list org-favtable--commands))
- (unless (string= what-input "+")
- ;; not just "+", use following string
- (setq what-input (substring what-input 1))
-
- (let ((completions
- ;; get list of possible completions for what-input
- (all-completions what-input (mapcar 'symbol-name commands))))
- ;; use it, if unambigously
- (if (= (length completions) 1)
- (setq what-input (car completions))))))
-
-
- ;; if input ends in digits, save them away and do completions on head of input
- ;; this allows input like "h224" to be accepted
- (when (string-match "^\\([^0-9+]\\)\\([0-9]+\\)\\s *$" what-input)
- ;; use first match as input, even if ambigously
- (setq org-favtable--preferred-command
- (intern (first (all-completions (match-string 1 what-input)
- (mapcar 'symbol-name commands)))))
- ;; use digits as argument to commands
- (setq what-input (format org-favtable--ref-format
- (string-to-number (match-string 2 what-input)))))
-
- (setq what (intern what-input))
-
- ;; user is not required to input one of the commands; if
- ;; not, take the first one and use the original input for
- ;; next question
- (if (memq what commands)
- ;; input matched one element of list, dont need original
- ;; input any more
- (setq what-input nil)
- ;; what-input will be used for next question, use first
- ;; command for what
- (setq what (or org-favtable--preferred-command
- (first commands)))
- ;; remove any trailing dot, that user might have added to
- ;; disambiguate his input
- (if (equal (substring what-input -1) ".")
- ;; but do this only, if dot was really necessary to
- ;; disambiguate
- (let ((shortened-what-input (substring what-input 0 -1)))
- (unless (test-completion shortened-what-input
- (mapcar 'symbol-name
- commands))
- (setq what-input shortened-what-input)))))
-
- ;; ask for reorder in loop, because we have to ask for
- ;; what right again
- (if (eq what 'reorder)
- (setq reorder-once
- (intern
- (org-icompleting-read
- "Please choose column to reorder reftable once: "
- (mapcar 'symbol-name '(ref count last-accessed))
- nil t))))
-
- ;; maybe ask initial question again
- (memq what '(reorder +)))))
-
-
- ;;
- ;; Get search, if required
- ;;
-
- ;; These actions need a search string:
- (when (memq what '(goto occur head update))
-
- ;; Maybe we've got a search string from the arguments
- (unless search
- (let (search-from-table
- search-from-cursor)
-
- ;; Search string can come from several sources:
- ;; From ref column of table
- (when within-node
- (setq search-from-table (org-favtable--get-field 'ref)))
- ;; From string below cursor
- (when (and (not within-node)
- below-cursor
- (string-match (concat "\\(" ref-regex "\\)")
- below-cursor))
- (setq search-from-cursor (match-string 1 below-cursor)))
-
- ;; Depending on requested action, get search from one of the sources above
- (cond ((eq what 'goto)
- (setq search (or what-input search-from-cursor)))
- ((memq what '(head occur))
- (setq search (or what-input search-from-table search-from-cursor))))))
-
-
- ;; If we still do not have a search string, ask user explicitly
- (unless search
-
- (if what-input
- (setq search what-input)
- (setq search (read-from-minibuffer
- (cond ((memq what '(occur head))
- "Text or reference number to search for: ")
- ((eq what 'goto)
- "Reference number to search for, or enter \".\" for id of current node: ")
- ((eq what 'update)
- "Reference number to update: ")))))
-
- (if (string-match "^\\s *[0-9]+\\s *$" search)
- (setq search (format "%s%s%s" head (org-trim search) tail))))
-
- ;; Clean up and examine search string
- (if search (setq search (org-trim search)))
- (if (string= search "") (setq search nil))
- (setq search-is-ref (string-match ref-regex search))
-
- ;; Check for special case
- (when (and (memq what '(head goto))
- (string= search "."))
- (setq search (org-id-get))
- (setq search-is-link t))
-
- (when search-is-ref
- (setq guarded-search (org-favtable--make-guarded-search search)))
-
- ;;
- ;; Do some sanity checking before really starting
- ;;
-
- ;; Correct requested action, if nothing to search
- (when (and (not search)
- (memq what '(search occur head)))
- (setq what 'enter)
- (setq what-adjusted t))
-
- ;; For a proper reference as input, we do multi-occur
- (if (and (string-match ref-regex search)
- (eq what 'occur))
- (setq what 'multi-occur))
-
- ;; Check for invalid combinations of arguments; try to be helpful
- (when (and (memq what '(head goto))
- (not search-is-link)
- (not search-is-ref))
- (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search)))
-
-
- ;;
- ;; Prepare
- ;;
-
- ;; Get link if required before moving in
- (if (eq what 'link)
- (setq link-id (org-id-get-create)))
-
- ;; Move into table, if outside
- (when (memq what '(enter ref link goto occur multi-occur missing statistics))
-
- ;; Support orgmode-standard of going back (buffer and position)
- (org-mark-ring-push)
-
- ;; Switch to favtable
- (org-pop-to-buffer-same-window (car ref-node-buffer-and-point))
- (goto-char (cdr ref-node-buffer-and-point))
- (show-subtree)
- (org-show-context)
-
- ;; sort favtable
- (org-favtable--sort-table reorder-once))
-
- ;; Goto back to initial ref, because reformatting of table above might
- ;; have moved point
- (when initial-ref-or-link
- (while (and (org-at-table-p)
- (not (or
- (string= initial-ref-or-link (org-favtable--get-field 'ref))
- (string= initial-ref-or-link (org-favtable--get-field 'link)))))
- (forward-line))
- ;; did not find ref, go back to top
- (if (not (org-at-table-p)) (goto-char top)))
-
-
- ;;
- ;; Actually do, what is requested
- ;;
-
- (cond
-
-
- ((eq what 'help)
-
- (let ((help-what
- ;; which sort of help ?
- (intern
- (concat
- "help-"
- (org-icompleting-read
- "Help on: "
- (mapcar 'symbol-name '(commands usage setup version example))
- nil t)))))
-
- ;; help is taken from docstring of functions or variables
- (cond ((eq help-what 'help-commands)
- (org-favtable--show-help 'org-favtable--commands))
- ((eq help-what 'help-usage)
- (org-favtable--show-help 'org-favtable))
- ((eq help-what 'help-setup)
- (org-favtable--show-help 'org-favtable-id))
- ((eq help-what 'help-version)
- (org-favtable-version)))))
-
-
- ((eq what 'multi-occur)
-
- ;; Conveniently position cursor on number to search for
- (org-favtable--goto-top)
- (let (found (initial (point)))
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found (string= search
- (org-favtable--get-field 'ref)))))
- (if found
- (org-favtable--update-line nil)
- (goto-char initial)))
-
- ;; Construct list of all org-buffers
- (let (buff org-buffers)
- (dolist (buff (buffer-list))
- (set-buffer buff)
- (if (string= major-mode "org-mode")
- (setq org-buffers (cons buff org-buffers))))
-
- ;; Do multi-occur
- (multi-occur org-buffers guarded-search)
- (if (get-buffer "*Occur*")
- (progn
- (setq message-text (format "multi-occur for '%s'" search))
- (setq org-favtable--occur-buffer (get-buffer "*Occur*"))
- (other-window 1)
- (toggle-truncate-lines 1))
- (setq message-text (format "Did not find '%s'" search)))))
-
-
- ((eq what 'head)
-
- (let (link)
- ;; link either from table or passed in as argument
-
- ;; try to get link
- (if search-is-link
- (setq link (org-trim search))
- (if (and within-node
- (org-at-table-p))
- (setq link (org-favtable--get-field 'link))))
-
- ;; use link if available
- (if (and link
- (not (string= link "")))
- (progn
- (org-id-goto link)
- (org-favtable--update-line search)
- (setq message-text "Followed link"))
-
- (message (format "Scanning headlines for '%s' ..." search))
- (let (buffer point)
- (if (catch 'found
- (progn
- ;; loop over all headlines, stop on first match
- (org-map-entries
- (lambda ()
- (when (looking-at (concat ".*" guarded-search))
- ;; remember location and bail out
- (setq buffer (current-buffer))
- (setq point (point))
- (throw 'found t)))
- nil 'agenda)
- nil))
-
- (progn
- (org-favtable--update-line search)
- (setq message-text (format "Found '%s'" search))
- (org-pop-to-buffer-same-window buffer)
- (goto-char point)
- (org-reveal))
- (setq message-text (format "Did not find '%s'" search)))))))
-
-
- ((eq what 'leave)
-
- (when result-is-visible
-
- ;; If we are within the occur-buffer, switch over to get current line
- (if (and (string= (buffer-name) "*Occur*")
- (eq org-favtable--last-action 'occur))
- (occur-mode-goto-occurrence)))
-
- (setq kill-new-text org-favtable--text-to-yank)
- (setq org-favtable--text-to-yank nil)
-
- ;; If "leave" has been called two times in succession, make
- ;; org-mark-ring-goto believe it has been called two times too
- (if (eq org-favtable--last-action 'leave)
- (let ((this-command nil) (last-command nil))
- (org-mark-ring-goto 1))
- (org-mark-ring-goto 0)))
-
-
- ((eq what 'goto)
-
- ;; Go downward in table to requested reference
- (let (found (initial (point)))
- (org-favtable--goto-top)
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found
- (string= search
- (org-favtable--get-field
- (if search-is-link 'link 'ref))))))
- (if found
- (progn
- (setq message-text (format "Found '%s'" search))
- (org-favtable--update-line nil)
- (org-table-goto-column (org-favtable--column-num 'ref))
- (if (looking-back " ") (backward-char))
- ;; remember string to copy
- (setq org-favtable--text-to-yank
- (org-trim (org-table-get-field (org-favtable--column-num 'copy)))))
- (setq message-text (format "Did not find '%s'" search))
- (goto-char initial)
- (forward-line)
- (setq what 'missed))))
-
-
- ((eq what 'occur)
-
- ;; search for string: occur
- (let (search-regexp
- all-or-any
- (search-words (split-string search "," t)))
-
- (if (< (length search-words) 2)
- ;; only one word to search; use it as is
- (setq search-regexp search)
- ;; construct regexp to match any of the words (maybe throw out some matches later)
- (setq search-regexp
- (mapconcat (lambda (x) (concat "\\(" x "\\)")) search-words "\\|"))
- (setq all-or-any
- (intern
- (org-icompleting-read
- "Two or more words have been specified; show lines, that match: " '("all" "any")))))
-
- (save-restriction
- (org-narrow-to-subtree)
- (occur search-regexp)
- (widen)
- (if (get-buffer "*Occur*")
- (with-current-buffer "*Occur*"
-
- ;; install helpful keyboard-shortcuts within occur-buffer
- (let ((keymap (make-sparse-keymap)))
- (set-keymap-parent keymap occur-mode-map)
-
- (define-key keymap (kbd "RET")
- (lambda () (interactive)
- (org-favtable--occur-helper 'head)))
-
- (define-key keymap (kbd "<C-return>")
- (lambda () (interactive)
- (org-favtable--occur-helper 'multi-occur)))
-
- (define-key keymap (kbd "<M-return>")
- (lambda () (interactive)
- (org-favtable--occur-helper 'goto)))
-
- (define-key keymap (kbd "<C-M-return>")
- (lambda () (interactive)
- (org-favtable--occur-helper 'update)))
-
- (use-local-map keymap))
-
- ;; Brush up occur buffer
- (other-window 1)
- (toggle-truncate-lines 1)
- (let ((inhibit-read-only t))
- ;; insert some help text
- (insert (substitute-command-keys
- "Type RET to find heading, C-RET for multi-occur, M-RET to go to occurence and C-M-RET to update line in reftable.\n\n"))
- (forward-line 1)
-
- ;; when matching all of multiple words, remove all lines that do not match one of the words
- (when (eq all-or-any 'all)
- (mapc (lambda (x) (keep-lines x)) search-words))
-
- ;; replace description from occur
- (when all-or-any
- (forward-line -1)
- (kill-line)
- (let ((count (- (count-lines (point) (point-max)) 1)))
- (insert (format "%d %s for %s of %s"
- count
- (if (= count 1) "match" "matches")
- all-or-any
- search)))
- (forward-line)
- (beginning-of-line))
-
- ;; Record link or reference for each line in
- ;; occur-buffer, that is linked into reftable. Because if
- ;; we later realign the reftable and then reuse the occur
- ;; buffer, the original links might point nowehere.
- (save-excursion
- (while (not (eq (point) (point-max)))
- (let ((beg (line-beginning-position))
- (end (line-end-position))
- pos ref link)
-
- ;; occur has saved the position into a special property
- (setq pos (get-text-property (point) 'occur-target))
- (when pos
- ;; but this property might soon point nowhere; so retrieve ref-or-link instead
- (with-current-buffer (marker-buffer pos)
- (goto-char pos)
- (setq ref (org-favtable--get-field 'ref))
- (setq link (org-favtable--get-field 'link))))
- ;; save as text property
- (put-text-property beg end 'org-favtable--ref ref)
- (put-text-property beg end 'org-favtable--link link))
- (forward-line))))
-
- (setq message-text
- (format "Occur for '%s'" search)))
- (setq message-text
- (format "Did not find any matches for '%s'" search))))))
-
-
- ((memq what '(ref link))
-
- ;; add a new row (or reuse existing one)
- (let (new)
-
- (when (eq what 'ref)
- ;; go through table to find first entry to be reused
- (when has-reuse
- (org-favtable--goto-top)
- ;; go through table
- (while (and (org-at-table-p)
- (not new))
- (when (string=
- (org-favtable--get-field 'count)
- ":reuse:")
- (setq new (org-favtable--get-field 'ref))
- (if new (org-table-kill-row)))
- (forward-line)))
-
- ;; no ref to reuse; construct new reference
- (unless new
- (setq new (format "%s%d%s" head (1+ maxref) tail)))
-
- ;; remember for org-mark-ring-goto
- (setq org-favtable--text-to-yank new))
-
- ;; insert ref or link as very first row
- (org-favtable--goto-top)
- (org-table-insert-row)
-
- ;; fill special columns with standard values
- (when (eq what 'ref)
- (org-table-goto-column (org-favtable--column-num 'ref))
- (insert new))
- (when (eq what 'link)
- (org-table-goto-column (org-favtable--column-num 'link))
- (insert link-id))
- (org-table-goto-column (org-favtable--column-num 'created))
- (org-insert-time-stamp nil nil t)
-
- ;; goto first empty field
- (unless (catch 'empty
- (dotimes (col numcols)
- (org-table-goto-column (+ col 1))
- (if (string= (org-trim (org-table-get-field)) "")
- (throw 'empty t))))
- ;; none found, goto first
- (org-table-goto-column 1))
-
- (org-table-align)
- (if active-region (setq kill-new-text active-region))
- (if (eq what 'ref)
- (setq message-text (format "Adding a new row with ref '%s'" new))
- (setq message-text (format "Adding a new row linked to '%s'" link-id)))))
-
-
- ((eq what 'enter)
-
- ;; simply go into table
- (org-favtable--goto-top)
- (show-subtree)
- (recenter)
- (if what-adjusted
- (setq message-text "Nothing to search for; at favtable")
- (setq message-text "At favtable")))
-
-
- ((eq what 'fill)
-
- ;; check, if within reftable
- (unless (and within-node
- (org-at-table-p))
- (error "Not within table of favorites"))
-
- ;; applies to missing refs and missing links alike
- (let ((ref (org-favtable--get-field 'ref))
- (link (org-favtable--get-field 'link)))
-
- (if (and (not ref)
- (not link))
- ;; have already checked this during parse, check here anyway
- (error "Columns ref and link are both empty in this line"))
-
- ;; fill in new ref
- (if (not ref)
- (progn
- (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail))
- (org-favtable--get-field 'ref kill-new-text)
- ;; remember for org-mark-ring-goto
- (setq org-favtable--text-to-yank kill-new-text)
- (org-id-goto link)
- (setq message-text "Filled reftable field with new reference"))
-
- ;; fill in new link
- (if (not link)
- (progn
- (setq guarded-search (org-favtable--make-guarded-search ref))
- (message (format "Scanning headlines for '%s' ..." ref))
- (let (link)
- (if (catch 'found
- (org-map-entries
- (lambda ()
- (when (looking-at (concat ".*" guarded-search))
- (setq link (org-id-get-create))
- (throw 'found t)))
- nil 'agenda)
- nil)
-
- (progn
- (org-favtable--get-field 'link link)
- (setq message-text "Inserted link"))
-
- (setq message-text (format "Did not find reference '%s'" ref)))))
-
- ;; nothing is missing
- (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do")))))
-
-
- ((eq what 'sort)
-
- ;; sort lines according to contained reference
- (let (begin end where)
- (catch 'aborted
- ;; either active region or whole buffer
- (if (and transient-mark-mode
- mark-active)
- ;; sort only region
- (progn
- (setq begin (region-beginning))
- (setq end (region-end))
- (setq where "region"))
- ;; sort whole buffer
- (setq begin (point-min))
- (setq end (point-max))
- (setq where "whole buffer")
- ;; make sure
- (unless (y-or-n-p "Sort whole buffer ")
- (setq message-text "Sort aborted")
- (throw 'aborted nil)))
-
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (narrow-to-region begin end)
- (sort-subr nil 'forward-line 'end-of-line
- (lambda ()
- (if (looking-at (concat ".*"
- (org-favtable--make-guarded-search ref-regex 'dont-quote)))
- (string-to-number (match-string 1))
- 0))))
- (highlight-regexp ref-regex)
- (setq message-text (format "Sorted %s from character %d to %d, %d lines"
- where begin end
- (count-lines begin end)))))))
-
-
- ((eq what 'update)
-
- ;; simply update line in reftable
- (save-excursion
- (let ((ref-or-link (if search-is-link "link" "reference")))
- (beginning-of-line)
- (if (org-favtable--update-line search)
- (setq message-text (format "Updated %s '%s'" ref-or-link search))
- (setq message-text (format "Did not find %s '%s'" ref-or-link search))))))
-
-
- ((eq what 'parse)
-
- ;; Just parse the reftable, which is already done, so nothing to do
- )
-
-
- ((memq what '(highlight unhighlight))
-
- (let ((where "buffer"))
- (save-excursion
- (save-restriction
- (when (and transient-mark-mode
- mark-active)
- (narrow-to-region (region-beginning) (region-end))
- (setq where "region"))
-
- (if (eq what 'highlight)
- (progn
- (highlight-regexp ref-regex)
- (setq message-text (format "Highlighted references in %s" where)))
- (unhighlight-regexp ref-regex)
- (setq message-text (format "Removed highlights for references in %s" where)))))))
-
-
- ((memq what '(missing statistics))
-
- (org-favtable--goto-top)
- (let (missing
- ref-field
- ref
- min
- max
- (total 0))
-
- ;; start with list of all references
- (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail))
- (number-sequence 1 maxref)))
-
- ;; go through table and remove all refs, that we see
- (while (and (forward-line)
- (org-at-table-p))
-
- ;; get ref-field and number
- (setq ref-field (org-favtable--get-field 'ref))
- (if (and ref-field
- (string-match ref-regex ref-field))
- (setq ref (string-to-number (match-string 1 ref-field))))
-
- ;; remove existing refs from list
- (if ref-field (setq missing (delete ref-field missing)))
-
- ;; record min and max
- (if (or (not min) (< ref min)) (setq min ref))
- (if (or (not max) (> ref max)) (setq max ref))
-
- ;; count
- (setq total (1+ total)))
-
- ;; insert them, if requested
- (forward-line -1)
- (if (eq what 'statistics)
-
- (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. "
- total
- (format org-favtable--format min)
- (format org-favtable--format max)
- (length missing)))
-
- (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the table of favorites"
- (length missing)))
- (let (type)
- (setq type (org-icompleting-read
- "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing")))
- (mapc (lambda (x)
- (let (org-table-may-need-update) (org-table-insert-row t))
- (org-favtable--get-field 'ref x)
- (org-favtable--get-field 'count (format ":%s:" type)))
- missing)
- (org-table-align)
- (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))
- (setq message-text (format "%d missing references." (length missing)))))))
-
-
- (t (error "This is a bug: unmatched case '%s'" what)))
-
-
- ;; remember what we have done for next time
- (setq org-favtable--last-action what)
-
- ;; tell, what we have done and what can be yanked
- (if kill-new-text (setq kill-new-text
- (substring-no-properties kill-new-text)))
- (if (string= kill-new-text "") (setq kill-new-text nil))
- (let ((m (concat
- message-text
- (if (and message-text kill-new-text)
- " and r"
- (if kill-new-text "R" ""))
- (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))
- (unless (string= m "") (message m)))
- (if kill-new-text (kill-new kill-new-text))))
-
-
-
-(defun org-favtable--parse-and-adjust-table ()
-
- (let ((maxref 0)
- top
- bottom
- ref-field
- link-field
- parts
- numcols
- head
- tail
- ref-regex
- has-reuse
- initial-point)
-
- (setq initial-point (point))
- (org-favtable--goto-top)
- (setq top (point))
-
- (goto-char top)
-
- ;; count columns
- (org-table-goto-column 100)
- (setq numcols (- (org-table-current-column) 1))
-
- ;; get contents of columns
- (forward-line -2)
- (unless (org-at-table-p)
- (org-favtable--report-setup-error
- "Table of favorites starts with a hline" t))
-
- ;; check for optional line consisting solely of width specifications
- (beginning-of-line)
- (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")
- (forward-line -1))
- (org-table-goto-column 1)
-
- (setq org-favtable--columns (org-favtable--parse-headings numcols))
-
- ;; Go beyond end of table
- (while (org-at-table-p) (forward-line 1))
-
- ;; Kill all empty rows at bottom
- (while (progn
- (forward-line -1)
- (org-table-goto-column 1)
- (and
- (not (org-favtable--get-field 'ref))
- (not (org-favtable--get-field 'link))))
- (org-table-kill-row))
- (forward-line)
- (setq bottom (point))
- (forward-line -1)
-
- ;; Retrieve any decorations around the number within the first nonempty ref-field
- (goto-char top)
- (while (and (org-at-table-p)
- (not (setq ref-field (org-favtable--get-field 'ref))))
- (forward-line))
-
- ;; Some Checking
- (unless ref-field
- (org-favtable--report-setup-error
- "No line of reference column contains a number" t))
-
- (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
- (org-favtable--report-setup-error
- (format "First reference in table table of favorites ('%s') does not contain a number" ref-field) t))
-
-
- ;; These are the decorations used within the first ref of favtable
- (setq head (match-string 1 ref-field))
- (setq tail (match-string 3 ref-field))
- (setq ref-regex (concat (regexp-quote head)
- "\\([0-9]+\\)"
- (regexp-quote tail)))
-
- ;; Go through table to find maximum number and do some checking
- (let ((ref 0))
-
- (while (org-at-table-p)
-
- (setq ref-field (org-favtable--get-field 'ref))
- (setq link-field (org-favtable--get-field 'link))
-
- (if (and (not ref-field)
- (not link-field))
- (throw 'content-error "Columns ref and link are both empty in this line"))
-
- (if ref-field
- (if (string-match ref-regex ref-field)
- ;; grab number
- (setq ref (string-to-number (match-string 1 ref-field)))
- (throw 'content-error "Column ref does not contain a number")))
-
- ;; check, if higher ref
- (if (> ref maxref) (setq maxref ref))
-
- ;; check if ref is ment for reuse
- (if (string= (org-favtable--get-field 'count) ":reuse:")
- (setq has-reuse 1))
-
- (forward-line 1)))
-
- ;; sort used to be here
-
- (setq parts (list head maxref tail numcols ref-regex has-reuse))
-
- ;; go back to top of table
- (goto-char top)
-
- parts))
-
-
-
-(defun org-favtable--sort-table (sort-column)
-
- (unless sort-column (setq sort-column (org-favtable--column-num 'sort)))
-
- (let (top
- bottom
- ref-field
- count-field
- count-special)
-
-
- ;; get boundaries of table
- (org-favtable--goto-top)
- (forward-line 0)
- (setq top (point))
- (while (org-at-table-p) (forward-line))
- (setq bottom (point))
-
- (save-restriction
- (narrow-to-region top bottom)
- (goto-char top)
- (sort-subr t
- 'forward-line
- 'end-of-line
- (lambda ()
- (let (ref
- (ref-field (or (org-favtable--get-field 'ref) ""))
- (count-field (or (org-favtable--get-field 'count) ""))
- (count-special 0))
-
- ;; get reference with leading zeroes, so it can be
- ;; sorted as text
- (string-match org-favtable--ref-regex ref-field)
- (setq ref (format
- "%06d"
- (string-to-number
- (or (match-string 1 ref-field)
- "0"))))
-
- ;; find out, if special token in count-column
- (setq count-special (format "%d"
- (- 2
- (length (member count-field '(":missing:" ":reuse:"))))))
-
- ;; Construct different sort-keys according to
- ;; requested sort column; prepend count-special to
- ;; sort special entries at bottom of table, append ref
- ;; as a secondary sort key
- (cond
-
- ((eq sort-column 'count)
- (concat count-special
- (format
- "%08d"
- (string-to-number (or (org-favtable--get-field 'count)
- "")))
- ref))
-
- ((eq sort-column 'last-accessed)
- (concat count-special
- (org-favtable--get-field 'last-accessed)
- " "
- ref))
-
- ((eq sort-column 'ref)
- (concat count-special
- ref))
-
- (t (error "This is a bug: unmatched case '%s'" sort-column)))))
-
- nil 'string<)))
-
- ;; align table
- (org-table-align))
-
-
-(defun org-favtable--goto-top ()
-
- ;; go to heading of node
- (while (not (org-at-heading-p)) (forward-line -1))
- (forward-line 1)
- ;; go to table within node, but make sure we do not get into another node
- (while (and (not (org-at-heading-p))
- (not (org-at-table-p))
- (not (eq (point) (point-max))))
- (forward-line 1))
-
- ;; check, if there really is a table
- (unless (org-at-table-p)
- (org-favtable--report-setup-error
- (format "Cannot find favtable within node %s" org-favtable-id) t))
-
- ;; go to first hline
- (while (and (not (org-at-table-hline-p))
- (org-at-table-p))
- (forward-line 1))
-
- ;; and check
- (unless (org-at-table-hline-p)
- (org-favtable--report-setup-error
- "Cannot find hline within table of favorites" t))
-
- (forward-line 1)
- (org-table-goto-column 1))
-
-
-
-(defun org-favtable--id-find ()
- "Find org-favtable-id"
- (let ((marker (org-id-find org-favtable-id 'marker))
- marker-and-buffer)
-
- (if marker
- (progn
- (setq marker-and-buffer (cons (marker-buffer marker) (marker-position marker)))
- (move-marker marker nil)
- marker-and-buffer)
- nil)))
-
-
-
-(defun org-favtable--parse-headings (numcols)
-
- (let (columns)
-
- ;; Associate names of special columns with column-numbers
- (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0)
- (count . 0) (sort . nil) (copy . nil))))
-
- ;; For each column
- (dotimes (col numcols)
- (let* (field-flags ;; raw heading, consisting of file name and maybe
- ;; flags (seperated by ";")
- field ;; field name only
- field-symbol ;; and as a symbol
- flags ;; flags from field-flags
- found)
-
- ;; parse field-flags into field and flags
- (setq field-flags (org-trim (org-table-get-field (+ col 1))))
- (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)
- (progn
- (setq field (downcase (or (match-string 1 field-flags) "")))
- ;; get flags as list of characters
- (setq flags (mapcar 'string-to-char
- (split-string
- (downcase (match-string 2 field-flags))
- "" t))))
- ;; no flags
- (setq field field-flags))
-
- (unless (string= field "") (setq field-symbol (intern (downcase field))))
-
- ;; Check, that no flags appear twice
- (mapc (lambda (x)
- (when (memq (car x) flags)
- (if (cdr (assoc (cdr x) columns))
- (org-favtable--report-setup-error
- (format "More than one heading is marked with flag '%c'" (car x)) t))))
- '((?s . sort)
- (?c . copy)))
-
- ;; Process flags
- (if (memq ?s flags)
- (setcdr (assoc 'sort columns) field-symbol))
- (if (memq ?c flags)
- (setcdr (assoc 'copy columns) (+ col 1)))
-
- ;; Store columns in alist
- (setq found (assoc field-symbol columns))
- (when found
- (if (> (cdr found) 0)
- (org-favtable--report-setup-error
- (format "'%s' appears two times as column heading" (downcase field)) t))
- (setcdr found (+ col 1)))))
-
- ;; check if all necessary informations have been specified
- (mapc (lambda (col)
- (unless (> (cdr (assoc col columns)) 0)
- (org-favtable--report-setup-error
- (format "column '%s' has not been set" col) t)))
- '(ref link count created last-accessed))
-
- ;; use ref as a default sort-column
- (unless (cdr (assoc 'sort columns))
- (setcdr (assoc 'sort columns) 'ref))
- columns))
-
-
-
-(defun org-favtable--report-setup-error (text &optional switch-to-node)
-
- (when switch-to-node
- (org-id-goto org-favtable-id)
- (delete-other-windows))
-
- (when (y-or-n-p (concat
- text
- ";\n"
- "the correct setup is explained in the documentation of 'org-favtable-id'.\n"
- "Do you want to read it ? "))
- (org-favtable--show-help 'org-favtable-id))
-
- (error "")
- (setq org-favtable--last-action 'leave))
-
-
-
-(defun org-favtable--show-help (function-or-variable)
-
- (let ((isfun (functionp function-or-variable)))
- ;; bring up help-buffer for function or variable
- (if isfun
- (describe-function function-or-variable)
- (describe-variable function-or-variable))
-
-
- ;; clean up help-buffer
- (pop-to-buffer "*Help*")
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (while (progn
- (kill-line 1)
- (not (looking-at
- (if isfun
- "("
- "Documentation:")))))
- (kill-line (if isfun 2 3))
- (goto-char (point-max))
- (kill-line -2)
- (goto-char (point-min)))))
-
-
-
-(defun org-favtable--update-line (ref-or-link)
-
- (let (initial
- found
- count-field
- (ref-node-buffer-and-point (org-favtable--id-find)))
-
- (with-current-buffer (car ref-node-buffer-and-point)
-
- ;; search reference or link, if given (or assume, that we are already positioned right)
- (when ref-or-link
- (setq initial (point))
- (goto-char (cdr ref-node-buffer-and-point))
- (org-favtable--goto-top)
- (while (and (org-at-table-p)
- (not (or (string= ref-or-link (org-favtable--get-field 'ref))
- (string= ref-or-link (org-favtable--get-field 'link)))))
- (forward-line)))
-
- (if (not (org-at-table-p))
- (error "Did not find reference or link '%s'" ref-or-link)
- (setq count-field (org-favtable--get-field 'count))
-
- ;; update count field only if number or empty; leave :missing: and :reuse: as is
- (if (or (not count-field)
- (string-match "^[0-9]+$" count-field))
- (org-favtable--get-field 'count
- (number-to-string
- (+ 1 (string-to-number (or count-field "0"))))))
-
- ;; update timestamp
- (org-table-goto-column (org-favtable--column-num 'last-accessed))
- (org-table-blank-field)
- (org-insert-time-stamp nil t t)
-
- (setq found t))
-
- (if initial (goto-char initial))
-
- found)))
-
-
-
-(defun org-favtable--occur-helper (action)
- (let ((line-beg (line-beginning-position))
- key search link ref)
-
- ;; extract reference or link from text property (as put there before)
- (setq ref (get-text-property line-beg 'org-favtable--ref))
- (if (string= ref "") (setq ref nil))
- (setq link (get-text-property line-beg 'org-favtable--link))
- (if (string= link "") (setq link nil))
-
- (org-favtable action
- (or link ref) ;; prefer link
- (if link t nil))))
-
-
-(defun org-favtable--get-field (key &optional value)
- (let (field)
- (setq field (org-trim (org-table-get-field (cdr (assoc key org-favtable--columns)) value)))
- (if (string= field "") (setq field nil))
-
- field))
-
-
-(defun org-favtable--column-num (key)
- (cdr (assoc key org-favtable--columns)))
-
-
-(defun org-favtable-version ()
- "Show version of org-favtable" (interactive)
- (message "org-favtable %s" org-favtable--version))
-
-
-(defun org-favtable--make-guarded-search (ref &optional dont-quote)
- (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b"))
-
-
-(defun org-favtable-get-ref-regex-format ()
- "return cons-cell with regular expression and format for references"
- (unless org-favtable--ref-regex
- (org-favtable 'parse))
- (cons (org-favtable--make-guarded-search org-favtable--ref-regex 'dont-quote) org-favtable--ref-format))
-
-
-(defadvice org-mark-ring-goto (after org-favtable--advice-text-to-yank activate)
- "Make text from the favtable available for yank."
- (when org-favtable--text-to-yank
- (kill-new org-favtable--text-to-yank)
- (message (format "Ready to yank '%s'" org-favtable--text-to-yank))
- (setq org-favtable--text-to-yank nil)))
-
-
-(provide 'org-favtable)
-
-;; Local Variables:
-;; fill-column: 75
-;; comment-column: 50
-;; End:
-
-;;; org-favtable.el ends here
diff --git a/contrib/lisp/org-git-link.el b/contrib/lisp/org-git-link.el
index 7d95bbb..ad0ce71 100644
--- a/contrib/lisp/org-git-link.el
+++ b/contrib/lisp/org-git-link.el
@@ -98,10 +98,12 @@
(let* ((strlist (org-git-split-string str))
(filepath (first strlist))
(commit (second strlist))
+ (line (third strlist))
(dirlist (org-git-find-gitdir (file-truename filepath)))
(gitdir (first dirlist))
(relpath (second dirlist)))
- (org-git-open-file-internal gitdir (concat commit ":" relpath))))
+ (org-git-open-file-internal gitdir (concat commit ":" relpath))
+ (when line (goto-line (string-to-int line)))))
;; Utility functions (file names etc)
@@ -141,16 +143,19 @@
;; splitting the link string
;; Both link open functions are called with a string of
-;; consisting of two parts separated by a double colon (::).
+;; consisting of three parts separated by a double colon (::).
(defun org-git-split-string (str)
- "Given a string of the form \"str1::str2\", return a list of
- two substrings \'(\"str1\" \"str2\"). If the double colon is mising, take str2 to be the empty string."
+ "Given a string of the form \"str1::str2::str3\", return a list of
+ three substrings \'(\"str1\" \"str2\" \"str3\"). If there are less
+than two double colons, str2 and/or str3 may be set the empty string."
(let ((strlist (split-string str "::")))
(cond ((= 1 (length strlist))
- (list (car strlist) ""))
+ (list (car strlist) "" ""))
((= 2 (length strlist))
+ (append strlist (list "")))
+ ((= 3 (length strlist))
strlist)
- (t (error "org-git-split-string: only one :: allowed: %s" str)))))
+ (t (error "org-git-split-string: only one or two :: allowed: %s" str)))))
;; finding the file name part of a commit
(defun org-git-link-filename (str)
@@ -168,22 +173,24 @@
(concat branch "@{" timestring "}"))
-(defun org-git-create-git-link (file)
+(defun org-git-create-git-link (file &optional line)
"Create git link part to file at specific time"
(interactive "FFile: ")
(let* ((gitdir (first (org-git-find-gitdir (file-truename file))))
(branchname (org-git-get-current-branch gitdir))
(timestring (format-time-string "%Y-%m-%d" (current-time))))
- (concat "git:" file "::" (org-git-create-searchstring branchname timestring))))
+ (concat "git:" file "::" (org-git-create-searchstring branchname timestring)
+ (if line (format "::%s" line) ""))))
(defun org-git-store-link ()
"Store git link to current file."
(when (buffer-file-name)
- (let ((file (abbreviate-file-name (buffer-file-name))))
+ (let ((file (abbreviate-file-name (buffer-file-name)))
+ (line (line-number-at-pos)))
(when (org-git-gitrepos-p file)
(org-store-link-props
:type "git"
- :link (org-git-create-git-link file))))))
+ :link (org-git-create-git-link file line))))))
(add-hook 'org-store-link-functions 'org-git-store-link)
diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el
new file mode 100644
index 0000000..26edc85
--- /dev/null
+++ b/contrib/lisp/org-index.el
@@ -0,0 +1,2497 @@
+;;; org-index.el --- A personal index for org and beyond
+
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+
+;; Author: Marc Ihm <org-index@2484.de>
+;; Version: 4.2.1
+;; Keywords: outlines index
+
+;; This file is not part of GNU Emacs.
+
+;;; License:
+
+;; 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, 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:
+
+;; Purpose:
+;;
+;; Fast search for selected org headings and things outside of org.
+;;
+;; This package creates and updates an index table of headings or
+;; keywords, references and ids, where each line points to a heading
+;; within org or references something outside. This table is sorted by
+;; usage count, so that frequently used lines appear among the first
+;; search results.
+;;
+;; References are essentially small numbers (e.g. 'R237' or '--455--'), as
+;; created by this package; they are well suited to be used outside of
+;; org, e.g. in folder names, issue trackers or on printed documents.
+;;
+;; On first invocation org-index will guide you to create a dedicated node
+;; for its index table and its configuration flags.
+;;
+;; For basic usage, subcommands 'add' and 'occur' are most important.
+;;
+;;
+;; Setup:
+;;
+;; - Add these lines to your .emacs:
+;;
+;; (require 'org-index)
+;; (org-index-default-keybindings) ; optional
+;;
+;; - Restart your Emacs to make these lines effective.
+;;
+;; - Invoke `org-index', which will assist in creating your index
+;; table. The variable org-index-id will be persisted within your
+;; customization file (typically .emacs).
+;;
+;;
+;; Further reading:
+;;
+;; See the documentation of `org-index', which can also be read
+;; by invoking `org-index' and choosing the help-command.
+;;
+;;
+;; Updates:
+;;
+;; The latest tested version of this file can always be found at:
+;;
+;; http://orgmode.org/w/org-mode.git?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD
+
+;;; Change Log:
+
+;; [2015-03-18 We] Version 4.2.1
+;; - No garbage in kill-ring
+;; - No recentering after add
+;;
+;; [2015-03-08 Su] Version 4.2.0
+;; - Reference numbers for subcommands can be passed as a prefix argument
+;; - Renamed subcommand 'point' to 'ping'
+;; - New variable org-index-default-keybindings-list with a list of
+;; default keybindings for org-index-default-keybindings
+;; - Added new column level
+;; - removed flags get-category-on-add and get-heading-on-add
+;;
+;; [2015-03-05 Th] Version 4.1.1 and 4.1.2
+;; - org-mark-ring is now used more consistently
+;; - Bugfix when going to a heading by ref
+;;
+;; [2015-02-26 Th] Version 4.0.0 and 4.1.0:
+;; - Removed command "leave"; rather go back with org-mark-ring-goto
+;; - Property "org-index-ref" is no longer used or needed
+;; - Renamed column "link" to "id"
+;; - Added maintainance options to find duplicate rows, to check ids,
+;; update index or remove property org-index-ref from nodes
+;; - New command point
+;; - Shortened versin history
+;;
+;; [2014-12-07 Sa] to [2015-01-31 Sa] Version 3.0.0 to 3.2.0:
+;; - Complete sorting of index only occurs in idle-timer
+;; - New command "maintain" with some subcommands
+;; - Rewrote command "occur" with overlays in an indirect buffer
+;; - introduced variable org-index-version
+;; - Command "add" updates index, if node is already present
+;; - New commands "add" and "delete" to easily add and remove
+;; the current node to or from your index.
+;; - New command "example" to create an example index.
+;; - Moved flags to a list within the same node as the index table;
+;; this breaks compatibility to prior versions of the package.
+;; - Several new flags that are explained within index node.
+;; - Removed commands "reuse", "missing", "put", "goto",
+;; "update", "link", "fill", "unhighlight"
+;; - New function `org-index-default-keybindings'
+;;
+;; [2012-12-07 Fr] to [2014-04-26 Sa] Version 2.0.0 to 2.4.3:
+;; - New functions org-index-new-line and org-index-get-line
+;; offer access to org-index from other lisp programs
+;; - Regression tests with ert
+;; - Renamed from "org-favtable" to "org-index"
+;; - Added an assistant to set up the index table
+;; - occur is now incremental, searching as you type
+;; - Integrated with org-mark-ring-goto
+;; - Added full support for ids
+;; - Renamed the package from "org-reftable" to "org-favtable"
+;; - Additional columns are required (e.g. "link"). Error messages will
+;; guide you
+;; - Ask user explicitly, which command to invoke
+;; - Renamed the package from "org-refer-by-number" to "org-reftable"
+;;
+;; [2011-12-10 Sa] to [2012-09-22 Sa] Version Version 1.2.0 to 1.5.0:
+;; - New command "sort" to sort a buffer or region by reference number
+;; - New commands "highlight" and "unhighlight" to mark references
+;; - New command "head" to find a headline with a reference number
+;; - New commands occur and multi-occur
+;; - Started this Change Log
+
+;;; Code:
+
+(require 'org-table)
+(require 'cl)
+
+(defcustom org-index-id nil
+ "Id of the Org-mode node, which contains the index table."
+ :group 'org
+ :group 'org-index)
+
+;; Version of this package
+(defvar org-index-version "4.2.1" "Version of `org-index', format is major.minor.bugfix, where \"major\" is a change in index-table and \"minor\" are new features.")
+
+;; Variables to hold the configuration of the index table
+(defvar org-index--maxref nil "Maximum number from reference table (e.g. '153').")
+(defvar org-index--head nil "Any header before number (e.g. 'R').")
+(defvar org-index--tail nil "Tail after number (e.g. '}' or ')'.")
+(defvar org-index--numcols nil "Number of columns in index table.")
+(defvar org-index--ref-regex nil "Regular expression to match a reference.")
+(defvar org-index--ref-format nil "Format, that can print a reference.")
+(defvar org-index--columns nil "Columns of index-table.")
+(defvar org-index--special-columns nil "Columns with flags, that may appear only once.")
+(defvar org-index--flagged-columns nil "Columns with flags, that may appear multiple times.")
+(defvar org-index--buffer nil "Buffer of index table.")
+(defvar org-index--point nil "Position at start of headline of index table.")
+(defvar org-index--below-hline nil "Position of first cell in first line below hline.")
+(defvar org-index--headings nil "Headlines of index-table as a string.")
+(defvar org-index--headings-visible nil "Visible part of headlines of index-table as a string.")
+(defvar org-index--keymap nil "Keymap for shortcuts for some commands of `org-index'. Filled and activated by `org-index-default-keybings'.")
+
+;; Variables to hold context and state
+(defvar org-index--last-ref nil "Last reference created or visited.")
+(defvar org-index--category-before nil "Category of node before.")
+(defvar org-index--active-region nil "Active region, initially. I.e. what has been marked.")
+(defvar org-index--below-cursor nil "Word below cursor.")
+(defvar org-index--within-node nil "True, if we are within node of the index table.")
+(defvar org-index--message-text nil "Text that was issued as an explanation; helpful for regression tests.")
+(defvar org-index--occur-help-text nil "Text for help in occur buffer.")
+(defvar org-index--occur-help-overlay nil "Overlay for help in occur buffer.")
+(defvar org-index--occur-stack nil "Stack with overlays for hiding lines.")
+(defvar org-index--occur-tail-overlay nil "Overlay to cover invisible lines.")
+(defvar org-index--last-sort nil "Last column, the index has been sorted after.")
+(defvar org-index--sort-timer nil "Timer to sort index in correct order.")
+(defvar org-index--aligned nil "Remember for this Emacs session, if table has been aligned at least once.")
+
+;; static information for this program package
+(defconst org-index--commands '(occur add delete head ping enter ref help example sort multi-occur highlight maintain) "List of commands available.")
+(defconst org-index--required-flags '(sort) "Flags that are required.")
+(defconst org-index--single-flags '(sort point-on-add yank-after-add shift-ref-and-date-on-add) "Flags, that may only appear once; these can appear as special-columns.")
+(defconst org-index--multiple-flags '(edit-on-add) "Flags, that might appear multiple times.")
+(defconst org-index--all-flags (append org-index--single-flags org-index--multiple-flags) "All flags.")
+(defconst org-index--required-headings '(ref id created last-accessed count) "All required headings.")
+(defconst org-index--valid-headings (append org-index--required-headings '(keywords category level)) "All valid headings.")
+(defconst org-index--occur-buffer-name "*org-index-occur*" "Name of occur buffer.")
+(defconst org-index--sort-idle-delay 300 "Delay in seconds after which buffer will sorted.")
+(defvar org-index-default-keybindings-list '(("a" . 'add) ("i " . nil) ("o" . 'occur) ("a" . 'add) ("d" . 'delete) ("h" . 'head) ("e" . 'enter) ("p." . 'ping) ("r" . 'ref) ("?" . 'help)) "One-letter short cuts for selected subcommands of `org-index', put in effect by `org-index-default-keybindings'")
+(defconst org-index--sample-flags
+"
+ - columns-and-flags :: associate columns of index table with flags. Do not remove.
+ - ref
+ - yank-after-add
+ - category
+ - edit-on-add
+ - keywords
+ - edit-on-add
+ - point-on-add
+ - count
+ - sort
+ - last-accessed
+ - created
+ - id
+ - all-columns-explained :: All columns of the index table and their meaning.
+ - ref :: The reference number; will be generated automatically.
+ - id :: id of the node, that this line represents
+ - created :: When has this entry been created ?
+ - last-accessed :: When has this entry been accessed last ?
+ - count :: How many times has this entry been picked ?
+ - keywords :: Optional column, suggested to keep a list of keywords,
+ which may match your input during occur. While adding a line to your index,
+ this column will be filled with the nodes heading.
+ - category :: (optional) column to store the category of newly added nodes.
+ - level :: Nesting level of node
+ - Any name starting with a dot (`.') :: No predefined meaning,
+ depends on its flags.
+ - all-flags-explained :: All flags, that can be associated with columns.
+ - sort :: Sort whole table according to this column.
+ - yank-after-add :: This column will be yanked after picking this line during
+ occur.
+ - edit-on-add :: This field will be presented for editing, when adding
+ a new line to your index.
+ - point-on-add :: Point will land here, when adding a new line, e.g. with
+ command ref.
+ - shift-ref-and-date-on-add :: Remove leading reference and timestamp on add."
+"A sample string of flags.")
+
+
+(defmacro org-index--on (column value &rest body)
+ "Execute the forms in BODY with point on index line whose COLUMN is VALUE.
+The value returned is the value of the last form in BODY or nil,
+if VALUE cannot be found."
+ (declare (indent 2) (debug t))
+ (let ((pointvar (make-symbol "point")) ; avoid clash with same-named variables in body
+ (foundvar (make-symbol "found"))
+ (retvar (make-symbol "ret")))
+ `(save-current-buffer
+ (set-buffer org-index--buffer)
+ (setq ,pointvar (point))
+ (setq ,foundvar nil)
+ (setq ,retvar nil)
+
+ (setq ,foundvar (org-index--go ,column ,value))
+ (when ,foundvar
+ (setq ,retvar (progn ,@body)))
+
+ (goto-char ,pointvar)
+
+ ,retvar)))
+
+
+(defun org-index (&optional command search-ref arg)
+ "Fast search for selected org headings and things outside of org.
+
+This package creates and updates an index table of headings or
+keywords, references and ids, where each line points to a heading
+within org or references something outside. This table is sorted by
+usage count, so that frequently used lines appear among the first
+search results.
+
+References are essentially small numbers (e.g. 'R237' or '--455--'), as
+created by this package; they are well suited to be used outside of
+org, e.g. in folder names, issue trackers or on printed documents.
+
+On first invocation `org-index' will guide you to create a dedicated node
+for its index table and its configuration flags.
+
+For basic usage, subcommands 'add' and 'occur' are most important.
+
+This is version 4.2.1 of org-index.el.
+\\<org-mode-map>
+The function `org-index' operates on a dedicated table, the index
+table, which lives within its own Org-mode node. The table and
+its containing node will be created, when you first invoke
+`org-index'. The node also contains a commented list, describing
+the columns of the index table and their associated flags. The
+node is found through its id, which is stored within the variable
+`org-index-id'.
+
+
+The function `org-index' is the only interactive function of this
+package and its main entry point; it will present you with a list
+of subcommands to choose from:
+
+ occur: Incremental search, that shows matching lines from the
+ index table. It is updated after every keystroke. You may
+ enter a list of words seperated by space or comma (`,'), to
+ select lines that contain all of the given words.
+
+ add: Add the current node to your index, so that it can be
+ found through the subcommand \"occur\". Update index,
+ if node has already been present.
+
+ delete: Delete the current node from your index.
+
+ head: Ask for a reference number and search for this heading.
+
+ enter: Enter index table and maybe go to a specific reference;
+ use `org-mark-ring-goto' (\\[org-mark-ring-goto]) to go back.
+
+ ping: Echo line from index table for current node or first of
+ its ancestor from index.
+
+ ref: Create a new reference.
+
+ help: Show this text.
+
+ example: Create a temporary index, that will not be saved, but
+ may serve as an example.
+
+ sort: Sort lines in index, in region or buffer by contained
+ reference, or sort index by count, reference or last access.
+
+ multi-occur: Apply Emacs standard `multi-occur' operation on all
+ `org-mode' buffers to search for the given reference.
+
+ highlight: Highlight or unhiglight references in active region or buffer.
+ Call with prefix argument (`C-u') to remove highlights.
+
+ maintain: Offers some choices to check, update or fix your index.
+
+If you invoke `org-index' for the first time, an assistant will be
+invoked, that helps you to create your own, commented index.
+
+Use `org-index-default-keybindings' to establish convenient
+keyboard shortcuts.
+
+See the commented list of flags within your index node for ways to
+modify the behaviour of org-index.
+
+A numeric prefix argument is used as a reference number for
+commands, that need one (e.g. 'head').
+
+Optional arguments for use from elisp: COMMAND is a symbol naming
+the command to execute. SEARCH-REF specifies a reference to
+search for, if needed. ARG allows passing in a prefix argument
+as in interactive calls."
+
+ (interactive "i\ni\nP")
+
+ (let (search-id ; id to search for
+ sort-what ; sort what ?
+ kill-new-text ; text that will be appended to kill ring
+ message-text) ; text that will be issued as an explanation
+
+
+ ;;
+ ;; Initialize and parse
+ ;;
+
+ ;; creates index table, if necessary
+ (org-index--verify-id)
+
+ ;; Get configuration of index table
+ (org-index--parse-table)
+
+ ;; store context information
+ (org-index--retrieve-context)
+
+
+ ;;
+ ;; Arrange for proper sorting of index
+ ;;
+
+ ;; lets assume, that it has been sorted this way (we try hard to make sure)
+ (unless org-index--last-sort (setq org-index--last-sort (org-index--special-column 'sort)))
+ ;; rearrange for index beeing sorted into default sort order after 300 secs of idle time
+ (unless org-index--sort-timer
+ (setq org-index--sort-timer
+ (run-with-idle-timer org-index--sort-idle-delay t 'org-index--sort-silent)))
+
+
+ ;;
+ ;; Find out, what we are supposed to do
+ ;;
+
+ ;; check or read command
+ (if command
+ (unless (memq command org-index--commands)
+ (error "Unknown command '%s' passed as argument, valid choices are any of these symbols: %s"
+ command (mapconcat 'symbol-name org-index--commands ",")))
+ (setq command (intern (org-completing-read
+ "Please choose: "
+ (mapcar 'symbol-name org-index--commands)))))
+
+
+ ;;
+ ;; Get search string, if required; process possible sources one after
+ ;; another (lisp argument, prefix argumen, user input).
+ ;;
+
+ ;; Try prefix, if no lisp argument given
+ (if (and (not search-ref)
+ (numberp arg))
+ (setq search-ref (format "%s%d%s" org-index--head arg org-index--tail)))
+
+ ;; These actions really need a search string and may even prompt for it
+ (when (memq command '(enter head multi-occur))
+
+ ;; search from surrounding text ?
+ (unless search-ref
+ (if org-index--within-node
+
+ (if (org-at-table-p)
+ (setq search-ref (org-index--get-or-set-field 'ref)))
+
+ (if (and org-index--below-cursor
+ (string-match (concat "\\(" org-index--ref-regex "\\)")
+ org-index--below-cursor))
+ (setq search-ref (match-string 1 org-index--below-cursor)))))
+
+ ;; If we still do not have a search string, ask user explicitly
+ (unless search-ref
+ (if (eq command 'enter)
+ (let ((r (org-index--read-search-for-enter)))
+ (setq search-ref (car r))
+ (setq search-id (cdr r)))
+ (setq search-ref (read-from-minibuffer "Search reference number: "))))
+
+ ;; Clean up search string
+ (when search-ref
+ (setq search-ref (org-trim search-ref))
+ (if (string-match "^[0-9]+$" search-ref)
+ (setq search-ref (concat org-index--head search-ref org-index--tail)))
+ (if (string= search-ref "") (setq search-ref nil)))
+
+ (if (and (not search-ref)
+ (not (eq command 'enter)))
+ (error "Command %s needs a reference number" command)))
+
+
+ ;;
+ ;; Command sort needs to know in advance, what to sort for
+ ;;
+
+ (when (eq command 'sort)
+ (setq sort-what (intern (org-completing-read "You may sort:\n - index : your index table by various columns\n - region : the active region by contained reference\n - buffer : the whole current buffer\nPlease choose what to sort: " (list "index" "region" "buffer") nil t))))
+
+
+ ;;
+ ;; Enter table
+ ;;
+
+ ;; Arrange for beeing able to return
+ (when (and (memq command '(occur head enter ref example sort maintain))
+ (not (string= (buffer-name) org-index--occur-buffer-name)))
+ (org-mark-ring-push))
+
+ ;; These commands will leave user in index table after they are finished
+ (when (or (memq command '(enter ref maintain))
+ (and (eq command 'sort)
+ (eq sort-what 'index)))
+
+ (pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--point)
+ (org-index--unfold-buffer))
+
+
+ ;;
+ ;; Actually do, what is requested
+ ;;
+
+ (cond
+
+
+ ((eq command 'help)
+
+ ;; bring up help-buffer for this function
+ (describe-function 'org-index))
+
+
+ ((eq command 'multi-occur)
+
+ ;; Construct list of all org-buffers
+ (let (buff org-buffers)
+ (dolist (buff (buffer-list))
+ (set-buffer buff)
+ (if (string= major-mode "org-mode")
+ (setq org-buffers (cons buff org-buffers))))
+
+ ;; Do multi-occur
+ (multi-occur org-buffers (org-index--make-guarded-search search-ref))
+
+ ;; Present results
+ (if (get-buffer "*Occur*")
+ (progn
+ (setq message-text (format "multi-occur for '%s'" search-ref))
+ (other-window 1)
+ (toggle-truncate-lines 1))
+ (setq message-text (format "Did not find '%s'" search-ref)))))
+
+
+ ((eq command 'add)
+
+ (let ((r (org-index--do-add-or-update)))
+ (setq message-text (car r))
+ (setq kill-new-text (cdr r))))
+
+
+ ((eq command 'delete)
+
+ (setq message-text (org-index--do-delete)))
+
+
+ ((eq command 'head)
+
+ (if (and org-index--within-node
+ (org-at-table-p))
+ (setq search-id (org-index--get-or-set-field 'id)))
+
+ (setq search-id (or search-id (org-index--id-from-ref search-ref)))
+ (setq message-text
+ (if search-id
+ (org-index--do-head search-ref search-id)
+ (message "Current line has no id."))))
+
+
+ ((eq command 'enter)
+
+ (goto-char org-index--below-hline)
+
+ (setq message-text
+
+ (if search-ref
+ (if (org-index--go 'ref search-ref)
+ (progn
+ (org-index--update-current-line)
+ (org-table-goto-column (org-index--column-num 'ref))
+ (format "Found index line '%s'" search-ref))
+ (format "Did not find index line with reference '%s'" search-ref))
+
+ (if search-id
+ (if (org-index--go 'id search-id)
+ (progn
+ (org-index--update-current-line)
+ (org-table-goto-column (org-index--column-num 'ref))
+ (format "Found index line '%s'" (org-index--get-or-set-field 'ref)))
+ (format "Did not find index line with id '%s'" search-id))
+
+ ;; simply go into table
+ (setq message-text "At index table"))))
+
+ (recenter))
+
+
+ ((eq command 'ping)
+
+ (let ((moved-up 0) id info reached-top)
+
+ (unless (string= major-mode "org-mode") (error "No node at point"))
+ ;; take id from current node or reference
+ (setq id (if search-ref
+ (org-index--id-from-ref search-ref)
+ (org-id-get)))
+
+ ;; move up until we find a node in index
+ (save-excursion
+ (outline-back-to-heading)
+ (while (not (or info
+ reached-top))
+ (if id
+ (setq info (org-index--on 'id id
+ (mapcar (lambda (x) (org-index--get-or-set-field x))
+ (list 'ref 'count 'created 'last-accessed 'category 'keywords 'ref)))))
+
+ (setq reached-top (= (org-outline-level) 1))
+
+ (unless (or info
+ reached-top)
+ (outline-up-heading 1 t)
+ (incf moved-up))
+
+ (setq id (org-id-get))))
+
+ (if info
+ (progn
+ (setq message-text
+ (apply 'format
+ (append (list "'%s'%shas been accessed %s times between %s and %s; category is '%s', keywords are '%s'"
+ (pop info)
+ (if (> moved-up 0) (format " (parent node, %d level up) " moved-up) " "))
+ info)))
+ (setq kill-new-text (car (last info))))
+ (setq message-text "Neither this node nor any of its parents is part of index"))))
+
+
+ ((eq command 'occur)
+
+ (set-buffer org-index--buffer)
+ (org-index--do-occur))
+
+
+ ((eq command 'ref)
+
+ (let (new)
+
+ ;; add a new row
+ (setq new (org-index--create-new-line))
+
+ ;; fill special columns with standard values
+ (org-table-goto-column (org-index--column-num 'ref))
+ (insert new)
+ (setq org-index--last-ref new)
+
+ ;; goto point-field or first empty one or first field
+ (if (org-index--special-column 'point-on-add)
+ (org-table-goto-column (org-index--column-num (org-index--special-column 'point-on-add)))
+ (unless (catch 'empty
+ (dotimes (col org-index--numcols)
+ (org-table-goto-column (+ col 1))
+ (if (string= (org-trim (org-table-get-field)) "")
+ (throw 'empty t))))
+ ;; none found, goto first
+ (org-table-goto-column 1)))
+
+ (if org-index--active-region (setq kill-new-text org-index--active-region))
+ (setq message-text (format "Adding a new row with ref '%s'" new))))
+
+
+ ((eq command 'sort)
+
+ (let ((columns (list "ref" "count" "created" "last-accessed" "id"))
+ sort groups-and-counts)
+
+ (cond
+ ((eq sort-what 'index)
+ (setq sort
+ (intern
+ (org-icompleting-read
+ "Please choose column to sort index table: "
+ (append (copy-list columns) (list "group-by"))
+ nil t nil nil (symbol-name (org-index--special-column 'sort)))))
+
+ (when (eq sort 'group-by)
+ (setq sort
+ (intern
+ (org-icompleting-read
+ "Please choose column to group index table by: "
+ columns
+ nil t nil nil (symbol-name (org-index--special-column 'sort)))))
+ (setq groups-and-counts (org-index--collect-sort-groups sort)))
+
+ (org-index--do-sort-index sort (first groups-and-counts))
+ (org-table-goto-column (org-index--column-num sort))
+ ;; When saving index, it should again be sorted correctly
+ (with-current-buffer org-index--buffer
+ (add-hook 'before-save-hook 'org-index--sort-silent t))
+
+ (setq message-text
+ (format
+ (concat "Your index has been sorted temporarily by %s and will be sorted again by %s after %d seconds of idle time"
+ (if groups-and-counts
+ "; %d groups with equal %s and a total of %d lines have been found"
+ ""))
+ (symbol-name sort)
+ (org-index--special-column 'sort)
+ org-index--sort-idle-delay
+ (second groups-and-counts)
+ (symbol-name sort)
+ (third groups-and-counts))))
+
+ ((memq sort-what '(region buffer))
+ (org-index--do-sort-lines sort-what)
+ (setq message-text (format "Sorted %s by contained references" sort-what))))))
+
+
+ ((eq command 'highlight)
+
+ (let ((where "buffer"))
+ (save-excursion
+ (save-restriction
+ (when (and transient-mark-mode
+ mark-active)
+ (narrow-to-region (region-beginning) (region-end))
+ (setq where "region"))
+
+ (if arg
+ (progn
+ (unhighlight-regexp org-index--ref-regex)
+ (setq message-text (format "Removed highlights for references in %s" where)))
+ (highlight-regexp org-index--ref-regex 'isearch)
+ (setq message-text (format "Highlighted references in %s" where)))))))
+
+
+ ((eq command 'maintain)
+ (setq message-text (org-index--do-maintain)))
+
+
+ ((eq command 'example)
+
+ (if (y-or-n-p "This assistant will help you to create a temporary index with detailed comments.\nDo you want to proceed ? ")
+ (org-index--create-index t)))
+
+
+ (t (error "Unknown subcommand '%s'" command)))
+
+
+ ;; tell, what we have done and what can be yanked
+ (if kill-new-text (setq kill-new-text
+ (substring-no-properties kill-new-text)))
+ (if (string= kill-new-text "") (setq kill-new-text nil))
+ (let ((m (concat
+ message-text
+ (if (and message-text kill-new-text)
+ " and r"
+ (if kill-new-text "R" ""))
+ (if kill-new-text (format "eady to yank '%s'." kill-new-text) (if message-text "." "")))))
+ (unless (string= m "")
+ (message m)
+ (setq org-index--message-text m)))
+ (if kill-new-text (kill-new kill-new-text))))
+
+
+(defun org-index-default-keybindings (&optional prefix)
+ "Set default keybindings for `org-index'.
+
+Invoke subcommands of org index with a single key
+sequence. Establish the common prefix key 'C-c i' which should be
+followed by the first letter of a subcommand.
+
+The ist of letters and subcommands is specified in within
+`org-index-default-keybindings-list'.
+
+See `org-index' for a description of all subcommands.
+
+Optional argument PREFIX specifies common prefix, defaults to 'C-c i'"
+ (interactive)
+
+ (define-prefix-command 'org-index--keymap)
+ ;; prefix command
+ (global-set-key (kbd (or prefix "C-c i")) 'org-index--keymap)
+ ;; loop over subcommands
+ (mapcar
+ (lambda (x)
+ ;; loop over letters, that invoke the same subcommand
+ (mapcar (lambda (c)
+ (define-key org-index--keymap (kbd (char-to-string c))
+ `(lambda (arg) (interactive "P")
+ (message nil)
+ (org-index ,(cdr x) nil arg))))
+ (car x)))
+ org-index-default-keybindings-list))
+
+
+(defun org-index-new-line (&rest keys-values)
+ "Create a new line within the index table, returning its reference.
+
+The function takes a varying number of argument pairs; each pair
+is a symbol for an existing column heading followed by its value.
+The return value is the new reference.
+
+Example:
+
+ (message \"Created reference %s\"
+ (org-index-new-line 'keywords \"foo bar\" 'category \"baz\"))
+
+Optional argument KEYS-VALUES specifies content of new line."
+
+ (org-index--verify-id)
+ (org-index--parse-table)
+
+ (car (apply 'org-index--do-new-line keys-values)))
+
+
+(defun org-index--do-new-line (&rest keys-values)
+ "Do the work for `org-index-new-line'.
+Optional argument KEYS-VALUES specifies content of new line."
+
+ (save-excursion
+ (org-index--retrieve-context)
+ (with-current-buffer org-index--buffer
+ (goto-char org-index--point)
+
+ ;; check arguments early; they might come from lisp-user
+ (let ((kvs keys-values)
+ k v)
+ (while kvs
+ (setq k (car kvs))
+ (setq v (cadr kvs))
+ (if (eq k 'ref)
+ (unless (memq v '(t nil))
+ (error "Column 'ref' accepts only \"t\" or \"nil\""))
+ (if (or (not (symbolp k))
+ (and (symbolp v) (not (eq v t)) (not (eq v nil))))
+ (error "Arguments must be alternation of key and value")))
+ (unless (org-index--column-num k)
+ (error "Unknown column or column not defined in table: '%s'" (symbol-name k)))
+ (setq kvs (cddr kvs))))
+
+ (let (ref yank)
+ ;; create new line
+ (setq ref (org-index--create-new-line))
+ (plist-put keys-values 'ref ref)
+
+ ;; fill columns
+ (let ((kvs keys-values)
+ k v n)
+ (while kvs
+ (setq k (car kvs))
+ (setq v (cadr kvs))
+ (org-table-goto-column (org-index--column-num k))
+ (insert (org-trim v))
+ (setq kvs (cddr kvs))))
+
+ ;; align and fontify line
+ (org-index--promote-current-line)
+ (org-index--align-and-fontify-current-line)
+
+ ;; get column to yank
+ (setq yank (org-index--get-or-set-field (org-index--special-column 'yank-after-add)))
+
+ (cons ref yank)))))
+
+
+(defun org-index-get-line (column value)
+ "Retrieve an existing line within the index table by ref or id.
+Return its contents as a property list.
+
+The function `plist-get' may be used to retrieve specific elements
+from the result.
+
+Example:
+
+ (plist-get (org-index-get-line 'ref \"R12\") 'count)
+
+retrieves the value of the count-column for reference number 12.
+
+Argument COLUMN is a symbol, either ref or id,
+argument VALUE specifies the value to search for."
+ ;; check arguments
+ (unless (memq column '(ref id))
+ (error "Argument column can only be 'ref' or 'id'"))
+
+ (unless value
+ (error "Need a value to search for"))
+
+ (org-index--verify-id)
+ (org-index--parse-table)
+
+ (org-index--get-line column value))
+
+
+(defun org-index--get-line (column value)
+ "Find a line by ID, return its contents.
+Argument COLUMN and VALUE specify line to get."
+ (let (content)
+ (org-index--on
+ column value
+ (mapc (lambda (x)
+ (if (and (numberp (cdr x))
+ (> (cdr x) 0))
+ (setq content (cons (car x) (cons (or (org-index--get-or-set-field (car x)) "") content)))))
+ (reverse org-index--columns)))
+ content))
+
+
+(defun org-index--delete-line (id)
+ "Delete a line specified by ID."
+ (let (content)
+ (org-index--on
+ 'id id
+ (let ((start (line-beginning-position)))
+ (beginning-of-line)
+ (forward-line)
+ (delete-region start (point))
+ t))))
+
+
+(defun org-index--ref-from-id (id)
+ "Get reference from line ID."
+ (org-index--on 'id id (org-index--get-or-set-field 'ref)))
+
+
+(defun org-index--id-from-ref (ref)
+ "Get id from line REF."
+ (org-index--on 'ref ref (org-index--get-or-set-field 'id)))
+
+
+(defun org-index--read-search-for-enter ()
+ "Special input routine for command enter."
+ ;; Accept single char commands or switch to reading a sequence of digits
+ (let (char prompt search-ref search-id)
+
+ ;; start with short prompt but give more help on next iteration
+ (setq prompt "Please specify, where to go in index (0-9.,space,backspace,return or ? for help): ")
+
+ ;; read one character
+ (while (not (memq char (append (number-sequence ?0 ?9) (list ?\d ?\b ?\r ?\j ?\s ?.))))
+ (setq char (read-char prompt))
+ (setq prompt "Go to index table and specific position. Digits specify a reference number to got to, <space> goes to top of index, <backspace> or <delete> to last line created and <return> or `.' to index line of current node. Please choose: "))
+
+ (if (memq char (number-sequence ?0 ?9))
+ ;; read rest of digits
+ (setq search-ref (read-from-minibuffer "Search reference number: " (char-to-string char))))
+ ;; decode single chars
+ (if (memq char '(?\r ?\n ?.)) (setq search-id (org-id-get)))
+ (if (memq char '(?\d ?\b)) (setq search-ref (number-to-string org-index--maxref)))
+
+ (cons search-ref search-id)))
+
+
+(defun org-index--verify-id ()
+ "Check, that we have a valid id."
+
+ ;; Check id
+ (unless org-index-id
+ (let ((answer (org-completing-read "Cannot find an index (org-index-id is not set). You may:\n - read-help : to learn more about org-index\n - create-index : invoke an assistant to create an initial index\nPlease choose: " (list "read-help" "create-index") nil t nil nil "read-help")))
+ (if (string= "create-index" answer)
+ (org-index--create-missing-index "Variable org-index-id is not set, so probably no index table has been created yet.")
+ (describe-function 'org-index))))
+
+ ;; Find node
+ (let (marker)
+ (setq marker (org-id-find org-index-id 'marker))
+ (unless marker (org-index--create-missing-index "Cannot find the node with id \"%s\" (as specified by variable org-index-id)." org-index-id))
+ ; Try again with new node
+ (setq marker (org-id-find org-index-id 'marker))
+ (unless marker (error "Could not create node"))
+ (setq org-index--buffer (marker-buffer marker)
+ org-index--point (marker-position marker))
+ (move-marker marker nil)))
+
+
+(defun org-index--retrieve-context ()
+ "Collect context information before starting with command."
+
+ ;; Get the content of the active region or the word under cursor
+ (setq org-index--active-region
+ (if (and transient-mark-mode mark-active)
+ (buffer-substring (region-beginning) (region-end))
+ nil))
+ (setq org-index--below-cursor (thing-at-point 'symbol))
+
+ ;; get category of current node
+ (setq org-index--category-before
+ (save-excursion ; workaround: org-get-category does not give category when at end of buffer
+ (beginning-of-line)
+ (org-get-category (point) t)))
+
+ ;; Find out, if we are within index table or not
+ (setq org-index--within-node (string= (org-id-get) org-index-id)))
+
+
+(defun org-index--parse-table ()
+ "Parse content of index table."
+
+ (let (ref-field
+ id-field
+ initial-point
+ end-of-headings
+ start-of-headings)
+
+ (with-current-buffer org-index--buffer
+
+ (setq org-index--maxref 0)
+ (setq initial-point (point))
+
+ (org-index--go-below-hline)
+
+ ;; align and fontify table once for this emacs session
+ (unless org-index--aligned
+ (org-table-align) ; needs to happen before fontification to be effective ?
+ (let ((is-modified (buffer-modified-p))
+ (below (point)))
+ (while (org-at-table-p)
+ (forward-line))
+ (font-lock-fontify-region below (point))
+ (org-index--go-below-hline)
+ (setq org-index--aligned t)
+ (set-buffer-modified-p is-modified)))
+
+ (org-index--go-below-hline)
+ (setq org-index--below-hline (point-marker))
+ (beginning-of-line)
+
+ ;; get headings to display during occur
+ (setq end-of-headings (point))
+ (while (org-at-table-p) (forward-line -1))
+ (forward-line)
+ (setq start-of-headings (point))
+ (setq org-index--headings-visible (substring-no-properties (org-index--copy-visible start-of-headings end-of-headings)))
+ (setq org-index--headings (buffer-substring start-of-headings end-of-headings))
+
+ ;; count columns
+ (org-table-goto-column 100)
+ (setq org-index--numcols (- (org-table-current-column) 1))
+
+ ;; go to top of table
+ (while (org-at-table-p)
+ (forward-line -1))
+ (forward-line)
+
+ ;; parse line of headings
+ (org-index--parse-headings)
+
+ ;; parse list of flags
+ (goto-char org-index--point)
+ (org-index--parse-flags)
+
+ ;; Retrieve any decorations around the number within the first nonempty ref-field
+ (goto-char org-index--below-hline)
+ (while (and (org-at-table-p)
+ (not (setq ref-field (org-index--get-or-set-field 'ref))))
+ (forward-line))
+
+ ;; Some Checking
+ (unless ref-field
+ (org-index--report-index-error "Reference column is empty"))
+
+ (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
+ (org-index--report-index-error
+ "First reference in index table ('%s') does not contain a number" ref-field))
+
+ ;; These are the decorations used within the first ref of index
+ (setq org-index--head (match-string 1 ref-field))
+ (setq org-index--tail (match-string 3 ref-field))
+ (setq org-index--ref-regex (concat (regexp-quote org-index--head)
+ "\\([0-9]+\\)"
+ (regexp-quote org-index--tail)))
+ (setq org-index--ref-format (concat org-index--head "%d" org-index--tail))
+
+ ;; Go through table to find maximum number and do some checking
+ (let ((ref 0))
+
+ (while (org-at-table-p)
+
+ (setq ref-field (org-index--get-or-set-field 'ref))
+ (setq id-field (org-index--get-or-set-field 'id))
+
+ (when (and (not ref-field)
+ (not id-field))
+ (kill-whole-line)
+ (message "Removing line from index-table with both ref and id empty"))
+
+ (if ref-field
+ (if (string-match org-index--ref-regex ref-field)
+ ;; grab number
+ (setq ref (string-to-number (match-string 1 ref-field)))
+ (kill-whole-line)
+ (message "Removing line from index-table whose ref does not contain a number")))
+
+ ;; check, if higher ref
+ (if (> ref org-index--maxref) (setq org-index--maxref ref))
+
+ (forward-line 1)))
+
+ ;; go back to initial position
+ (goto-char initial-point))))
+
+
+(defun org-index--do-maintain ()
+ "Choose among and perform some tasks to maintain index."
+ (let ((check-what) (max-mini-window-height 1.0) message-text)
+ (setq check-what (intern (org-completing-read "These checks and fixes are available:\n - statistics : compute statistics about index table\n - check : check ids by visiting their nodes\n - duplicates : check index for duplicate rows (any column)\n - clean : remove obsolete property org-index-id\n - update : update content of index lines, with an id \nPlease choose: " (list "statistics" "check" "duplicates" "clean" "update") nil t nil nil "statistics")))
+ (message nil)
+
+ (cond
+ ((eq check-what 'check)
+ (setq message-text (or (org-index--check-ids)
+ "No problems found")))
+
+ ((eq check-what 'statistics)
+ (setq message-text (org-index--do-statistics)))
+
+ ((eq check-what 'duplicates)
+ (setq message-text "Finding duplcates can be done by sorting your index appropriately: Choose 'group-by' and select a column; rows will then be sorted together, if they have the same value within the coosen column."))
+
+ ((eq check-what 'clean)
+ (let ((lines 0))
+ (org-map-entries
+ (lambda ()
+ (when (org-entry-get (point) "org-index-ref")
+ (incf lines)
+ (org-entry-delete (point) "org-index-ref")))
+ nil 'agenda)
+ (setq message-text (format "Removed property 'org-index-ref' from %d lines" lines))))
+
+ ((eq check-what 'update)
+ (if (y-or-n-p "Updating your index will overwrite certain columns with content from the associated heading and category. If unsure, you may try this for a single, already existing line of your index by doing `add' from within your index. Are you SURE to proceed for ALL INDEX LINES ? ")
+ (setq message-text (org-index--update-all-lines))
+ (setq message-text "Canceled."))))
+ message-text))
+
+
+(defun org-index--do-sort-index (sort &optional groups)
+ "Sort index table according to SORT, optinally with GROUPS."
+
+ (let ((is-modified (buffer-modified-p))
+ top
+ bottom
+ ref-field
+ count-field)
+
+ (unless buffer-read-only
+
+ (message "Sorting table for %s..." (symbol-name sort))
+ (undo-boundary)
+
+ (let ((message-log-max nil)) ; we have just issued a message, dont need those of sort-subr
+
+ ;; get boundaries of table
+ (goto-char org-index--below-hline)
+ (forward-line 0)
+ (setq top (point))
+ (while (org-at-table-p) (forward-line))
+
+ ;; kill all empty rows at bottom
+ (while (progn
+ (forward-line -1)
+ (org-table-goto-column 1)
+ (and
+ (not (org-index--get-or-set-field 'ref))
+ (not (org-index--get-or-set-field 'id))))
+ (org-table-kill-row))
+ (forward-line 1)
+ (setq bottom (point))
+
+ ;; sort lines
+ (save-restriction
+ (narrow-to-region top bottom)
+ (goto-char top)
+ (sort-subr t
+ 'forward-line
+ 'end-of-line
+ (lambda ()
+ (concat
+ (if groups
+ (format "%06d-" (cdr (assoc (org-index--get-or-set-field sort) groups)))
+ "")
+ (org-index--get-sort-key sort t)))
+ nil
+ 'string<)
+ (goto-char (point-min))
+
+ ;; restore modification state
+ (set-buffer-modified-p is-modified)))
+
+ (setq org-index--last-sort sort))))
+
+
+(defun org-index--collect-sort-groups (sort)
+ "Collect groups to SORT for."
+ (let ((count-groups 0) (count-lines 0)
+ groups key key-value)
+
+ (org-index--on
+ nil nil
+ (while (org-at-table-p)
+ (setq key (org-index--get-or-set-field sort))
+ (setq key-value (assoc key groups))
+ (if key-value
+ (progn
+ (incf (cdr key-value)))
+ (setq groups (cons (cons key 1) groups)))
+ (forward-line)))
+
+ (mapc (lambda (x) (when (> (cdr x) 1)
+ (incf count-groups)
+ (incf count-lines (cdr x))))
+ groups)
+
+ (list groups count-groups count-lines)))
+
+
+(defun org-index--do-sort-lines (what)
+ "Sort lines in WHAT according to contained reference."
+ (save-restriction
+ (cond
+ ((eq what 'region)
+ (if (region-active-p)
+ (narrow-to-region (region-beginning) (region-end))
+ (error "No active region, cannot sort")))
+ ((eq what 'buffer)
+ (unless (y-or-n-p "Sort whole current buffer ? ")
+ (error "Canceled"))
+ (narrow-to-region (point-min) (point-max))))
+
+ (goto-char (point-min))
+ (sort-subr nil 'forward-line 'end-of-line
+ (lambda ()
+ (if (looking-at (concat ".*"
+ (org-index--make-guarded-search org-index--ref-regex 'dont-quote)))
+ (string-to-number (match-string 1))
+ 0)))))
+
+
+(defun org-index--go-below-hline ()
+ "Move below hline in index-table."
+
+ (let ((count 0)
+ (errstring (format "index table within node %s" org-index-id)))
+
+ (goto-char org-index--point)
+
+ ;; go to heading of node
+ (while (not (org-at-heading-p)) (forward-line -1))
+ (forward-line 1)
+
+ ;; go to first table, but make sure we do not get into another node
+ (while (and (not (org-at-table-p))
+ (not (org-at-heading-p))
+ (not (eobp)))
+ (forward-line))
+
+ ;; check, if there really is a table
+ (unless (org-at-table-p)
+ (org-index--create-missing-index "Cannot find %s." errstring))
+
+ ;; go just after hline
+ (while (and (not (org-at-table-hline-p))
+ (org-at-table-p))
+ (forward-line))
+ (forward-line)
+
+ ;; and check
+ (unless (org-at-table-p)
+ (org-index--report-index-error "Cannot find a hline within %s" errstring))
+
+ (org-table-goto-column 1)))
+
+
+(defun org-index--parse-headings ()
+ "Parse headings of index table."
+
+ (let (field ;; field content
+ field-symbol ;; and as a symbol
+ found)
+
+ (setq org-index--columns nil)
+
+ ;; For each column
+ (dotimes (col org-index--numcols)
+
+ (setq field (substring-no-properties (downcase (org-trim (org-table-get-field (+ col 1))))))
+
+ (if (string= field "")
+ (error "Heading of column cannot be empty"))
+ (if (and (not (string= (substring field 0 1) "."))
+ (not (member (intern field) org-index--valid-headings)))
+
+ (if (string= field "link")
+ ;; Ask user to migrate his index to new version (since [2015-02-11 Mi])
+ (progn
+ ;; pop to index buffer
+ (pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--below-hline)
+ (org-reveal t)
+ ;; go to column
+ (while (org-at-table-p)
+ (forward-line -1))
+ (forward-line)
+ (org-table-goto-column (+ 1 col))
+ (error "Column 'link' should be named 'id' with recent versions of org-index,\nplease adjust your table (cursor is already positioned right)"))
+ (error "Column name '%s' is not a valid heading (custom headings may start with a dot, e.g. '.foo')" field)))
+
+ (setq field-symbol (intern field))
+
+ ;; check if heading has already appeared
+ (if (assoc field-symbol org-index--columns)
+ (org-index--report-index-error
+ "'%s' appears two times as column heading" (downcase field))
+ ;; add it to list at front, reverse later
+ (setq org-index--columns (cons (cons field-symbol (+ col 1)) org-index--columns)))))
+
+ (setq org-index--columns (reverse org-index--columns))
+
+ ;; check if all necessary headings have appeared
+ (mapc (lambda (head)
+ (unless (cdr (assoc head org-index--columns))
+ (org-index--report-index-error "No column has heading '%s'" head)))
+ org-index--required-headings))
+
+
+(defun org-index--parse-flags ()
+ "Parse list of flags in index table."
+
+ (let (parent parent-is-comment child)
+
+ ;; reset configuration variables
+ (setq org-index--special-columns nil)
+ (setq org-index--flagged-columns nil)
+
+ (org-index--goto-list "columns-and-flags" t)
+ (forward-line 1)
+
+ ;; outer loop over columns
+ (while (and (setq parent (org-index--parse-list-item))
+ parent
+ (> (cdr (assoc :indent parent)) 0))
+
+ (setq parent-is-comment (member (cdr (assoc :text parent)) '("all-columns-explained" "all-flags-explained")))
+
+ ;; check, that we have a valid heading
+ (unless (or parent-is-comment
+ (assoc (cdr (assoc :sym parent)) org-index--columns))
+ (when (string= "link" (cdr (assoc :text parent)))
+ (pop-to-buffer-same-window org-index--buffer)
+ (org-reveal t)
+ (error "Flag 'link' should be named 'id' with recent versions of org-index,\nplease adjust this flag (cursor is already positioned right)"))
+ (org-index--report-index-error "'%s' appears within flags, but not as a index column. " (cdr (assoc :text parent))))
+
+ ;; inner loop over children
+ (while (and (forward-line 1)
+ (setq child (org-index--parse-list-item))
+ child
+ (> (cdr (assoc :indent child))
+ (cdr (assoc :indent parent))))
+
+ (unless parent-is-comment
+ ;; check, that we have a valid flag
+ (unless (memq (cdr (assoc :sym child)) org-index--all-flags)
+ (org-index--report-index-error "'%s' is not a valid flag" (cdr (assoc :text child))))
+
+ ;; process flag with respect to current index-column
+ (if (memq (cdr (assoc :sym child)) org-index--single-flags)
+ ;; Check, that none of org-index--single-flags appears twice
+ (if (assoc (cdr (assoc :sym child)) org-index--special-columns)
+ (org-index--report-index-error
+ "More than one column is marked with flag '%s'" (cdr (assoc :text child)))
+ ;; add it to list
+ (setq org-index--special-columns (cons (cons (cdr (assoc :sym child)) (cdr (assoc :sym parent)))
+ org-index--special-columns))))
+
+ ;; all flags are stored in org-index--flagged-columns
+ (let ((l (assoc (cdr (assoc :sym child)) org-index--flagged-columns))) ;; list of flag and columns, that carry this flag
+ (unless l
+ ;; no list of columns with this flag is present, create one
+ (setq org-index--flagged-columns
+ (cons (cons (cdr (assoc :sym child)) nil)
+ org-index--flagged-columns))
+ (setq l (car org-index--flagged-columns)))
+ ;; prepend this column to list of columns with this flag
+ (setcdr l (cons (cdr (assoc :sym parent)) (cdr l)))))))
+
+ ;; check, that all needed flags have been specified
+ (mapc (lambda (x)
+ (unless (assoc x org-index--special-columns)
+ (org-index--report-index-error "Required flag '%s' does not appear" (substring (symbol-name x) 1))))
+ org-index--required-flags)))
+
+
+(defun org-index--goto-list (name &optional required non-top)
+ "Goto list NAME (maybe NON-TOP Level) in index node, err if REQUIRED list is not present."
+ (goto-char org-index--point)
+
+ ;; go to heading of node
+ (while (not (org-at-heading-p)) (forward-line -1))
+ (forward-line 1)
+
+ ;; go to named list
+ (while (and (not (let ((item (org-index--parse-list-item)))
+ (if item
+ (and (or non-top (= (cdr (assoc :indent item)) 0)) ;; accept only toplevel ?
+ (string= (cdr (assoc :text item)) name)) ;; with requested name
+ nil)))
+ (not (org-at-table-p))
+ (not (org-at-heading-p))
+ (not (eobp)))
+ (forward-line 1))
+
+ (if (org-at-item-p)
+ t
+ (if required
+ (org-index--report-index-error "Could not find required list '%s'" name)
+ nil)))
+
+
+(defun org-index--parse-list-item ()
+ "Parse a list item into an assoc array (indent, checkbox, text, value)."
+
+ ;; matche full list-item, maybe with checkbox and double-colon
+ (if (looking-at org-list-full-item-re)
+
+ ;; retrieve interesting parts of list item from match data
+ (let (indent checkbox text value next-line)
+
+ (setq indent
+ (- (save-excursion (goto-char (match-beginning 1)) (current-column)) ; first column
+ (save-match-data (org-current-level)) ; indent-level
+ 1))
+ (setq checkbox (match-string 3))
+ (setq text (match-string 4))
+ (set (if text 'value 'text) (buffer-substring (match-end 0) (line-end-position))) ; regexp did not capture this
+
+ ;; peek ahead, if item continues on next line
+ (forward-line 1)
+ (if (looking-at org-list-full-item-re)
+ (forward-line -1) ; already at next item; go back
+ (setq next-line (buffer-substring (line-beginning-position) (line-end-position))))
+
+ ;; clean up strings
+ (mapc (lambda (x)
+ (if (stringp (symbol-value x))
+ (set x (org-trim (substring-no-properties (symbol-value x))))))
+ '(text value next-line))
+
+ (if next-line (setq text (concat text " " next-line))) ; append next line if
+
+ (list (cons :indent indent) (cons :text text) (cons :value value) (cons :sym (intern text))))
+ nil))
+
+
+(defun org-index--create-missing-index (&rest reasons)
+ "Create a new empty index table with detailed explanation. Argument REASONS explains why."
+
+ (org-index--ask-before-create-index "Cannot find your index table: "
+ "new permanent" "."
+ reasons)
+ (org-index--create-index))
+
+
+(defun org-index--report-index-error (&rest reasons)
+ "Report an error (explained by REASONS) with the existing index and offer to create a valid one to compare with."
+
+ (when org-index--buffer
+ (pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--below-hline)
+ (org-reveal t))
+ (org-index--ask-before-create-index "The existing index contains this error: "
+ "temporary" ", to compare with."
+ reasons)
+ (org-index--create-index t t))
+
+
+(defun org-index--ask-before-create-index (explanation type for-what reasons)
+ ; checkdoc-params: (explanation type for-what reasons)
+ "Ask the user before creating an index or throw error. Arguments specify bits of issued message."
+ (let (reason prompt)
+
+ (setq reason (apply 'format reasons))
+
+ (setq prompt (concat explanation reason "\n\n"
+ "However, this assistant can help you to create a "
+ type " index with detailed comments" for-what "\n\n"
+ "Do you want to proceed ?"))
+
+ (unless (let ((max-mini-window-height 1.0))
+ (y-or-n-p prompt))
+ (error (concat explanation reason)))))
+
+
+(defun org-index--create-index (&optional temporary compare)
+ "Create a new empty index table with detailed explanation.
+specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existing index."
+ (let (buffer
+ title
+ firstref
+ id)
+
+ (if temporary
+ (let ((file-name (concat temporary-file-directory "org-index--example-index.org"))
+ (buffer-name "*org-index-example-index*"))
+ (setq buffer (get-buffer-create buffer-name))
+ (with-current-buffer buffer
+ ;; but it needs a file for its index to be found
+ (unless (string= (buffer-file-name) file-name)
+ (set-visited-file-name file-name))
+ (rename-buffer buffer-name) ; name is change by line above
+
+ (erase-buffer)
+ (org-mode)))
+
+ (setq buffer (get-buffer (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list))))))
+
+ (setq title (read-from-minibuffer "Please enter the title of the index node: "))
+
+ (while (progn
+ (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: "))
+ (let (desc)
+ (when (string-match "[[:blank:]]" firstref)
+ (setq desc "Contains whitespace"))
+ (when (string-match "[[:cntrl:]]" firstref)
+ (setq desc "Contains control characters"))
+ (unless (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)
+ ;; firstref not okay, report details
+ (setq desc
+ (cond ((string= firstref "") "is empty")
+ ((not (string-match "^[^0-9]+" firstref)) "starts with a digit")
+ ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number")
+ ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits")
+
+ )))
+ (if desc
+ (progn
+ (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s.\nPlease hit RET and try again: " firstref desc))
+ t)
+ nil))))
+
+ (with-current-buffer buffer
+ (goto-char (point-max))
+ (insert (format "* %s %s\n" firstref title))
+ (if temporary
+ (insert "
+ Below you find your temporary index table, which WILL NOT LAST LONGER
+ THAN YOUR CURRENT EMACS SESSION.
+")
+ (insert "
+ Below you find your initial index table, which will grow over time.
+"))
+ (insert "
+ You may start using it by adding some lines. Just move to
+ another heading, invoke `org-index' and choose the command
+ 'add'. After adding a few nodes, try the command 'occur'
+ to search among them.
+
+ To gain further insight you may invoke the subcommand 'help', or
+ read the description of `org-index'.
+
+ Within the index table below, dhe sequence of columns does not
+ matter. You may reorder them in any way you please. Columns are
+ found by their heading. You may also add your own columns,
+ which should start with a dot (e.g. '.custom').
+
+ Following this explanations you will find the item-list
+ `columns-and-flags', which influences the behaviour of
+ `org-index'. See the explanations which are part of this list.
+
+ This node needs not be a top level node; its name is completely
+ at your choice; it is found through its ID only.
+")
+ (unless temporary
+ (insert "
+ Remark: These lines of explanation can be removed at any time.
+"))
+
+ (setq id (org-id-get-create))
+ (insert (format "
+%s
+
+
+ | ref | category | keywords | count | last-accessed | created | id |
+ | | | | | | | <4> |
+ |-----+-----------+----------+-------+---------------+---------+------|
+ | %s | | %s | | | %s | %s |
+
+"
+ org-index--sample-flags
+ firstref
+ "This node"
+ (with-temp-buffer (org-insert-time-stamp nil nil t))
+ id))
+
+ ;; make sure, that node can be found
+ (org-id-add-location id (buffer-file-name))
+ (setq buffer-save-without-query t)
+ (basic-save-buffer)
+
+ (while (not (org-at-table-p)) (forward-line -1))
+ (unless buffer-read-only (org-table-align))
+ (while (not (org-at-heading-p)) (forward-line -1))
+
+ ;; read back some info about new index
+ (let ((org-index-id id))
+ (org-index--verify-id))
+
+ ;; remember at least for this session
+ (setq org-index-id id)
+
+ ;; present results to user
+ (if temporary
+ (progn
+ ;; Present existing and temporary index together
+ (when compare
+ (pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--point)
+ (org-index--unfold-buffer)
+ (delete-other-windows)
+ (select-window (split-window-vertically)))
+ ;; show new index
+ (pop-to-buffer-same-window buffer)
+ (org-id-goto id)
+ (org-index--unfold-buffer)
+ (if compare
+ (error "Please compare your existing index (upper window) and a temporary new one (lower window) to fix your index")
+ (message "This is your new temporary index.")))
+ (progn
+ ;; Only show the new index
+ (pop-to-buffer-same-window buffer)
+ (delete-other-windows)
+ (org-id-goto id)
+ (org-index--unfold-buffer)
+ (if (y-or-n-p "This is your new index table. It is already set for this Emacs session, so you may try it out. Do you want to save its id to make it available for future Emacs sessions too ? ")
+ (progn
+ (customize-save-variable 'org-index-id id)
+ (error "Saved org-index-id '%s' to %s" id (or custom-file
+ user-init-file)))
+ (let (sq)
+ (setq sq (format "(setq org-index-id \"%s\")" id))
+ (kill-new sq)
+ (error "Did not make the id of this new index permanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it" sq))))))))
+
+
+(defun org-index--unfold-buffer ()
+ "Helper function to unfold buffer."
+ (org-show-context)
+ (org-show-subtree)
+ (recenter 1)
+ (save-excursion
+ (org-back-to-heading)
+ (forward-line) ;; on property drawer
+ (org-cycle)
+ (org-index--goto-list "columns-and-flags")
+ (org-cycle)))
+
+
+(defun org-index--update-line (&optional ref-or-id)
+ "Update columns count and last-accessed in line REF-OR-ID."
+
+ (let ((newcount 0)
+ initial)
+
+ (with-current-buffer org-index--buffer
+ (unless buffer-read-only
+
+ ;; search reference or id, if given (or assume, that we are already positioned right)
+ (when ref-or-id
+ (setq initial (point))
+ (goto-char org-index--below-hline)
+ (while (and (org-at-table-p)
+ (not (or (string= ref-or-id (org-index--get-or-set-field 'ref))
+ (string= ref-or-id (org-index--get-or-set-field 'id)))))
+ (forward-line)))
+
+ (if (not (org-at-table-p))
+ (error "Did not find reference or id '%s'" ref-or-id)
+ (org-index--update-current-line))
+
+ (if initial (goto-char initial))))))
+
+
+(defun org-index--update-current-line ()
+ "Update current lines columns count and last-accessed."
+ (let (newcount (count-field (org-index--get-or-set-field 'count)))
+
+ ;; update count field only if number or empty
+ (when (or (not count-field)
+ (string-match "^[0-9]+$" count-field))
+ (setq newcount (+ 1 (string-to-number (or count-field "0"))))
+ (org-index--get-or-set-field 'count
+ (number-to-string newcount)))
+
+ ;; update timestamp
+ (org-table-goto-column (org-index--column-num 'last-accessed))
+ (org-table-blank-field)
+ (org-insert-time-stamp nil t t)
+
+ ;; move line according to new content
+ (org-index--promote-current-line)
+ (org-index--align-and-fontify-current-line)))
+
+
+(defun org-index--align-and-fontify-current-line ()
+ "Make current line blend well among others."
+ (let ((line (substring-no-properties (delete-and-extract-region (line-beginning-position) (line-end-position)))))
+ ;; create minimum table with fixed-width columns to align and fontiry new line
+ (insert (with-temp-buffer
+ (org-set-font-lock-defaults)
+ (insert org-index--headings-visible)
+ (goto-char (point-min))
+ ;; fill columns, so that aligning cannot shrink them
+ (search-forward "|")
+ (replace-string " " "." nil (point) (line-end-position))
+ (replace-string ".|." " | " nil (line-beginning-position) (line-end-position))
+ (replace-string "|." "| " nil (line-beginning-position) (line-end-position))
+ (goto-char (point-max))
+ (insert line)
+ (forward-line 0)
+ (org-table-align)
+ (font-lock-fontify-region (point-min) (point-max))
+ (goto-char (point-max))
+ (forward-line -1)
+ (buffer-substring (line-beginning-position) (line-end-position))))))
+
+
+(defun org-index--promote-current-line ()
+ "Move current line up in table according to changed sort fields."
+ (let (begin end key
+ (to-skip 0))
+
+ (forward-line 0) ; stay at beginning of line
+
+ (setq key (org-index--get-sort-key))
+ (setq begin (point))
+ (setq end (line-beginning-position 2))
+
+ (forward-line -1)
+ (while (and (org-at-table-p)
+ (not (org-at-table-hline-p))
+ (string< (org-index--get-sort-key) key))
+
+ (incf to-skip)
+ (forward-line -1))
+ (forward-line 1)
+
+ ;; insert line at new position
+ (when (> to-skip 0)
+ (insert (delete-and-extract-region begin end))
+ (forward-line -1))))
+
+
+(defun org-index--get-sort-key (&optional sort with-ref)
+ "Get value for sorting from column SORT, optional WITH-REF."
+ (let (ref
+ ref-field
+ key)
+
+ (unless sort (setq sort org-index--last-sort)) ; use default value
+
+ (when (or with-ref
+ (eq sort 'ref))
+ ;; get reference with leading zeroes, so it can be
+ ;; sorted as text
+ (setq ref-field (org-index--get-or-set-field 'ref))
+ (string-match org-index--ref-regex ref-field)
+ (setq ref (format
+ "%06d"
+ (string-to-number
+ (or (match-string 1 ref-field)
+ "0")))))
+
+ (setq key
+ (cond
+ ((eq sort 'count)
+ (format "%08d" (string-to-number (or (org-index--get-or-set-field 'count) ""))))
+ ((eq sort 'ref)
+ ref)
+ ((eq sort 'id)
+ (org-index--get-or-set-field sort))
+ ((eq sort 'last-accessed)
+ (org-index--get-or-set-field sort))
+ ((eq sort 'created)
+ (org-index--get-or-set-field sort))
+ (t (error "This is a bug: unmatched case '%s'" sort))))
+
+ (if with-ref (setq key (concat key ref)))
+
+ key))
+
+
+(defun org-index--get-or-set-field (key &optional value)
+ "Retrieve field KEY from index table or set it to VALUE."
+ (let (field)
+ (save-excursion
+ (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))
+ (if (string= field "") (setq field nil))
+
+ (org-no-properties field))))
+
+
+(defun org-index--column-num (key)
+ "Return number of column KEY."
+ (if (numberp key)
+ key
+ (cdr (assoc key org-index--columns))))
+
+
+(defun org-index--special-column (key)
+ "Return column (not a number) for special column KEY."
+ (cdr (assoc key org-index--special-columns)))
+
+
+(defun org-index--flag-p (flag column)
+ "Check if COLUMN has FLAG set."
+ (unless (memq flag org-index--all-flags)
+ (error (format "Internal error: unknown flag %s" (symbol-name flag))))
+ (memq column (assoc flag org-index--flagged-columns)))
+
+
+(defun org-index--make-guarded-search (ref &optional dont-quote)
+ "Make robust search string from REF; DONT-QUOTE it, if requested."
+ (concat "\\_<" (if dont-quote ref (regexp-quote ref)) "\\_>"))
+
+
+(defun org-index--do-statistics ()
+ "Compute statistics about index table."
+ (let ((total 0)
+ ref-field ref min max message)
+
+
+ ;; go through table and remove all refs, that we see
+ (goto-char org-index--below-hline)
+ (while (org-at-table-p)
+
+ ;; get ref-field and number
+ (setq ref-field (org-index--get-or-set-field 'ref))
+ (if (and ref-field
+ (string-match org-index--ref-regex ref-field))
+ (setq ref (string-to-number (match-string 1 ref-field))))
+
+ ;; record min and max
+ (if (or (not min) (< ref min)) (setq min ref))
+ (if (or (not max) (> ref max)) (setq max ref))
+
+ ;; count
+ (setq total (1+ total))
+
+ (forward-line))
+
+ (setq message (format "First reference is %s, last %s; %d values in between, %d of them are used (%d percent)"
+ (format org-index--ref-format min)
+ (format org-index--ref-format max)
+ (1+ (- max min))
+ total
+ (truncate (* 100 (/ (float total) (1+ (- max min)))))
+
+))
+
+ (goto-char org-index--below-hline)
+ message))
+
+
+(defun org-index--do-add-or-update ()
+ "For current node or current line in index, add a new line to index table or update existing."
+
+ (let* (id ref args yank ref-and-yank)
+
+ ;; do the same things from within index and from outside
+ (if org-index--within-node
+
+ (progn
+ (unless (org-at-table-p)
+ (error "Within index node but not on table"))
+
+ (setq id (org-index--get-or-set-field 'id))
+ (setq ref (org-index--get-or-set-field 'ref))
+ (setq args (org-index--collect-values-for-add-update-remote id))
+ (org-index--write-fields-for-add-update args)
+ (setq yank (org-index--get-or-set-field (org-index--special-column 'yank-after-add)))
+
+ (cons (format "Updated index line %s" ref) yank))
+
+ (unless (org-at-heading-p)
+ (error "Not at headline"))
+
+ (setq id (org-id-get-create))
+ (setq ref (org-index--on 'id id (org-index--get-or-set-field 'ref)))
+ (setq args (org-index--collect-values-for-add-update id ref))
+
+ (if ref
+ ;; already have a ref, find it in index and update fields
+ (let ((kvs args)
+ found-and-message)
+
+ (org-index--on
+ 'ref ref
+ (org-index--write-fields-for-add-update args)
+ (setq yank (org-index--get-or-set-field (org-index--special-column 'yank-after-add))))
+
+ (cons (format "Updated index line %s" ref) yank))
+
+ ;; no ref here, create new line in index
+ (setq ref-and-yank (apply 'org-index--do-new-line args))
+
+ (cons (format "Added index line %s" (car ref-and-yank)) (concat (cdr ref-and-yank) " "))))))
+
+
+(defun org-index--check-ids ()
+ "Check, that ids really point to a node."
+
+ (let ((lines 0)
+ id ids marker)
+
+ (goto-char org-index--below-hline)
+
+ (catch 'problem
+ (while (org-at-table-p)
+
+ (when (setq id (org-index--get-or-set-field 'id))
+
+ ;; check for double ids
+ (when (member id ids)
+ (org-table-goto-column (org-index--column-num 'id))
+ (throw 'problem "This id appears twice in index; please use command 'maintain' to check for duplicate ids"))
+ (incf lines)
+ (setq ids (cons id ids))
+
+ ;; check, if id is valid
+ (setq marker (org-id-find id t))
+ (unless marker
+ (org-table-goto-column (org-index--column-num 'id))
+ (throw 'problem "This id cannot be found")))
+
+ (forward-line))
+
+ (goto-char org-index--below-hline)
+ nil)))
+
+
+(defun org-index--update-all-lines ()
+ "Update all lines of index at once."
+
+ (let ((lines 0)
+ id ref kvs)
+
+ ;; check for double ids
+ (or
+ (org-index--check-ids)
+
+ (progn
+ (goto-char org-index--below-hline)
+ (while (org-at-table-p)
+
+ ;; update single line
+ (when (setq id (org-index--get-or-set-field 'id))
+ (setq ref (org-index--get-or-set-field 'ref))
+ (setq kvs (org-index--collect-values-for-add-update-remote id))
+ (org-index--write-fields-for-add-update kvs)
+ (incf lines))
+ (forward-line))
+
+ (goto-char org-index--below-hline)
+ (org-table-align)
+ (format "Updated %d lines" lines)))))
+
+
+(defun org-index--collect-values-for-add-update (id &optional silent category)
+ "Collect values for adding or updating line specified by ID, do not ask if SILENT, use CATEGORY, if given."
+
+ (let ((args (list 'ref t 'id id))
+ content)
+
+ (dolist (col-num org-index--columns)
+
+ (setq content "")
+
+ (if (eq (car col-num) 'keywords)
+ (setq content (nth 4 (org-heading-components))))
+
+ (if (eq (car col-num) 'category)
+ (setq content (or category org-index--category-before)))
+
+ (if (eq (car col-num) 'level)
+ (setq content (number-to-string (org-outline-level))))
+
+ ;; Shift ref and timestamp ?
+ (if (org-index--flag-p 'shift-ref-and-date-on-add (car col-num))
+ (dotimes (i 2)
+ (if (or (string-match (concat "^\\s-*" org-index--ref-regex) content)
+ (string-match (concat org-ts-regexp-both) content))
+ (setq content (substring content (match-end 0))))))
+
+ (if (and (not silent) ; do not edit, if heading has already been added
+ (org-index--flag-p 'edit-on-add (car col-num)))
+ (setq content (read-from-minibuffer
+ (format "Edit text for column '%s': " (symbol-name (car col-num)))
+ content)))
+
+ (if (not (string= content ""))
+ (setq args (append (list (car col-num) content) args))))
+ args))
+
+
+(defun org-index--collect-values-for-add-update-remote (id)
+ "Wrap `org-index--collect-values-for-add-update' by prior moving to remote node identified by ID."
+
+ (let (marker point args)
+
+ (setq marker (org-id-find id t))
+ ;; enter buffer and collect information
+ (with-current-buffer (marker-buffer marker)
+ (setq point (point))
+ (goto-char marker)
+ (setq args (org-index--collect-values-for-add-update id t (org-get-category (point) t)))
+ (goto-char point))
+
+ args))
+
+
+(defun org-index--write-fields-for-add-update (kvs)
+ "Update current line with values from KVS (keys-values)."
+ (while kvs
+ (unless (eq (car kvs) 'ref)
+ (org-index--get-or-set-field (car kvs) (org-trim (cadr kvs))))
+ (setq kvs (cddr kvs))))
+
+
+(defun org-index--do-delete ()
+ "Perform command delete."
+
+ (unless (org-at-heading-p)
+ (error "Not at headline"))
+
+ (let* ((id (org-entry-get (point) "ID"))
+ (ref (org-index--ref-from-id id)))
+
+ ;; maybe delete from heading
+ (if ref
+ (save-excursion
+ (end-of-line)
+ (let ((end (point)))
+ (beginning-of-line)
+ (when (search-forward ref end t)
+ (delete-char (- (length ref)))
+ (just-one-space)))))
+
+ ;; delete from index table
+ (if (org-index--delete-line id)
+ (format "Deleted index line %s" ref)
+ (format "Did not find id %s in index" id))))
+
+
+(defun org-index--go (&optional column value)
+ "Position cursor on index line where COLUMN equals VALUE.
+Return t or nil, leave point on line or at top of table, needs to be in buffer initially."
+ (let (found text)
+
+ (unless (eq (current-buffer) org-index--buffer)
+ (error "This is a bug: Not in index buffer"))
+
+ ;; loop over lines
+ (goto-char org-index--below-hline)
+ (if column
+ (progn
+ (forward-line -1)
+ (while (and (not found)
+ (forward-line)
+ (org-at-table-p))
+ (setq found (string= value (org-index--get-or-set-field column)))))
+ (setq found t))
+
+ ;; return value
+ (if found
+ t
+ (goto-char org-index--below-hline)
+ nil)))
+
+
+(defun org-index--do-head (ref id &optional other)
+ "Perform command head: Find node with REF or ID and present it.
+If OTHER in separate window."
+
+ (setq org-index--last-ref ref)
+
+ (let (message marker)
+
+ (setq marker (org-id-find id t))
+
+ (if marker
+ (progn
+ (org-index--update-line id)
+ (let (cb)
+ (if other
+ (progn
+ (setq cb (current-buffer))
+ (pop-to-buffer (marker-buffer marker)))
+ (pop-to-buffer-same-window (marker-buffer marker)))
+
+ (goto-char marker)
+ (org-reveal t)
+ (org-show-entry)
+ (recenter))
+ (setq message (format "Found headline %s" ref)))
+ (setq message (format "Did not find headline %s" ref)))))
+
+
+(defun org-index--do-occur ()
+ "Perform command occur."
+ (let ((word "") ; last word to search for growing and shrinking on keystrokes
+ (prompt "Search for: ")
+ (lines-wanted (window-body-height))
+ (lines-found 0) ; number of lines found
+ words ; list words that should match
+ occur-buffer
+ begin ; position of first line
+ narrow ; start of narrowed buffer
+ help-text ; cons with help text short and long
+ key-help ; for keys with special function
+ search-text ; description of text to search for
+ done ; true, if loop is done
+ in-c-backspace ; true, while processing C-backspace
+ show-headings ; true, if headings should be shown
+ help-overlay ; Overlay with help text
+ last-point ; Last position before end of search
+ key ; input from user
+ key-sequence) ; as a sequence
+
+
+ ;; make and show buffer
+ (if (get-buffer org-index--occur-buffer-name)
+ (kill-buffer org-index--occur-buffer-name))
+ (setq occur-buffer (make-indirect-buffer org-index--buffer org-index--occur-buffer-name))
+ (pop-to-buffer-same-window occur-buffer)
+ ;; avoid modifying direct buffer
+ (setq buffer-read-only t)
+ (toggle-truncate-lines 1)
+ (setq font-lock-keywords-case-fold-search t)
+ (setq case-fold-search t)
+
+ ;; reset stack and overlays
+ (setq org-index--occur-stack nil)
+ (setq org-index--occur-tail-overlay nil)
+
+ ;; narrow to table rows and one line before
+ (goto-char (marker-position org-index--below-hline))
+ (forward-line 0)
+ (setq begin (point))
+ (forward-line -1)
+ (setq narrow (point))
+ (while (org-at-table-p)
+ (forward-line))
+ (narrow-to-region narrow (point))
+ (goto-char (point-min))
+ (forward-line)
+
+ ;; initialize help text
+ (setq help-text (cons
+ "Incremental occur; `?' toggles help and headlines.\n"
+ (concat
+ (org-index--wrap
+ (concat
+ "Normal keys add to search word; <space> or <comma> start additional word; <backspace> erases last char, <C-backspace> last word; <return> jumps to heading, <tab> jumps to heading in other window; all other keys end search.\n"))
+ org-index--headings)))
+
+ ;; insert overlays for help text and to cover unsearched lines
+ (setq help-overlay (make-overlay (point-min) begin))
+ (overlay-put help-overlay 'display (car help-text))
+ (overlay-put help-overlay 'face 'org-agenda-dimmed-todo-face)
+ (setq org-index--occur-tail-overlay (make-overlay (point-max) (point-max)))
+ (overlay-put org-index--occur-tail-overlay 'invisible t)
+
+ (while (not done)
+
+ (if in-c-backspace
+ (setq key "<backspace>")
+ (setq search-text (mapconcat 'identity (reverse (cons word words)) ","))
+ ;; read key
+ (setq key-sequence
+ (vector (read-key
+ (format "%s%s%s"
+ prompt
+ search-text
+ (if (string= search-text "") "" " ")))))
+ (setq key (key-description key-sequence)))
+
+ (cond
+
+
+ ((string= key "<C-backspace>")
+ (setq in-c-backspace t))
+
+
+ ((member key (list "<backspace>" "DEL")) ; erase last char
+
+ (if (= (length word) 0)
+
+ ;; nothing more to delete from current word; try next
+ (progn
+ (setq word (car words))
+ (setq words (cdr words))
+ (setq in-c-backspace nil))
+
+ ;; unhighlight longer match
+ (unhighlight-regexp (regexp-quote word))
+
+ ;; some chars are left; shorten word
+ (setq word (substring word 0 -1))
+ (when (= (length word) 0) ; when nothing left, use next word from list
+ (setq word (car words))
+ (setq words (cdr words))
+ (setq in-c-backspace nil))
+
+ ;; free top list of overlays and remove list
+ (setq lines-found (or (org-index--unhide) lines-wanted))
+ (move-overlay org-index--occur-tail-overlay
+ (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
+ (point-max))
+ (point-max))
+
+
+ ;; highlight shorter word
+ (unless (= (length word) 0)
+ (highlight-regexp (regexp-quote word) 'isearch))
+
+ ;; make sure, point is still visible
+ (goto-char begin)))
+
+
+ ((member key (list "SPC" ",")) ; space or comma: enter an additional search word
+
+ ;; push current word and clear, no need to change display
+ (setq words (cons word words))
+ (setq word ""))
+
+
+ ((string= key "?") ; question mark: toggle display of headlines and help
+ (setq help-text (cons (cdr help-text) (car help-text)))
+ (overlay-put help-overlay 'display (car help-text)))
+
+ ((and (= (length key) 1)
+ (aref printable-chars (elt key 0))) ; any printable char: add to current search word
+
+ ;; unhighlight short word
+ (unless (= (length word) 0)
+ (unhighlight-regexp (regexp-quote word)))
+
+ ;; add to word
+ (setq word (concat word key))
+
+ ;; make overlays to hide lines, that do not match longer word any more
+ (goto-char begin)
+ (setq lines-found (org-index--hide-with-overlays (cons word words) lines-wanted))
+ (move-overlay org-index--occur-tail-overlay
+ (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
+ (point-max))
+ (point-max))
+
+ (goto-char begin)
+
+ ;; highlight longer word
+ (highlight-regexp (regexp-quote word) 'isearch)
+
+ ;; make sure, point is on a visible line
+ (line-move -1 t)
+ (line-move 1 t))
+
+ ;; anything else terminates loop
+ (t (setq done t))))
+
+ ;; put back input event, that caused the loop to end
+ (unless (string= key "C-g")
+ (setq unread-command-events (listify-key-sequence key-sequence))
+ (message key))
+
+ ;; postprocessing
+ (setq last-point (point))
+
+ ;; For performance reasons do not show matching lines for rest of table. So no code here.
+
+ ;; make permanent copy
+ ;; copy visible lines
+ (let ((lines-collected 0)
+ keymap line all-lines end-of-head)
+
+ (setq cursor-type t)
+ (goto-char begin)
+
+ ;; collect all visible lines
+ (while (and (not (eobp))
+ (< lines-collected lines-wanted))
+ ;; skip over invisible lines
+ (while (and (invisible-p (point))
+ (not (eobp)))
+ (goto-char (1+ (overlay-end (car (overlays-at (point)))))))
+ (setq line (buffer-substring (line-beginning-position) (line-end-position)))
+ (unless (string= line "")
+ (incf lines-collected)
+ (setq all-lines (cons (concat line
+ "\n")
+ all-lines)))
+ (forward-line 1))
+
+ (kill-buffer org-index--occur-buffer-name) ; cannot keep this buffer; might become stale soon
+
+ ;; create new buffer
+ (setq occur-buffer (get-buffer-create org-index--occur-buffer-name))
+ (pop-to-buffer-same-window occur-buffer)
+ (insert org-index--headings)
+ (setq end-of-head (point))
+
+ ;; insert into new buffer
+ (save-excursion
+ (apply 'insert (reverse all-lines))
+ (if (= lines-collected lines-wanted)
+ (insert "\n(more lines omitted)\n")))
+
+ (org-mode)
+ (setq truncate-lines t)
+ (if (org-at-table-p) (org-table-align))
+ (font-lock-fontify-buffer)
+
+ ;; prepare help text
+ (setq org-index--occur-help-overlay (make-overlay (point-min) end-of-head))
+ (setq org-index--occur-help-text
+ (cons
+ (org-index--wrap
+ (concat "Search is done; `?' toggles help and headlines.\n"))
+ (concat
+ (org-index--wrap (format (concat "Search is done. "
+ (if (< lines-collected lines-wanted)
+ " Showing all %d matches for "
+ " Showing one window of matches for ")
+ "\"" search-text
+ "\". <return> jumps to heading, <tab> jumps to heading in other window, <S-return> to matching line in index, <space> increments count.\n" )
+ (length all-lines)))
+ org-index--headings)))
+
+ (overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text))
+ (overlay-put org-index--occur-help-overlay 'face 'org-agenda-dimmed-todo-face)
+
+ ;; highlight words
+ (setq case-fold-search t)
+ (setq font-lock-keywords-case-fold-search t)
+ (mapc (lambda (w) (unless (or (not w) (string= w "")) (highlight-regexp (regexp-quote w) 'isearch)))
+ (cons word words))
+
+ (setq buffer-read-only t)
+
+ ;; install keyboard-shortcuts
+ (setq keymap (make-sparse-keymap))
+ (set-keymap-parent keymap org-mode-map)
+
+ (mapc (lambda (x) (define-key keymap (kbd x)
+ (lambda () (interactive)
+ (message "%s" (org-index--occur-to-head)))))
+ (list "<return>" "RET"))
+
+ (define-key keymap (kbd "<tab>")
+ (lambda () (interactive)
+ (message (org-index--occur-to-head t))))
+
+ (define-key keymap (kbd "SPC")
+ (lambda () (interactive)
+ ;; increment in index
+ (let ((ref (org-index--get-or-set-field 'ref))
+ count)
+ (org-index--on
+ 'ref ref
+ (setq count (+ 1 (string-to-number (org-index--get-or-set-field 'count))))
+ (org-index--get-or-set-field 'count (number-to-string count))
+ (org-index--promote-current-line)
+ (org-index--align-and-fontify-current-line))
+ ;; increment in this buffer
+ (let ((inhibit-read-only t))
+ (org-index--get-or-set-field 'count (number-to-string count)))
+ (message "Incremented count to %d" count))))
+
+ (define-key keymap (kbd "<S-return>")
+ (lambda () (interactive)
+ (org-index 'enter (org-index--get-or-set-field 'ref))))
+
+ (define-key keymap (kbd "?")
+ (lambda () (interactive)
+ (setq-local org-index--occur-help-text (cons (cdr org-index--occur-help-text) (car org-index--occur-help-text)))
+ (overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text))))
+
+ (use-local-map keymap))))
+
+
+(defun org-index--wrap (text)
+ "Wrap TEXT at fill column."
+ (with-temp-buffer
+ (insert text)
+ (fill-region (point-min) (point-max) nil t)
+ (buffer-string)))
+
+
+(defun org-index--occur-to-head (&optional other)
+ "Helper for `org-index--occur', find heading with ref or id; if OTHER, in other window."
+ (let ((ref (org-index--get-or-set-field 'ref))
+ (id (org-index--get-or-set-field 'id)))
+ (if id
+ (org-index--do-head ref id other)
+ (message "Current line has no id."))))
+
+
+(defun org-index--hide-with-overlays (words lines-wanted)
+ "Hide text that is currently visible and does not match WORDS by creating overlays; leave LINES-WANTED lines visible."
+ (let ((lines-found 0)
+ (end-of-visible (point))
+ overlay overlays start matched)
+
+ ;; main loop
+ (while (and (not (eobp))
+ (< lines-found lines-wanted))
+
+ ;; skip invisible lines
+ (while (and (not (eobp))
+ (and
+ (invisible-p (point))
+ (< (point) (overlay-start org-index--occur-tail-overlay))))
+ (goto-char (overlay-end (car (overlays-at (point))))))
+
+ ;; find stretch of lines, that are currently visible but should be invisible now
+ (setq matched nil)
+ (setq start (point))
+ (while (and (not (eobp))
+ (not
+ (and
+ (invisible-p (point))
+ (< (point) (overlay-start org-index--occur-tail-overlay))))
+ (not (and (org-index--test-words words)
+ (setq matched t)))) ; for its side effect
+ (forward-line 1))
+
+ ;; create overlay to hide this stretch
+ (when (< start (point)) ; avoid creating an empty overlay
+ (setq overlay (make-overlay start (point)))
+ (overlay-put overlay 'invisible t)
+ (setq overlays (cons overlay overlays)))
+
+ ;; skip and count line, that matched
+ (when matched
+ (forward-line 1)
+ (setq end-of-visible (point))
+ (incf lines-found)))
+
+ ;; put new list on top of stack
+ (setq org-index--occur-stack
+ (cons (list (cons :overlays overlays)
+ (cons :end-of-visible end-of-visible)
+ (cons :lines lines-found))
+ org-index--occur-stack))
+
+ lines-found))
+
+
+(defun org-index--unhide ()
+ "Unhide text that does has been hidden by `org-index--hide-with-overlays'."
+ (when org-index--occur-stack
+ ;; delete overlays and make visible again
+ (mapc (lambda (y)
+ (delete-overlay y))
+ (cdr (assoc :overlays (car org-index--occur-stack))))
+ ;; remove from stack
+ (setq org-index--occur-stack (cdr org-index--occur-stack))
+ ;; return number of lines, that are now visible
+ (if org-index--occur-stack (cdr (assoc :lines (car org-index--occur-stack))))))
+
+
+(defun org-index--test-words (words)
+ "Test current line for match against WORDS."
+ (let (line)
+ (setq line (downcase (buffer-substring (line-beginning-position) (line-beginning-position 2))))
+ (catch 'not-found
+ (dolist (w words)
+ (or (search w line)
+ (throw 'not-found nil)))
+ t)))
+
+
+(defun org-index--create-new-line ()
+ "Do the common work for `org-index-new-line' and `org-index'."
+
+ (let (new)
+
+ ;; construct new reference
+ (unless new
+ (setq new (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail)))
+
+ ;; insert ref or id as last or first line, depending on sort-column
+ (goto-char org-index--below-hline)
+ (if (eq (org-index--special-column 'sort) 'count)
+ (progn
+ (while (org-at-table-p)
+ (forward-line))
+ (forward-line -1)
+ (org-table-insert-row t))
+ (org-table-insert-row))
+
+ ;; insert some of the standard values
+ (org-table-goto-column (org-index--column-num 'created))
+ (org-insert-time-stamp nil nil t)
+ (org-table-goto-column (org-index--column-num 'count))
+ (insert "1")
+
+ new))
+
+
+(defun org-index--sort-silent ()
+ "Sort index for default column to remove any effects of temporary sorting."
+ (save-excursion
+ (org-index--verify-id)
+ (org-index--parse-table)
+ (org-index--on nil nil
+ (org-index--do-sort-index (org-index--special-column 'sort))
+ (org-table-align)
+ (remove-hook 'before-save-hook 'org-index--sort-silent))))
+
+
+(defun org-index--copy-visible (beg end)
+ "Copy the visible parts of the region without adding it to kill-ring; copy of `org-copy-visible'"
+ (let (snippets s)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (setq s (goto-char (point-min)))
+ (while (not (= (point) (point-max)))
+ (goto-char (org-find-invisible))
+ (push (buffer-substring s (point)) snippets)
+ (setq s (goto-char (org-find-visible))))))
+ (apply 'concat (nreverse snippets))))
+
+
+(provide 'org-index)
+
+;; Local Variables:
+;; fill-column: 75
+;; comment-column: 50
+;; End:
+
+;;; org-index.el ends here
diff --git a/contrib/lisp/org-jira.el b/contrib/lisp/org-jira.el
deleted file mode 100644
index 43edd08..0000000
--- a/contrib/lisp/org-jira.el
+++ /dev/null
@@ -1,64 +0,0 @@
-;;; org-jira.el --- add a jira:ticket protocol to Org
-(defconst org-jira-version "0.1")
-;; Copyright (C) 2008-2014 Jonathan Arkell.
-;; Author: Jonathan Arkell <jonnay@jonnay.net>
-
-;; This file is not part of GNU Emacs.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation version 2.
-
-;; 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:
-;; This adds a jira protocol to org mode.
-
-;;; Commands:
-;;
-;; Below are complete command list:
-;;
-;;
-;;; Customizable Options:
-;;
-;; Below are customizable option list:
-;;
-
-;; I had initially planned on adding bi-directional linking, so you
-;; could store links from a jira ticket. I also wanted to import
-;; tickets assigned to you as a task. However, I am no longer working
-;; with JIRA, so this is now abandonware.
-
-;;; Installation:
-;; Put org-jira.el somewhere in your load-path.
-;; (Use M-x show-variable RET load-path to see what your load path is.)
-;; Add this to your emacs init file, preferably after you load org mode.
-;(require 'org-jira)
-
-;;; TODO:
-;; - bi-directional links
-;; - deeper importing, like tasks...?
-
-;;; CHANGELOG:
-;; v 0.2 - ran through checkdoc
-;; - Abandoned.
-;; v 0.1 - Initial release
-
-(require 'jira)
-
-(org-add-link-type "jira" 'org-jira-open)
-
-(defun org-jira-open (path)
- "Open a Jira Link from PATH."
- (jira-show-issue path))
-
-
-(provide 'org-jira)
-
-;;; org-jira.el ends here
diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el
new file mode 100644
index 0000000..426b148
--- /dev/null
+++ b/contrib/lisp/org-license.el
@@ -0,0 +1,540 @@
+;;; org-license.el --- Add a license to your org files
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: David Arroyo Menéndez <davidam@es.gnu.org>
+;; Keywords: licenses, creative commons
+;; Homepage: http://orgmode.org
+;;
+;; This file is not part of GNU Emacs, yet.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements functions to add a license fast in org files.
+;; Org-mode doesn't load this module by default - if this is not what
+;; you want, configure the variable `org-modules'. Thanks to #emacs-es
+;; irc channel for your support.
+
+;;; Code:
+
+;;
+;;
+;; You can download the images from http://www.davidam/img/licenses.tar.gz
+;;
+;;; CHANGELOG:
+;; v 0.2 - add public domain functions
+;; v 0.1 - Initial release
+
+
+(defvar org-license-images-directory "")
+
+(defun org-license-cc-by (language)
+ (interactive "MLanguage ( br | ca | de | en | es | eo | eu | fi | fr | gl | it | jp | nl | pt ): " language)
+ (cond ((equal language "br")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/br/deed.pt_BR")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Brasil]]\n")))
+ ((equal language "ca")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.ca")
+ (insert (concat "* Licència
+El text està disponible sota la [[" org-license-cc-url "][Reconeixement 3.0 Espanya]]\n")))
+ ((equal language "de")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/de/deed.de")
+ (insert (concat "* Lizenz
+Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Lizenz Creative Commons Namensnennung 3.0 Deutschland]]\n")))
+ ((equal language "eo")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/eo/deed.eo")
+ (insert (concat "* Licenco
+Ĉi tiu verko estas disponebla laŭ la permesilo [[" org-license-cc-url "][Krea Komunaĵo Atribuite 3.0 Neadaptita]]\n")))
+ ((equal language "es")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/es/deed.es")
+ (insert (concat "* Licencia
+Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución 3.0 España]]\n")))
+ ((equal language "eu")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/es/deed.eu")
+ (insert (concat "* Licenzua
+Testua [[" org-license-cc-url "][Aitortu 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
+ ((equal language "fi")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/1.0/fi/deed.fi")
+ (insert (concat "* Lisenssi
+Teksti on saatavilla [[" org-license-cc-url "][Nimeä 1.0 Suomi]] lisenssillä\n")))
+ ((equal language "fr")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/fr/deed.fr")
+ (insert (concat "* Licence
+Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution 3.0 France]]\n")))
+ ((equal language "gl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/es/deed.gl")
+ (insert (concat "* Licenza
+Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
+ ((equal language "it")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/it/deed.it")
+ (insert (concat "* Licenza
+Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione 3.0 Italia]]\n")))
+ ((equal language "jp")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/2.1/jp/deed.en")
+ (insert (concat "* ライセンス
+この文書は [[" org-license-cc-url "][Creative Commons Attribution 2.1 ]] ライセンスの下である\n")))
+ ((equal language "nl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/nl/deed.nl")
+ (insert (concat "* Licentie
+Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding 3.0 Nederland]]\n")))
+ ((equal language "pt")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/pt/deed.pt")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Portugal]]\n")))
+ (t
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/4.0/deed")
+ (concat (insert "* License
+This document is under a [[" org-license-cc-url "][Creative Commons Attribution 4.0 International]]\n"))))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by/3.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by/3.0/80x15.png]]\n"))))
+
+(defun org-license-cc-by-sa (language)
+ (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp | nl | pt ): " language)
+ (cond ((equal language "br")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/br/deed.pt_BR")
+ (concat (insert "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n")))
+ ((equal language "ca")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.ca")
+ (insert (concat "* Licència
+El text està disponible sota la [[" org-license-cc-url "][Reconeixement-CompartirIgual 3.0 Espanya]]\n")))
+ ((equal language "de")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/de/deed.de")
+ (insert (concat "* Lizenz
+Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n")))
+ ((equal language "es")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.es")
+ (concat (insert "* Licencia
+Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución Compartir por Igual 3.0 España]]\n")))
+ ((equal language "eu")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.eu")
+ (concat (insert "* Licenzua
+Testua [[" org-license-cc-url "][Aitortu-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
+ ((equal language "fi")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/1.0/fi/deed.fi")
+ (insert (concat "* Lisenssi
+Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
+ ((equal language "fr")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/fr/deed.fr")
+ (concat (insert "* Licence
+Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Partage dans les Mêmes Conditions 3.0 France]]\n")))
+ ((equal language "gl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.gl")
+ (insert (concat "* Licenza
+Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
+ ((equal language "it")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/it/deed.it")
+ (insert (concat "* Licenza
+Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Condividi allo stesso modo 3.0 Italia]]\n")))
+ ((equal language "jp")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/2.1/jp/deed.en")
+ (insert (concat "* ライセンス
+この文書は、[[" org-license-cc-url "][Creative Commons Attribution 2.1 ]] ライセンスの下である\n")))
+ ((equal language "nl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/nl/deed.nl")
+ (insert (concat "* Licentie
+Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding Gelijk Delen 3.0 Nederland]]\n")))
+ ((equal language "pt")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/pt/deed.pt")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição-CompartilhaIgual 3.0 Portugal]]\n")))
+ (t
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/4.0/deed")
+ (insert (concat "* License
+This document is under a [[" org-license-cc-url "][Creative Commons Attribution-ShareAlike 4.0 International]]\n"))))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-sa/3.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-sa/3.0/80x15.png]]\n"))))
+
+(defun org-license-cc-by-nd (language)
+ (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | pt ): " language)
+ (cond ((equal language "br")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/br/deed.pt_BR")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n")))
+ ((equal language "ca")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/es/deed.ca")
+ (insert (concat "* Licència
+El text està disponible sota la [[" org-license-cc-url "][Reconeixement-SenseObraDerivada 3.0 Espanya]]\n")))
+ ((equal language "de")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/de/deed.de")
+ (insert (concat "* Lizenz
+Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-Keine Bearbeitung 3.0 Deutschland]]\n")))
+ ((equal language "es")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/es/deed.es")
+ (insert (concat "* Licencia
+Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución-SinDerivadas 3.0]]\n")))
+ ((equal language "eu")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/es/deed.eu")
+ (insert (concat "* Licenzua
+Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
+ ((equal language "fi")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/1.0/fi/deed.fi")
+ (insert (concat "* Lisenssi
+Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
+ ((equal language "fr")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/fr/deed.fr")
+ (insert (concat "* Licence
+Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas de Modification 3.0 France]]\n")))
+ ((equal language "gl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/es/deed.gl")
+ (insert (concat "* Licenza
+Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
+ ((equal language "it")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/it/deed.it")
+ (insert (concat "* Licenza
+Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
+ ((equal language "jp")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/2.1/jp/deed.en")
+ (insert (concat "* ライセンス
+この文書は、[[" org-license-cc-url "][Creative Commons No Derivatives 2.1]] ライセンスの下である\n")))
+ ((equal language "nl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/nl/deed.nl")
+ (insert (concat "* Licentie
+Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding GeenAfgeleideWerken 3.0 Nederland]]\n")))
+ ((equal language "pt")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/pt/deed.pt")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Sem Derivados 3.0 Portugal]]\n")))
+ (t
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/4.0/deed")
+ (insert (concat "* License
+This document is under a [[" org-license-cc-url "][Creative Commons No Derivatives 4.0 International]]\n"))))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nd/3.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nd/3.0/80x15.png]]\n"))))
+
+
+(defun org-license-cc-by-nc (language)
+ (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp | nl | pt ): " language)
+ (cond ((equal language "br")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/br/deed.pt_BR")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Brasil]]\n")))
+ ((equal language "ca")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/es/deed.ca")
+ (insert (concat "* Licència
+El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial 3.0 Espanya]]\n")))
+ ((equal language "de")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/de/deed.de")
+ (insert (concat "* Lizenz
+Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-Nicht-kommerziell 3.0 Deutschland]]\n")))
+ ((equal language "es")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/es/deed.es")
+ (insert (concat "* Licencia
+Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial 3.0]]\n")))
+ ((equal language "eu")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/es/deed.eu")
+ (insert "* Licenzua
+Testua [[" org-license-cc-url "][Aitortu-EzKomertziala 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))
+ ((equal language "fi")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/1.0/fi/deed.fi")
+ (insert (concat "* Lisenssi
+Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen 1.0 Suomi]] lisenssillä\n")))
+ ((equal language "fr")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/fr/deed.fr")
+ (insert (concat "* Licence
+Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas d'Utilisation Commerciale 3.0 France]]\n")))
+ ((equal language "gl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/es/deed.gl")
+ (insert (concat "* Licenza
+Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
+ ((equal language "it")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/it/deed.it")
+ (insert (concat "* Licenza
+Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non commerciale 3.0 Italia]]\n")))
+ ((equal language "jp")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/2.1/jp/deed.en")
+ (insert (concat "* ライセンス
+この文書は、[[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 2.1 ]] ライセンスの下である\n")))
+ ((equal language "nl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/nl/deed.nl")
+ (insert (concat "* Licentie
+Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel 3.0 Nederland 3.0 Nederland]]\n")))
+ ((equal language "pt")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Portugal]]\n")))
+ (t
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/4.0/deed")
+ (insert (concat "* License
+This document is under a [[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 4.0 International]]\n"))))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc/3.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc/3.0/80x15.png]]\n"))))
+
+(defun org-license-cc-by-nc-sa (language)
+ (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it | jp | nl | pt ): " language)
+ (cond ((equal language "br")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/br/deed.pt_BR")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial - Compartil ha Igual 3.0 Brasil]]\n")))
+ ((equal language "ca")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.ca")
+ (insert (concat "* Licència
+El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial 3.0 Espanya]]\n")))
+ ((equal language "de")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/de/deed.de")
+ (insert (concat "* Lizenz
+Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n")))
+ ((equal language "es")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.es")
+ (insert (concat "* Licencia
+Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial 3.0]]\n")))
+ ((equal language "eu")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.eu")
+ (insert "* Licenzua
+Testua [[" org-license-cc-url "][Aitortu-EzKomertziala-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))
+ ((equal language "fi")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/1.0/fi/deed.fi")
+ (insert (concat "* Lisenssi
+Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
+ ((equal language "fr")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/fr/deed.fr")
+ (insert (concat "* Licence
+Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas d’Utilisation Commerciale - Partage dans les Mêmes Conditions 3.0 France]]\n")))
+ ((equal language "gl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.gl")
+ (insert (concat "* Licenza
+Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
+ ((equal language "it")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/it/deed.it")
+ (insert (concat "* Licenza
+Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
+ ((equal language "jp")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/2.1/jp/deed.en")
+ (insert (concat "* ライセンス
+この文書は、[[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 2.1 ]] ライセンスの下である\n")))
+ ((equal language "nl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/nl/deed.nl")
+ (insert (concat "* Licentie
+Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel GelijkDelen 3.0 Nederland]]\n")))
+ ((equal language "pt")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição NãoComercial Compartil ha Igual 3.0 Portugal]]\n")))
+ (t
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/4.0/deed")
+ (insert (concat "* License
+This document is under a [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 4.0 International]]\n"))))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc-sa/3.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-sa/3.0/80x15.png]]\n"))))
+
+(defun org-license-cc-by-nc-nd (language)
+ (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it | pt ): " language)
+ (cond ((equal language "br")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Brasil]]\n")))
+ ((equal language "ca")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.ca")
+ (insert (concat "* Licència
+El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial-SenseObraDerivada 3.0 Espanya]]\n")))
+ ((equal language "de")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/de/deed.de")
+ (insert (concat "* Lizenz
+Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-NichtKommerziell-KeineBearbeitung 3.0 Deutschland]]\n")))
+ ((equal language "es")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.es")
+ (insert (concat "* Licencia
+Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial-SinObraDerivada 3.0]]\n")))
+ ((equal language "eu")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.eu")
+ (insert (concat "* Licenzua
+Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
+ ((equal language "fi")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/1.0/fi/deed.fi")
+ (insert (concat "* Lisenssi
+Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Ei muutoksia-Epäkaupallinen 1.0 Suomi]] lisenssillä\n")))
+ ((equal language "fr")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/fr/deed.fr")
+ (insert (concat "* Licence
+Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas de Modification 3.0 France]]\n")))
+ ((equal language "gl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.gl")
+ (insert (concat "* Licenza
+Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
+ ((equal language "it")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/it/deed.it")
+ (insert (concat "* Licenza
+Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
+ ((equal language "jp")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/2.1/jp/deed.en")
+ (insert (concat "* ライセンス
+この文書は [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial - No Derivs 2.1]] ライセンスの下である\n")))
+ ((equal language "nl")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/nl/deed.nl")
+ (insert (concat "* Licentie
+Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel GeenAfgeleideWerken 3.0 Nederland]]\n")))
+ ((equal language "pt")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt")
+ (insert (concat "* Licença
+Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Portugal]]\n")))
+ (t
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/4.0/deed")
+ (insert (concat "* License
+This document is under a [[" org-license-cc-url "][License Creative Commons Attribution-NonCommercial-NoDerivatives 4.0 International]]\n"))))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc-nd/3.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-nd/3.0/80x15.png]]\n"))))
+
+(defun org-license-gfdl (language)
+ (interactive "MLanguage (es | en): " language)
+ (cond ((equal language "es")
+ (insert "* Licencia
+Copyright (C) " (format-time-string "%Y") " " user-full-name
+"\n Se permite copiar, distribuir y/o modificar este documento
+ bajo los términos de la GNU Free Documentation License, Version 1.3
+ o cualquier versión publicada por la Free Software Foundation;
+ sin Secciones Invariantes y sin Textos de Portada o Contraportada.
+ Una copia de la licencia está incluida en [[https://www.gnu.org/copyleft/fdl.html][GNU Free Documentation License]].\n"))
+ (t (insert (concat "* License
+Copyright (C) " (format-time-string "%Y") " " user-full-name
+"\n Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.3
+ or any later version published by the Free Software Foundation;
+ with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
+ A copy of the license is included in [[https://www.gnu.org/copyleft/fdl.html][GNU Free Documentation License]].\n"))))
+ (if (string= "" org-license-images-directory)
+ (insert "\n[[https://www.gnu.org/copyleft/fdl.html][file:https://upload.wikimedia.org/wikipedia/commons/thumb/4/42/GFDL_Logo.svg/200px-GFDL_Logo.svg.png]]\n")
+ (insert (concat "\n[[https://www.gnu.org/copyleft/fdl.html][file:" org-license-images-directory "/gfdl/gfdl.png]]\n"))))
+
+(defun org-license-publicdomain-zero (language)
+ (interactive "MLanguage ( en | es ): " language)
+ (setq org-license-pd-url "http://creativecommons.org/publicdomain/zero/1.0/")
+ (setq org-license-pd-file "zero/1.0/80x15.png")
+ (if (equal language "es")
+ (insert (concat "* Licencia
+Este documento está bajo una licencia [[" org-license-pd-url "][Public Domain Zero]]\n"))
+ (insert (concat "* License
+This documento is under a [[" org-license-pd-url "][Public Domain Zero]] license\n")))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-pd-url "][file:http://i.creativecommons.org/p/zero/1.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n"))))
+
+(defun org-license-publicdomain-mark (language)
+ (interactive "MLanguage ( en | es ): " language)
+ (setq org-license-pd-url "http://creativecommons.org/publicdomain/mark/1.0/")
+ (setq org-license-pd-file "mark/1.0/80x15.png")
+ (if (equal language "es")
+ (insert (concat "* Licencia
+Este documento está bajo una licencia [[" org-license-pd-url "][Etiqueta de Dominio Público 1.0]]\n"))
+ (insert (concat "* License
+This documento is under a [[" org-license-pd-url "][Public Domain Mark]] license\n")))
+ (if (string= "" org-license-images-directory)
+ (insert (concat "\n[[" org-license-pd-url "][file:http://i.creativecommons.org/p/mark/1.0/80x15.png]]\n"))
+ (insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n"))))
+
+(defun org-license-print-all ()
+"Print all combinations of licenses and languages, it's useful to find bugs"
+ (interactive)
+ (org-license-gfdl "es")
+ (org-license-gfdl "en")
+ (org-license-publicdomain-mark "es")
+ (org-license-publicdomain-mark "en")
+ (org-license-publicdomain-zero "es")
+ (org-license-publicdomain-zero "en")
+ (org-license-cc-by "br")
+ (org-license-cc-by "ca")
+ (org-license-cc-by "de")
+ (org-license-cc-by "es")
+ (org-license-cc-by "en")
+ (org-license-cc-by "eo")
+ (org-license-cc-by "eu")
+ (org-license-cc-by "fi")
+ (org-license-cc-by "fr")
+ (org-license-cc-by "gl")
+ (org-license-cc-by "it")
+ (org-license-cc-by "jp")
+ (org-license-cc-by "nl")
+ (org-license-cc-by "pt")
+ (org-license-cc-by-sa "br")
+ (org-license-cc-by-sa "ca")
+ (org-license-cc-by-sa "de")
+ (org-license-cc-by-sa "es")
+ (org-license-cc-by-sa "en")
+;; (org-license-cc-by-sa "eo")
+ (org-license-cc-by-sa "eu")
+ (org-license-cc-by-sa "fi")
+ (org-license-cc-by-sa "fr")
+ (org-license-cc-by-sa "gl")
+ (org-license-cc-by-sa "it")
+ (org-license-cc-by-sa "jp")
+ (org-license-cc-by-sa "nl")
+ (org-license-cc-by-sa "pt")
+ (org-license-cc-by-nd "br")
+ (org-license-cc-by-nd "ca")
+ (org-license-cc-by-nd "de")
+ (org-license-cc-by-nd "es")
+ (org-license-cc-by-nd "en")
+;; (org-license-cc-by-nd "eo")
+ (org-license-cc-by-nd "eu")
+ (org-license-cc-by-nd "fi")
+ (org-license-cc-by-nd "fr")
+ (org-license-cc-by-nd "gl")
+ (org-license-cc-by-nd "it")
+ (org-license-cc-by-nd "jp")
+ (org-license-cc-by-nd "nl")
+ (org-license-cc-by-nd "pt")
+ (org-license-cc-by-nc "br")
+ (org-license-cc-by-nc "ca")
+ (org-license-cc-by-nc "de")
+ (org-license-cc-by-nc "es")
+ (org-license-cc-by-nc "en")
+;; (org-license-cc-by-nc "eo")
+ (org-license-cc-by-nc "eu")
+ (org-license-cc-by-nc "fi")
+ (org-license-cc-by-nc "fr")
+ (org-license-cc-by-nc "gl")
+ (org-license-cc-by-nc "it")
+ (org-license-cc-by-nc "jp")
+ (org-license-cc-by-nc "nl")
+ (org-license-cc-by-nc "pt")
+ (org-license-cc-by-nc-sa "br")
+ (org-license-cc-by-nc-sa "ca")
+ (org-license-cc-by-nc-sa "de")
+ (org-license-cc-by-nc-sa "es")
+ (org-license-cc-by-nc-sa "en")
+;; (org-license-cc-by-nc-sa "eo")
+ (org-license-cc-by-nc-sa "eu")
+ (org-license-cc-by-nc-sa "fi")
+ (org-license-cc-by-nc-sa "fr")
+ (org-license-cc-by-nc-sa "gl")
+ (org-license-cc-by-nc-sa "it")
+ (org-license-cc-by-nc-sa "jp")
+ (org-license-cc-by-nc-sa "nl")
+ (org-license-cc-by-nc-sa "pt")
+ (org-license-cc-by-nc-nd "br")
+ (org-license-cc-by-nc-nd "ca")
+ (org-license-cc-by-nc-nd "de")
+ (org-license-cc-by-nc-nd "es")
+ (org-license-cc-by-nc-nd "en")
+;; (org-license-cc-by-nc-nd "eo")
+ (org-license-cc-by-nc-nd "eu")
+ (org-license-cc-by-nc-nd "fi")
+ (org-license-cc-by-nc-nd "fr")
+ (org-license-cc-by-nc-nd "gl")
+ (org-license-cc-by-nc-nd "it")
+ (org-license-cc-by-nc-nd "jp")
+ (org-license-cc-by-nc-nd "nl")
+ (org-license-cc-by-nc-nd "pt")
+)
+
+
diff --git a/contrib/lisp/org-mac-link.el b/contrib/lisp/org-mac-link.el
index fef6692..c991dfa 100644
--- a/contrib/lisp/org-mac-link.el
+++ b/contrib/lisp/org-mac-link.el
@@ -1,13 +1,13 @@
-;;; org-mac-link.el --- Grab links and url from various mac
-;; Application and insert them as links into org-mode documents
+;;; org-mac-link.el --- Insert org-mode links to items selected in various Mac apps
;;
;; Copyright (c) 2010-2014 Free Software Foundation, Inc.
;;
-;; Authors:
-;; Anthony Lander <anthony.lander@gmail.com>
-;; John Wiegley <johnw@gnu.org>
-;; Christopher Suckling <suckling at gmail dot com>
-;; Daniil Frumin <difrumin@gmail.com>
+;; Author: Anthony Lander <anthony.lander@gmail.com>
+;; John Wiegley <johnw@gnu.org>
+;; Christopher Suckling <suckling at gmail dot com>
+;; Daniil Frumin <difrumin@gmail.com>
+;; Alan Schmitt <alan.schmitt@polytechnique.org>
+;; Mike McLean <mike.mclean@pobox.com>
;;
;;
;; Version: 1.1
@@ -57,6 +57,7 @@
;; Together.app - Grab links to the selected items in the library list
;; Skim.app - Grab a link to the selected page in the topmost pdf document
;; Microsoft Outlook.app - Grab a link to the selected message in the message list
+;; DEVONthink Pro Office.app - Grab a link to the selected DEVONthink item(s); open DEVONthink item by reference
;;
;;
;; Installation:
@@ -86,61 +87,66 @@
(require 'org)
(defgroup org-mac-link nil
- "Options concerning grabbing links from external Mac
-applications and inserting them in org documents"
+ "Options for grabbing links from Mac applications."
:tag "Org Mac link"
:group 'org-link)
(defcustom org-mac-grab-Finder-app-p t
- "Enable menu option [F]inder to grab links from the Finder"
+ "Add menu option [F]inder to grab links from the Finder."
:tag "Grab Finder.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Mail-app-p t
- "Enable menu option [m]ail to grab links from Mail.app"
+ "Add menu option [m]ail to grab links from Mail.app."
:tag "Grab Mail.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Outlook-app-p t
- "Enable menu option [o]utlook to grab links from Microsoft Outlook.app"
+ "Add menu option [o]utlook to grab links from Microsoft Outlook.app."
:tag "Grab Microsoft Outlook.app links"
:group 'org-mac-link
:type 'boolean)
+(defcustom org-mac-grab-devonthink-app-p t
+ "Add menu option [d]EVONthink to grab links from DEVONthink Pro Office.app."
+ :tag "Grab DEVONthink Pro Office.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
(defcustom org-mac-grab-Addressbook-app-p t
- "Enable menu option [a]ddressbook to grab links from AddressBook.app"
+ "Add menu option [a]ddressbook to grab links from AddressBook.app."
:tag "Grab AddressBook.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Safari-app-p t
- "Enable menu option [s]afari to grab links from Safari.app"
+ "Add menu option [s]afari to grab links from Safari.app."
:tag "Grab Safari.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Firefox-app-p t
- "Enable menu option [f]irefox to grab links from Firefox.app"
+ "Add menu option [f]irefox to grab links from Firefox.app."
:tag "Grab Firefox.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Firefox+Vimperator-p nil
- "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
+ "Add menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin."
:tag "Grab Vimperator/Firefox.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Chrome-app-p t
- "Enable menu option [f]irefox to grab links from Google Chrome.app"
+ "Add menu option [c]hrome to grab links from Google Chrome.app."
:tag "Grab Google Chrome.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Together-app-p nil
- "Enable menu option [t]ogether to grab links from Together.app"
+ "Add menu option [t]ogether to grab links from Together.app."
:tag "Grab Together.app links"
:group 'org-mac-link
:type 'boolean)
@@ -148,23 +154,23 @@ applications and inserting them in org documents"
(defcustom org-mac-grab-Skim-app-p
(< 0 (length (shell-command-to-string
"mdfind kMDItemCFBundleIdentifier == 'net.sourceforge.skim-app.skim'")))
- "Enable menu option [S]kim to grab page links from Skim.app"
+ "Add menu option [S]kim to grab page links from Skim.app."
:tag "Grab Skim.app page links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-Skim-highlight-selection-p nil
- "Highlight (using notes) the selection (if present) when grabbing the a link from Skim.app"
+ "Highlight the active selection when grabbing a link from Skim.app."
:tag "Highlight selection in Skim.app"
:group 'org-mac-link
:type 'boolean)
(defgroup org-mac-flagged-mail nil
- "Options concerning linking to flagged Mail.app messages."
+ "Options foring linking to flagged Mail.app messages."
:tag "Org Mail.app"
:group 'org-link)
-(defcustom org-mac-mail-account "customize"
+(defcustom org-mac-mail-account nil
"The Mail.app account in which to search for flagged messages."
:group 'org-mac-flagged-mail
:type 'string)
@@ -185,27 +191,32 @@ applications and inserting them in org documents"
(setq return (shell-command-to-string cmd))
(concat "\"" (org-trim return) "\""))))
-
(defun org-mac-grab-link ()
- "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
+ "Prompt for an application to grab a link from.
+When done, go grab the link, and insert it at point."
(interactive)
- (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
- ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
- ("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-app-p)
- ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
- ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
- ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
- ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
- ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
- ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)
- ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
+ (let* ((descriptors
+ `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
+ ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
+ ("d" "EVONthink Pro Office" org-mac-devonthink-item-insert-selected
+ ,org-mac-grab-devonthink-app-p)
+ ("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-app-p)
+ ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
+ ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
+ ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
+ ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
+ ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
+ ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)
+ ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
(menu-string (make-string 0 ?x))
input)
;; Create the menu string for the keymap
(mapc '(lambda (descriptor)
(when (elt descriptor 3)
- (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
+ (setf menu-string (concat menu-string
+ "[" (elt descriptor 0) "]"
+ (elt descriptor 1) " "))))
descriptors)
(setf (elt menu-string (- (length menu-string) 1)) ?:)
@@ -221,12 +232,17 @@ applications and inserting them in org documents"
descriptors)))
(defun org-mac-paste-applescript-links (as-link-list)
- "Paste in a list of links from an applescript handler. The
- links are of the form <link>::split::<name>"
- (let* ((link-list
- (mapcar
- (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
- (split-string as-link-list "[\r\n]+")))
+ "Paste in a list of links from an applescript handler.
+The links are of the form <link>::split::<name>."
+ (let* ((noquote-as-link-list
+ (if (string-prefix-p "\"" as-link-list)
+ (substring as-link-list 1 -1)
+ as-link-list))
+ (link-list
+ (mapcar (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x)
+ (setq x (match-string 1 x)))
+ x)
+ (split-string noquote-as-link-list "[\r\n]+")))
split-link URL description orglink orglink-insert rtn orglink-list)
(while link-list
(setq split-link (split-string (pop link-list) "::split::"))
@@ -240,7 +256,6 @@ applications and inserting them in org documents"
rtn))
-
;; Handle links from Firefox.app
;;
;; This code allows you to grab the current active url from the main
@@ -257,27 +272,28 @@ applications and inserting them in org documents"
;; seems that it is always the last active window).
(defun org-as-mac-firefox-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Firefox\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"l\" using {command down}\n"
- " keystroke \"a\" using {command down}\n"
- " keystroke \"c\" using {command down}\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
+ (let ((result
+ (do-applescript
+ (concat
+ "set oldClipboard to the clipboard\n"
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Firefox\"\n"
+ " activate\n"
+ " delay 0.15\n"
+ " tell application \"System Events\"\n"
+ " keystroke \"l\" using {command down}\n"
+ " keystroke \"a\" using {command down}\n"
+ " keystroke \"c\" using {command down}\n"
+ " end tell\n"
+ " delay 0.15\n"
+ " set theUrl to the clipboard\n"
+ " set the clipboard to oldClipboard\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
(car (split-string result "[\r\n]+" t))))
(defun org-mac-firefox-get-frontmost-url ()
@@ -303,27 +319,28 @@ applications and inserting them in org documents"
;; Firefox
(defun org-as-mac-vimperator-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Firefox\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"y\"\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (replace-regexp-in-string "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
-
+ (let ((result
+ (do-applescript
+ (concat
+ "set oldClipboard to the clipboard\n"
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Firefox\"\n"
+ " activate\n"
+ " delay 0.15\n"
+ " tell application \"System Events\"\n"
+ " keystroke \"y\"\n"
+ " end tell\n"
+ " delay 0.15\n"
+ " set theUrl to the clipboard\n"
+ " set the clipboard to oldClipboard\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (replace-regexp-in-string
+ "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
(defun org-mac-vimperator-get-frontmost-url ()
(interactive)
@@ -348,27 +365,20 @@ applications and inserting them in org documents"
;; Firefox because Chrome doesn't publish an Applescript dictionary
(defun org-as-mac-chrome-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Google Chrome\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"l\" using command down\n"
- " keystroke \"c\" using command down\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (substring (car (split-string result "[\r\n]+" t)) 1 -1)))
+ (let ((result
+ (do-applescript
+ (concat
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Google Chrome\"\n"
+ " set theUrl to get URL of active tab of first window\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (replace-regexp-in-string
+ "^\"\\|\"$" "" (car (split-string result "[\r\n]+" t)))))
(defun org-mac-chrome-get-frontmost-url ()
(interactive)
@@ -392,57 +402,45 @@ applications and inserting them in org documents"
;; Grab the frontmost url from Safari.
(defun org-as-mac-safari-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "tell application \"Safari\"\n"
- " set theUrl to URL of document 1\n"
- " set theName to the name of the document 1\n"
- " return theUrl & \"::split::\" & theName & \"\n\"\n"
- "end tell\n"))))
- (car (split-string result "[\r\n]+" t))))
+ (do-applescript
+ (concat
+ "tell application \"Safari\"\n"
+ " set theUrl to URL of document 1\n"
+ " set theName to the name of the document 1\n"
+ " return theUrl & \"::split::\" & theName & \"\n\"\n"
+ "end tell\n")))
(defun org-mac-safari-get-frontmost-url ()
(interactive)
(message "Applescript: Getting Safari url...")
- (let* ((url-and-title (org-as-mac-safari-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
+ (org-mac-paste-applescript-links
+ (org-as-mac-safari-get-frontmost-url)))
(defun org-mac-safari-insert-frontmost-url ()
(interactive)
(insert (org-mac-safari-get-frontmost-url)))
-;;
-;;
;; Handle links from together.app
-;;
-;;
(org-add-link-type "x-together-item" 'org-mac-together-item-open)
(defun org-mac-together-item-open (uid)
- "Open the given uid, which is a reference to an item in Together"
+ "Open UID, which is a reference to an item in Together."
(shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
(defun as-get-selected-together-items ()
(do-applescript
- (concat
- "tell application \"Together\"\n"
- " set theLinkList to {}\n"
- " set theSelection to selected items\n"
- " repeat with theItem in theSelection\n"
- " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
- " copy theLink to end of theLinkList\n"
- " end repeat\n"
- " return theLinkList as string\n"
- "end tell")))
+ (concat
+ "tell application \"Together\"\n"
+ " set theLinkList to {}\n"
+ " set theSelection to selected items\n"
+ " repeat with theItem in theSelection\n"
+ " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
+ " copy theLink to end of theLinkList\n"
+ " end repeat\n"
+ " return theLinkList as string\n"
+ "end tell")))
(defun org-mac-together-get-selected ()
(interactive)
@@ -452,26 +450,22 @@ applications and inserting them in org documents"
(defun org-mac-together-insert-selected ()
(interactive)
(insert (org-mac-together-get-selected)))
-
-;;
-;;
+
;; Handle links from Finder.app
-;;
-;;
(defun as-get-selected-finder-items ()
(do-applescript
- (concat
- "tell application \"Finder\"\n"
- " set theSelection to the selection\n"
- " set links to {}\n"
- " repeat with theItem in theSelection\n"
- " set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
- " copy theLink to the end of links\n"
- " end repeat\n"
- " return links as string\n"
- "end tell\n")))
+ (concat
+ "tell application \"Finder\"\n"
+ " set theSelection to the selection\n"
+ " set links to {}\n"
+ " repeat with theItem in theSelection\n"
+ " set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
+ " copy theLink to the end of links\n"
+ " end repeat\n"
+ " return links as string\n"
+ "end tell\n")))
(defun org-mac-finder-item-get-selected ()
(interactive)
@@ -483,30 +477,26 @@ applications and inserting them in org documents"
(insert (org-mac-finder-item-get-selected)))
-;;
-;;
;; Handle links from AddressBook.app
-;;
-;;
(org-add-link-type "addressbook" 'org-mac-addressbook-item-open)
(defun org-mac-addressbook-item-open (uid)
- "Open the given uid, which is a reference to an item in Together"
+ "Open UID, which is a reference to an item in the addressbook."
(shell-command (concat "open \"addressbook:" uid "\"")))
(defun as-get-selected-addressbook-items ()
(do-applescript
- (concat
- "tell application \"Address Book\"\n"
- " set theSelection to the selection\n"
- " set links to {}\n"
- " repeat with theItem in theSelection\n"
- " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
- " copy theLink to the end of links\n"
- " end repeat\n"
- " return links as string\n"
- "end tell\n")))
+ (concat
+ "tell application \"Address Book\"\n"
+ " set theSelection to the selection\n"
+ " set links to {}\n"
+ " repeat with theItem in theSelection\n"
+ " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
+ " copy theLink to the end of links\n"
+ " end repeat\n"
+ " return links as string\n"
+ "end tell\n")))
(defun org-mac-addressbook-item-get-selected ()
(interactive)
@@ -517,8 +507,7 @@ applications and inserting them in org documents"
(interactive)
(insert (org-mac-addressbook-item-get-selected)))
-;;
-;;
+
;; Handle links from Skim.app
;;
;; Original code & idea by Christopher Suckling (org-mac-protocol)
@@ -531,40 +520,39 @@ applications and inserting them in org documents"
(match-string 1 uri)))
(document (substring uri 0 (match-beginning 0))))
(do-applescript
- (concat
- "tell application \"Skim\"\n"
- "activate\n"
- "set theDoc to \"" document "\"\n"
- "set thePage to " page "\n"
- "open theDoc\n"
- "go document 1 to page thePage of document 1\n"
- "end tell"))))
-
+ (concat
+ "tell application \"Skim\"\n"
+ "activate\n"
+ "set theDoc to \"" document "\"\n"
+ "set thePage to " page "\n"
+ "open theDoc\n"
+ "go document 1 to page thePage of document 1\n"
+ "end tell"))))
(defun as-get-skim-page-link ()
(do-applescript
+ (concat
+ "tell application \"Skim\"\n"
+ "set theDoc to front document\n"
+ "set theTitle to (name of theDoc)\n"
+ "set thePath to (path of theDoc)\n"
+ "set thePage to (get index for current page of theDoc)\n"
+ "set theSelection to selection of theDoc\n"
+ "set theContent to contents of (get text for theSelection)\n"
+ "if theContent is missing value then\n"
+ " set theContent to theTitle & \", p. \" & thePage\n"
+ (when org-mac-Skim-highlight-selection-p
(concat
- "tell application \"Skim\"\n"
- "set theDoc to front document\n"
- "set theTitle to (name of theDoc)\n"
- "set thePath to (path of theDoc)\n"
- "set thePage to (get index for current page of theDoc)\n"
- "set theSelection to selection of theDoc\n"
- "set theContent to contents of (get text for theSelection)\n"
- "if theContent is missing value then\n"
- " set theContent to theTitle & \", p. \" & thePage\n"
- (when org-mac-Skim-highlight-selection-p
- (concat
- "else\n"
- " tell theDoc\n"
- " set theNote to make note with properties {type:highlight note, selection:theSelection}\n"
- " set text of theNote to (get text for theSelection)\n"
- " end tell\n"))
- "end if\n"
- "set theLink to \"skim://\" & thePath & \"::\" & thePage & "
- "\"::split::\" & theContent\n"
- "end tell\n"
- "return theLink as string\n")))
+ "else\n"
+ " tell theDoc\n"
+ " set theNote to make note with properties {type:highlight note, selection:theSelection}\n"
+ " set text of theNote to (get text for theSelection)\n"
+ " end tell\n"))
+ "end if\n"
+ "set theLink to \"skim://\" & thePath & \"::\" & thePage & "
+ "\"::split::\" & theContent\n"
+ "end tell\n"
+ "return theLink as string\n")))
(defun org-mac-skim-get-page ()
(interactive)
@@ -583,29 +571,25 @@ applications and inserting them in org documents"
(interactive)
(insert (org-mac-skim-get-page)))
-
-;;
-;;
;; Handle links from Microsoft Outlook.app
-;;
(org-add-link-type "mac-outlook" 'org-mac-outlook-message-open)
(defun org-mac-outlook-message-open (msgid)
- "Open a message in outlook"
- (let* ((record-id-string (format "mdfind com_microsoft_outlook_recordID==%s" msgid))
- (found-message (replace-regexp-in-string "\n$" ""
- (shell-command-to-string record-id-string))))
- (if (string= found-message "")
- (message "org-mac-link: error could not find Outlook message %s" (substring-no-properties msgid))
- (shell-command (format "open \"`mdfind com_microsoft_outlook_recordID==%s`\"" msgid)))))
+ "Open a message in Outlook"
+ (do-applescript
+ (concat
+ "tell application \"/Applications/Microsoft Office 2011/Microsoft Outlook.app\"\n"
+ (format "open message id %s\n" (substring-no-properties msgid))
+ "activate\n"
+ "end tell")))
(defun org-as-get-selected-outlook-mail ()
"AppleScript to create links to selected messages in Microsoft Outlook.app."
(do-applescript
(concat
- "tell application \"Microsoft Outlook\"\n"
+ "tell application \"/Applications/Microsoft Office 2011/Microsoft Outlook.app\"\n"
"set msgCount to count current messages\n"
"if (msgCount < 1) then\n"
"return\n"
@@ -680,16 +664,18 @@ The Org-syntax text will be pushed to the kill ring, and also returned."
(defun org-mac-outlook-message-insert-selected ()
"Insert a link to the messages currently selected in Microsoft Outlook.app.
-This will use AppleScript to get the message-id and the subject of the
-active mail in Microsoft Outlook.app and make a link out of it."
+This will use AppleScript to get the message-id and the subject
+of the active mail in Microsoft Outlook.app and make a link out
+of it."
(interactive)
(insert (org-mac-outlook-message-get-links "s")))
(defun org-mac-outlook-message-insert-flagged (org-buffer org-heading)
"Asks for an org buffer and a heading within it, and replace message links.
-If heading exists, delete all mac-outlook:// links within heading's first
-level. If heading doesn't exist, create it at point-max. Insert
-list of mac-outlook:// links to flagged mail after heading."
+If heading exists, delete all mac-outlook:// links within
+heading's first level. If heading doesn't exist, create it at
+point-max. Insert list of mac-outlook:// links to flagged mail
+after heading."
(interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
(with-current-buffer org-buffer
(goto-char (point-min))
@@ -710,17 +696,78 @@ list of mac-outlook:// links to flagged mail after heading."
(org-insert-heading nil t)
(insert org-heading "\n" (org-mac-outlook-message-get-links "f"))))))
+
+;; Handle links from DEVONthink Pro Office.app
+
+(org-add-link-type "x-devonthink-item" 'org-devonthink-item-open)
+
+(defun org-devonthink-item-open (uid)
+ "Open UID, which is a reference to an item in DEVONthink Pro Office."
+ (shell-command (concat "open \"x-devonthink-item:" uid "\"")))
+
+(defun org-as-get-selected-devonthink-item ()
+ "AppleScript to create links to selected items in DEVONthink Pro Office.app."
+ (do-applescript
+ (concat
+ "set theLinkList to {}\n"
+ "tell application \"DEVONthink Pro\"\n"
+ "set selectedRecords to selection\n"
+ "set selectionCount to count of selectedRecords\n"
+ "if (selectionCount < 1) then\n"
+ "return\n"
+ "end if\n"
+ "repeat with theRecord in selectedRecords\n"
+ "set theID to uuid of theRecord\n"
+ "set theURL to \"x-devonthink-item:\" & theID\n"
+ "set theSubject to name of theRecord\n"
+ "set theLink to theURL & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "end tell\n"
+ "return theLinkList as string"
+ )))
+
+(defun org-mac-devonthink-get-links ()
+ "Create links to the item(s) currently selected in DEVONthink Pro Office.
+This will use AppleScript to get the `uuid' and the `name' of the
+selected items in DEVONthink Pro Office.app and make links out of
+it/them. This function will push the Org-syntax text to the kill
+ring, and also return it."
+ (message "Org Mac DEVONthink: looking for selected items...")
+ (let* ((as-link-list (org-as-get-selected-devonthink-item))
+ (link-list (if as-link-list
+ (mapcar
+ (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x)
+ (setq x (match-string 1 x)))
+ x)
+ (split-string as-link-list "[\r\n]+"))
+ nil))
+ orglink-list)
+ (while link-list
+ (let* ((current-item (pop link-list)))
+ (message "current item: %s" current-item)
+ (when (and current-item (not (string= current-item "")))
+ (let* ((split-link (split-string current-item "::split::"))
+ (orglink (org-make-link-string
+ (url-encode-url (car split-link))
+ (cadr split-link))))
+ (push orglink orglink-list)))))
+ (kill-new (mapconcat 'identity orglink-list "\n"))))
+
+(defun org-mac-devonthink-item-insert-selected ()
+ "Insert a link to the item(s) currently selected in DEVONthink Pro Office.
+This will use AppleScript to get the `uuid'(s) and the name(s) of the
+selected items in DEVONthink Pro Office and make link(s) out of it/them."
+ (interactive)
+ (insert (org-mac-devonthink-get-links)))
-;;
-;;
;; Handle links from Mail.app
-;;
(org-add-link-type "message" 'org-mac-message-open)
(defun org-mac-message-open (message-id)
- "Visit the message with the given MESSAGE-ID.
+ "Visit the message with MESSAGE-ID.
This will use the command `open' with the message URL."
(start-process (concat "open message:" message-id) nil
"open" (concat "message://<" (substring message-id 2) ">")))
@@ -728,67 +775,43 @@ This will use the command `open' with the message URL."
(defun org-as-get-selected-mail ()
"AppleScript to create links to selected messages in Mail.app."
(do-applescript
- (concat
- "tell application \"Mail\"\n"
- "set theLinkList to {}\n"
- "set theSelection to selection\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
+ (concat
+ "tell application \"Mail\"\n"
+ "set theLinkList to {}\n"
+ "set theSelection to selection\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject\n"
+ "if (theLinkList is not equal to {}) then\n"
+ "set theLink to \"\n\" & theLink\n"
+ "end if\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
(defun org-as-get-flagged-mail ()
"AppleScript to create links to flagged messages in Mail.app."
+ (unless org-mac-mail-account
+ (error "You must set org-mac-mail-account"))
(do-applescript
- (concat
- ;; Is Growl installed?
- "tell application \"System Events\"\n"
- "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
- "if (count of growlHelpers) > 0 then\n"
- "set growlHelperApp to item 1 of growlHelpers\n"
- "else\n"
- "set growlHelperApp to \"\"\n"
- "end if\n"
- "end tell\n"
-
- ;; Get links
- "tell application \"Mail\"\n"
- "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
- "set theLinkList to {}\n"
- "repeat with aMailbox in theMailboxes\n"
- "set theSelection to (every message in aMailbox whose flagged status = true)\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
-
- ;; Report progress through Growl
- ;; This "double tell" idiom is described in detail at
- ;; http://macscripter.net/viewtopic.php?id=24570 The
- ;; script compiler needs static knowledge of the
- ;; growlHelperApp. Hmm, since we're compiling
- ;; on-the-fly here, this is likely to be way less
- ;; portable than I'd hoped. It'll work when the name
- ;; is still "GrowlHelperApp", though.
- "if growlHelperApp is not \"\" then\n"
- "tell application \"GrowlHelperApp\"\n"
- "tell application growlHelperApp\n"
- "set the allNotificationsList to {\"FlaggedMail\"}\n"
- "set the enabledNotificationsList to allNotificationsList\n"
- "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
- "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
- "end tell\n"
- "end tell\n"
- "end if\n"
- "end repeat\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
+ (concat
+ ;; Get links
+ "tell application \"Mail\"\n"
+ "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
+ "set theLinkList to {}\n"
+ "repeat with aMailbox in theMailboxes\n"
+ "set theSelection to (every message in aMailbox whose flagged status = true)\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
(defun org-mac-message-get-links (&optional select-or-flag)
"Create links to the messages currently selected or flagged in Mail.app.
@@ -800,27 +823,11 @@ The Org-syntax text will be pushed to the kill ring, and also returned."
(interactive "sLink to (s)elected or (f)lagged messages: ")
(setq select-or-flag (or select-or-flag "s"))
(message "AppleScript: searching mailboxes...")
- (let* ((as-link-list
- (if (string= select-or-flag "s")
- (org-as-get-selected-mail)
- (if (string= select-or-flag "f")
- (org-as-get-flagged-mail)
- (error "Please select \"s\" or \"f\""))))
- (link-list
- (mapcar
- (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
- (split-string as-link-list "[\r\n]+")))
- split-link URL description orglink orglink-insert rtn orglink-list)
- (while link-list
- (setq split-link (split-string (pop link-list) "::split::"))
- (setq URL (car split-link))
- (setq description (cadr split-link))
- (when (not (string= URL ""))
- (setq orglink (org-make-link-string URL description))
- (push orglink orglink-list)))
- (setq rtn (mapconcat 'identity orglink-list "\n"))
- (kill-new rtn)
- rtn))
+ (org-mac-paste-applescript-links
+ (cond
+ ((string= select-or-flag "s") (org-as-get-selected-mail))
+ ((string= select-or-flag "f") (org-as-get-flagged-mail))
+ (t (error "Please select \"s\" or \"f\"")))))
(defun org-mac-message-insert-selected ()
"Insert a link to the messages currently selected in Mail.app.
@@ -851,11 +858,11 @@ list of message:// links to flagged mail after heading."
(delete-region (match-beginning 0) (match-end 0)))
(insert "\n" (org-mac-message-get-links "f")))
(flush-lines "^$" (point) (outline-next-heading)))
- (insert "\n" (org-mac-message-get-links "f")))
- (goto-char (point-max))
- (insert "\n")
- (org-insert-heading nil t)
- (insert org-heading "\n" (org-mac-message-get-links "f"))))))
+ (insert "\n" (org-mac-message-get-links "f")))
+ (goto-char (point-max))
+ (insert "\n")
+ (org-insert-heading nil t)
+ (insert org-heading "\n" (org-mac-message-get-links "f"))))))
(provide 'org-mac-link)
diff --git a/contrib/lisp/org-mew.el b/contrib/lisp/org-mew.el
index 4482375..eb0afc0 100644
--- a/contrib/lisp/org-mew.el
+++ b/contrib/lisp/org-mew.el
@@ -308,7 +308,7 @@ the subject and the group number to extract. You can get rid of
org-mew-subject-alist))
(setq id-list (cons subject id-list)))
(cond ((null id-list)
- (error "No message ID to search."))
+ (error "No message ID to search"))
((equal (length id-list) 1)
(org-search-view nil (car id-list)))
(t
@@ -342,7 +342,7 @@ asks you to select the capture template."
(mew-message-goto-summary))
(let ((mew-mark-afterstep-spec '((?o 0 0 0 0 0 0 0))))
(mew-summary-refile)))
- (error "No refile folder selected."))
+ (error "No refile folder selected"))
(let* ((org-mew-link-to-refile-destination t)
(folder-name (org-mew-folder-name))
(keys (if arg
diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el
index 44bf91b..078ebef 100644
--- a/contrib/lisp/org-mime.el
+++ b/contrib/lisp/org-mime.el
@@ -1,6 +1,6 @@
;;; org-mime.el --- org html export for text/html MIME emails
-;; Copyright (C) 2010-2014 Eric Schulte
+;; Copyright (C) 2010-2015 Eric Schulte
;; Author: Eric Schulte
;; Keywords: mime, mail, email, html
@@ -111,7 +111,7 @@
;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements
(defun org-mime-change-element-style (element style)
"Set new default htlm style for <ELEMENT> elements in exported html."
- (while (re-search-forward (format "<%s" element) nil t)
+ (while (re-search-forward (format "<%s\\>" element) nil t)
(replace-match (format "<%s style=\"%s\"" element style))))
(defun org-mime-change-class-style (class style)
@@ -194,10 +194,10 @@ and images in a multipart/related part."
str)
html-images)))
-(defun org-mime-htmlize (arg)
- "Export a portion of an email body composed using `mml-mode' to
-html using `org-mode'. If called with an active region only
-export that region, otherwise export the entire body."
+(defun org-mime-htmlize (&optional arg)
+ "Export to HTML an email body composed using `mml-mode'.
+If called with an active region only export that region,
+otherwise export the entire body."
(interactive "P")
(require 'ox-org)
(require 'ox-html)
@@ -252,22 +252,22 @@ export that region, otherwise export the entire body."
(save-restriction
(org-narrow-to-subtree)
(run-hooks 'org-mime-send-subtree-hook)
- (flet ((mp (p) (org-entry-get nil p org-mime-use-property-inheritance)))
- (let* ((file (buffer-file-name (current-buffer)))
- (subject (or (mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
- (to (mp "MAIL_TO"))
- (cc (mp "MAIL_CC"))
- (bcc (mp "MAIL_BCC"))
- (body (buffer-substring
- (save-excursion (goto-char (point-min))
- (forward-line 1)
- (when (looking-at "[ \t]*:PROPERTIES:")
- (re-search-forward ":END:" nil)
- (forward-char))
- (point))
- (point-max))))
- (org-mime-compose body (or fmt 'org) file to subject
- `((cc . ,cc) (bcc . ,bcc)))))))
+ (let* ((mp (lambda (p) (org-entry-get nil p org-mime-use-property-inheritance)))
+ (file (buffer-file-name (current-buffer)))
+ (subject (or (funcall mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
+ (to (funcall mp "MAIL_TO"))
+ (cc (funcall mp "MAIL_CC"))
+ (bcc (funcall mp "MAIL_BCC"))
+ (body (buffer-substring
+ (save-excursion (goto-char (point-min))
+ (forward-line 1)
+ (when (looking-at "[ \t]*:PROPERTIES:")
+ (re-search-forward ":END:" nil)
+ (forward-char))
+ (point))
+ (point-max))))
+ (org-mime-compose body (or fmt 'org) file to subject
+ `((cc . ,cc) (bcc . ,bcc))))))
(defun org-mime-send-buffer (&optional fmt)
(run-hooks 'org-mime-send-buffer-hook)
@@ -287,45 +287,46 @@ export that region, otherwise export the entire body."
(require 'message)
(message-mail to subject headers nil)
(message-goto-body)
- (flet ((bhook (body fmt)
- (let ((hook (intern (concat "org-mime-pre-"
- (symbol-name fmt)
- "-hook"))))
- (if (> (eval `(length ,hook)) 0)
- (with-temp-buffer
- (insert body)
- (goto-char (point-min))
- (eval `(run-hooks ',hook))
- (buffer-string))
- body))))
- (let ((fmt (if (symbolp fmt) fmt (intern fmt))))
- (cond
- ((eq fmt 'org)
- (require 'ox-org)
- (insert (org-export-string-as
- (org-babel-trim (bhook body 'org)) 'org t)))
- ((eq fmt 'ascii)
- (require 'ox-ascii)
- (insert (org-export-string-as
- (concat "#+Title:\n" (bhook body 'ascii)) 'ascii t)))
- ((or (eq fmt 'html) (eq fmt 'html-ascii))
- (require 'ox-ascii)
- (require 'ox-org)
- (let* ((org-link-file-path-type 'absolute)
- ;; we probably don't want to export a huge style file
- (org-export-htmlize-output-type 'inline-css)
- (html-and-images
- (org-mime-replace-images
- (org-export-string-as (bhook body 'html) 'html t) file))
- (images (cdr html-and-images))
- (html (org-mime-apply-html-hook (car html-and-images))))
- (insert (org-mime-multipart
- (org-export-string-as
- (org-babel-trim
- (bhook body (if (eq fmt 'html) 'org 'ascii)))
- (if (eq fmt 'html) 'org 'ascii) t)
- html)
- (mapconcat 'identity images "\n"))))))))
+ (let ((bhook
+ (lambda (body fmt)
+ (let ((hook (intern (concat "org-mime-pre-"
+ (symbol-name fmt)
+ "-hook"))))
+ (if (> (eval `(length ,hook)) 0)
+ (with-temp-buffer
+ (insert body)
+ (goto-char (point-min))
+ (eval `(run-hooks ',hook))
+ (buffer-string))
+ body))))
+ (fmt (if (symbolp fmt) fmt (intern fmt))))
+ (cond
+ ((eq fmt 'org)
+ (require 'ox-org)
+ (insert (org-export-string-as
+ (org-babel-trim (funcall bhook body 'org)) 'org t)))
+ ((eq fmt 'ascii)
+ (require 'ox-ascii)
+ (insert (org-export-string-as
+ (concat "#+Title:\n" (funcall bhook body 'ascii)) 'ascii t)))
+ ((or (eq fmt 'html) (eq fmt 'html-ascii))
+ (require 'ox-ascii)
+ (require 'ox-org)
+ (let* ((org-link-file-path-type 'absolute)
+ ;; we probably don't want to export a huge style file
+ (org-export-htmlize-output-type 'inline-css)
+ (html-and-images
+ (org-mime-replace-images
+ (org-export-string-as (funcall bhook body 'html) 'html t) file))
+ (images (cdr html-and-images))
+ (html (org-mime-apply-html-hook (car html-and-images))))
+ (insert (org-mime-multipart
+ (org-export-string-as
+ (org-babel-trim
+ (funcall bhook body (if (eq fmt 'html) 'org 'ascii)))
+ (if (eq fmt 'html) 'org 'ascii) t)
+ html)
+ (mapconcat 'identity images "\n")))))))
(defun org-mime-org-buffer-htmlize ()
"Create an email buffer containing the current org-mode file
diff --git a/contrib/lisp/org-mtags.el b/contrib/lisp/org-mtags.el
deleted file mode 100644
index 5342184..0000000
--- a/contrib/lisp/org-mtags.el
+++ /dev/null
@@ -1,255 +0,0 @@
-;;; org-mtags.el --- Muse-like tags in Org-mode
-
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 0.01
-;;
-;; This file is not yet 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, 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:
-;;
-;; This modules implements some of the formatting tags available in
-;; Emacs Muse. This is not a way if adding new functionality, but just
-;; a different way to write some formatting directives. The advantage is
-;; that files written in this way can be read by Muse reasonably well,
-;; and that this provides an alternative way of writing formatting
-;; directives in Org, a way that some might find more pleasant to type
-;; and look at that the Org's #+BEGIN..#+END notation.
-
-;; The goal of this development is to make it easier for people to
-;; move between both worlds as they see fit for different tasks.
-
-;; The following muse tags will be translated during export into their
-;; native Org equivalents:
-;;
-;; <br>
-;; Needs to be at the end of a line. Will be translated to "\\".
-;;
-;; <example switches="-n -r">
-;; Needs to be on a line by itself, similarly the </example> tag.
-;; Will be translated into Org's #+BEGIN_EXAMPLE construct.
-;;
-;; <quote>
-;; Needs to be on a line by itself, similarly the </quote> tag.
-;; Will be translated into Org's #+BEGIN_QUOTE construct.
-;;
-;; <comment>
-;; Needs to be on a line by itself, similarly the </comment> tag.
-;; Will be translated into Org's #+BEGIN_COMMENT construct.
-;;
-;; <verse>
-;; Needs to be on a line by itself, similarly the </verse> tag.
-;; Will be translated into Org's #+BEGIN_VERSE construct.
-;;
-;; <contents>
-;; This gets translated into "[TABLE-OF-CONTENTS]". It will not
-;; trigger the production of a table of contents - that is done
-;; in Org with the "#+OPTIONS: toc:t" setting. But it will define
-;; the location where the TOC will be placed.
-;;
-;; <literal style="STYLE"> ;; only latex, html, and docbook supported
-;; in Org.
-;; Needs to be on a line by itself, similarly the </literal> tag.
-;;
-;; <src lang="LANG" switches="-n -r">
-;; Needs to be on a line by itself, similarly the </src> tag.
-;; Will be translated into Org's BEGIN_SRC construct.
-;;
-;; <include file="FILE" markup="MARKUP" lang="LANG"
-;; prefix="str" prefix1="str" switches="-n -r">
-;; Needs to be on a line by itself.
-;; Will be translated into Org's #+INCLUDE construct.
-;;
-;; The lisp/perl/ruby/python tags can be implemented using the
-;; `org-eval.el' module, which see.
-
-(require 'org)
-
-;;; Customization
-
-(defgroup org-mtags nil
- "Options concerning Muse tags in Org mode."
- :tag "Org Muse Tags"
- :group 'org)
-
-(defface org-mtags ; 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"))))
- "Face for Muse-like tags in Org."
- :group 'org-mtags
- :group 'org-faces)
-
-(defcustom org-mtags-prefer-muse-templates t
- "Non-nil means prefere Muse tags for structure elements.
-This is relevane when expanding the templates defined in the variable
-`org-structure-templates'."
- :group 'org-mtags
- :type 'boolean)
-
-(defconst org-mtags-supported-tags
- '("example" "quote" "comment" "verse" "contents" "literal" "src" "include")
- "The tags that are supported by org-mtags.el for conversion.
-In addition to this list, the <br> tag is supported as well.")
-
-(defconst org-mtags-fontification-re
- (concat
- "^[ \t]*</?\\("
- (mapconcat 'identity org-mtags-supported-tags "\\|")
- "\\)\\>[^>]*>\\|<br>[ \t]*$")
- "Regular expression used for fontifying muse tags.")
-
-(defun org-mtags-replace ()
- "Replace Muse-like tags with the appropriate Org constructs.
-The is done in the entire buffer."
- (interactive) ;; FIXME
- (let ((re (concat "^[ \t]*\\(</?\\("
- (mapconcat 'identity org-mtags-supported-tags "\\|")
- "\\)\\>\\)"))
- info tag rpl style markup lang file prefix prefix1 switches)
- ;; First, do the <br> tag
- (goto-char (point-min))
- (while (re-search-forward "<br>[ \t]*$" nil t)
- (replace-match "\\\\" t t))
- ;; Now, all the other tags
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (goto-char (match-beginning 1))
- (setq info (org-mtags-get-tag-and-attributes))
- (if (not info)
- (end-of-line 1)
- (setq tag (plist-get info :tag))
- (cond
- ((equal tag "contents")
- (setq rpl "[TABLE-OF-CONTENTS]")
- ;; FIXME: also trigger TOC in options-plist?????
- )
- ((member tag '("quote" "comment" "verse"))
- (if (plist-get info :closing)
- (setq rpl (format "#+END_%s" (upcase tag)))
- (setq rpl (format "#+BEGIN_%s" (upcase tag)))))
- ((equal tag "literal")
- (setq style (plist-get info :style))
- (and style (setq style (downcase style)))
- (if (plist-get info :closing)
- (setq rpl (cond
- ((member style '("latex"))
- "#+END_LaTeX")
- ((member style '("html"))
- "#+END_HTML")
- ((member style '("docbook"))
- "#+END_DOCBOOK")
- ((member style '("ascii"))
- "#+END_ASCII")))
- (setq rpl (cond
- ((member style '("latex"))
- "#+BEGIN_LaTeX")
- ((member style '("html"))
- "#+BEGIN_HTML")
- ((member style '("ascii"))
- "#+BEGIN_ASCII")))))
- ((equal tag "example")
- (if (plist-get info :closing)
- (setq rpl "#+END_EXAMPLE")
- (setq rpl "#+BEGIN_EXAMPLE")
- (when (setq switches (plist-get info :switches))
- (setq rpl (concat rpl " " switches)))))
- ((equal tag "src")
- (if (plist-get info :closing)
- (setq rpl "#+END_SRC")
- (setq rpl "#+BEGIN_SRC")
- (when (setq lang (plist-get info :lang))
- (setq rpl (concat rpl " " lang))
- (when (setq switches (plist-get info :switches))
- (setq rpl (concat rpl " " switches))))))
- ((equal tag "include")
- (setq file (plist-get info :file)
- markup (downcase (plist-get info :markup))
- lang (plist-get info :lang)
- prefix (plist-get info :prefix)
- prefix1 (plist-get info :prefix1)
- switches (plist-get info :switches))
- (setq rpl "#+INCLUDE")
- (setq rpl (concat rpl " " (prin1-to-string file)))
- (when markup
- (setq rpl (concat rpl " " markup))
- (when (and (equal markup "src") lang)
- (setq rpl (concat rpl " " lang))))
- (when prefix
- (setq rpl (concat rpl " :prefix " (prin1-to-string prefix))))
- (when prefix1
- (setq rpl (concat rpl " :prefix1 " (prin1-to-string prefix1))))
- (when switches
- (setq rpl (concat rpl " " switches)))))
- (when rpl
- (goto-char (plist-get info :match-beginning))
- (delete-region (point-at-bol) (plist-get info :match-end))
- (insert rpl))))))
-
-(defun org-mtags-get-tag-and-attributes ()
- "Parse a Muse-like tag at point ant rturn the information about it.
-The return value is a property list which contains all the attributes
-with string values. In addition, it reutnrs the following properties:
-
-:tag The tag as a string.
-:match-beginning The beginning of the match, just before \"<\".
-:match-end The end of the match, just after \">\".
-:closing t when the tag starts with \"</\"."
- (when (looking-at "<\\(/\\)?\\([a-zA-Z]+\\>\\)\\([^>]*\\)>")
- (let ((start 0)
- tag rest prop attributes endp val)
- (setq tag (org-match-string-no-properties 2)
- endp (match-end 1)
- rest (and (match-end 3)
- (org-match-string-no-properties 3))
- attributes (list :tag tag
- :match-beginning (match-beginning 0)
- :match-end (match-end 0)
- :closing endp))
- (when rest
- (while (string-match "\\([a-zA-Z]+\\)=\\([^ \t\n>]+\\|\"[^>]+\"\\)"
- rest start)
- (setq start (match-end 0)
- prop (org-match-string-no-properties 1 rest)
- val (org-remove-double-quotes
- (org-match-string-no-properties 2 rest)))
- (setq attributes (plist-put attributes
- (intern (concat ":" prop)) val))))
- attributes)))
-
-(defun org-mtags-fontify-tags (limit)
- "Fontify the muse-like tags."
- (while (re-search-forward org-mtags-fontification-re limit t)
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-mtags font-lock-multiline t
- font-lock-fontified t))))
-
-(add-hook 'org-export-preprocess-hook 'org-mtags-replace)
-(add-hook 'org-font-lock-hook 'org-mtags-fontify-tags)
-
-(provide 'org-mtags)
-
-;;; org-mtags.el ends here
diff --git a/contrib/lisp/org-notmuch.el b/contrib/lisp/org-notmuch.el
index 2ab5c17..712ec5a 100644
--- a/contrib/lisp/org-notmuch.el
+++ b/contrib/lisp/org-notmuch.el
@@ -41,6 +41,29 @@
(require 'org)
+;; customisable notmuch open functions
+(defcustom org-notmuch-open-function
+ 'org-notmuch-follow-link
+ "Function used to follow notmuch links.
+
+Should accept a notmuch search string as the sole argument."
+ :group 'org-notmuch
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+(defcustom org-notmuch-search-open-function
+ 'org-notmuch-search-follow-link
+ "Function used to follow notmuch-search links.
+
+Should accept a notmuch search string as the sole argument."
+ :group 'org-notmuch
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+
;; Install the link type
(org-add-link-type "notmuch" 'org-notmuch-open)
(add-hook 'org-store-link-functions 'org-notmuch-store-link)
@@ -62,7 +85,7 @@
(defun org-notmuch-open (path)
"Follow a notmuch message link specified by PATH."
- (org-notmuch-follow-link path))
+ (funcall org-notmuch-open-function path))
(defun org-notmuch-follow-link (search)
"Follow a notmuch link to SEARCH.
@@ -90,14 +113,21 @@ Can link to more than one message, if so all matching messages are shown."
(defun org-notmuch-search-open (path)
"Follow a notmuch message link specified by PATH."
- (message path)
- (org-notmuch-search-follow-link path))
+ (message "%s" path)
+ (funcall org-notmuch-search-open-function path))
(defun org-notmuch-search-follow-link (search)
"Follow a notmuch link by displaying SEARCH in notmuch-search mode."
(require 'notmuch)
(notmuch-search (org-link-unescape search)))
+
+
+(defun org-notmuch-tree-follow-link (search)
+ "Follow a notmuch link by displaying SEARCH in notmuch-tree mode."
+ (require 'notmuch)
+ (notmuch-tree (org-link-unescape search)))
+
(provide 'org-notmuch)
;;; org-notmuch.el ends here
diff --git a/contrib/lisp/org-passwords.el b/contrib/lisp/org-passwords.el
new file mode 100644
index 0000000..4ebd5a6
--- /dev/null
+++ b/contrib/lisp/org-passwords.el
@@ -0,0 +1,384 @@
+;;; org-passwords.el --- org derived mode for managing passwords
+
+;; Author: Jorge A. Alfaro-Murillo <jorge.alfaro-murillo@yale.edu>
+;; Created: December 26, 2012
+;; Keywords: passwords, password
+
+;; This file is NOT part of GNU Emacs.
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code for managing your passwords with
+;; Org-mode. It is part of org/contrib (see http://orgmode.org/). If
+;; you want to contribute with development, or have a problem, do it
+;; here: https://bitbucket.org/alfaromurillo/org-passwords.el
+
+;; A basic setup needs to indicate a passwords file, and a dictionary
+;; for the random words:
+
+;; (require 'org-passwords)
+;; (setq org-passwords-file "~/documents/passwords.gpg")
+;; (setq org-passwords-random-words-dictionary "/etc/dictionaries-common/words")
+
+;; Basic usage:
+
+;; `M-x org-passwords' opens the passwords file in
+;; `org-passwords-mode'.
+
+;; `M-x org-passwords-generate-password' generates a random string
+;; of numbers, lowercase letters and uppercase letters.
+
+;; `C-u M-x org-passwords-generate-password' generates a random
+;; string of numbers, lowercase letters, uppercase letters and
+;; symbols.
+
+;; `M-x org-passwords-random-words' concatenates random words from
+;; the dictionary defined by `org-passwords-random-words-dictionary'
+;; into a string, each word separated by the string defined in
+;; `org-passwords-random-words-separator'.
+
+;; `C-u M-x org-passwords-random-words' does the same as above, and
+;; also makes substitutions according to
+;; `org-passwords-random-words-substitutions'.
+
+;; It is also useful to set up keybindings for the functions
+;; `org-passwords-copy-username', `org-passwords-copy-password' and
+;; `org-passwords-open-url' in the `org-passwords-mode', to easily
+;; make the passwords and usernames available to the facility for
+;; pasting text of the window system (clipboard on X and MS-Windows,
+;; pasteboard on Nextstep/Mac OS, etc.), without inserting them in the
+;; kill-ring. You can set for example:
+
+;; (eval-after-load "org-passwords"
+;; '(progn
+;; (define-key org-passwords-mode-map
+;; (kbd "C-c u")
+;; 'org-passwords-copy-username)
+;; (define-key org-passwords-mode-map
+;; (kbd "C-c p")
+;; 'org-passwords-copy-password)
+;; (kbd "C-c o")
+;; 'org-passwords-open-url)))
+
+;; Finally, to enter new passwords, you can use `org-capture' and a
+;; minimal template like:
+
+;; ("p" "password" entry (file "~/documents/passwords.gpg")
+;; "* %^{Title}\n %^{URL}p %^{USERNAME}p %^{PASSWORD}p")
+
+;; When asked for the password you can then call either
+;; `org-passwords-generate-password' or `org-passwords-random-words'.
+;; Be sure to enable recursive minibuffers to call those functions
+;; from the minibuffer:
+
+;; (setq enable-recursive-minibuffers t)
+
+;;; Code:
+
+(require 'org)
+
+;;;###autoload
+(define-derived-mode org-passwords-mode org-mode
+ "org-passwords-mode"
+ "Mode for storing passwords"
+ nil)
+
+(defgroup org-passwords nil
+ "Options for password management."
+ :group 'org)
+
+(defcustom org-passwords-password-property "PASSWORD"
+ "Name of the property for password entry."
+ :type 'string
+ :group 'org-passwords)
+
+(defcustom org-passwords-username-property "USERNAME"
+ "Name of the property for user name entry."
+ :type 'string
+ :group 'org-passwords)
+
+(defcustom org-passwords-url-property "URL"
+ "Name of the property for URL entry."
+ :type 'string
+ :group 'org-passwords)
+
+(defcustom org-passwords-file nil
+ "Default file name for the file that contains the passwords."
+ :type 'file
+ :group 'org-passwords)
+
+(defcustom org-passwords-time-opened "1 min"
+ "Time that the password file will remain open. It has to be a
+string, a number followed by units."
+ :type 'str
+ :group 'org-passwords)
+
+(defcustom org-passwords-default-password-size "20"
+ "Default number of characters to use in
+org-passwords-generate-password. It has to be a string."
+ :type 'str
+ :group 'org-passwords)
+
+(defcustom org-passwords-random-words-dictionary nil
+ "Default file name for the file that contains a dictionary of
+words for `org-passwords-random-words'. Each non-empty line in
+the file is considered a word."
+ :type 'file
+ :group 'org-passwords)
+
+(defcustom org-passwords-default-random-words-number "5"
+ "Default number of words to use in org-passwords-random-words.
+It has to be a string."
+ :type 'str
+ :group 'org-passwords)
+
+(defvar org-passwords-random-words-separator "-"
+ "A string to separate words in `org-passwords-random-words'.")
+
+(defvar org-passwords-random-words-substitutions
+ '(("a" . "@")
+ ("e" . "3")
+ ("o" . "0"))
+"A list of substitutions to be made with
+`org-passwords-random-words' if it is called with
+`universal-argument'. Each element is pair of
+strings (SUBSTITUTE-THIS . BY-THIS).")
+
+(defun org-passwords-copy-password ()
+ "Makes the password available to other programs. Puts the
+password of the entry at the location of the cursor in the
+facility for pasting text of the window system (clipboard on X
+and MS-Windows, pasteboard on Nextstep/Mac OS, etc.), without
+putting it in the kill ring."
+ (interactive)
+ (funcall interprogram-cut-function
+ (org-entry-get (point)
+ org-passwords-password-property)))
+
+(defun org-passwords-copy-username ()
+ "Makes the password available to other programs. Puts the
+username of the entry at the location of the cursor in the
+facility for pasting text of the window system (clipboard on X
+and MS-Windows, pasteboard on Nextstep/Mac OS, etc.), without
+putting it in the kill ring."
+ (interactive)
+ (funcall interprogram-cut-function
+ (org-entry-get (point)
+ org-passwords-username-property
+ t)))
+
+(defun org-passwords-open-url ()
+ "Browse the URL associated with the entry at the location of
+the cursor."
+ (interactive)
+ (browse-url (org-entry-get (point)
+ org-passwords-url-property
+ t)))
+
+;;;###autoload
+(defun org-passwords (&optional arg)
+ "Open the password file. Open the password file defined by the
+variable `org-password-file' in read-only mode and kill that
+buffer later according to the value of the variable
+`org-passwords-time-opened'. It also adds the `org-password-file'
+to the auto-mode-alist so that it is opened with its mode being
+`org-passwords-mode'.
+
+With prefix arg ARG, the command does not set up a timer to kill the buffer.
+
+With a double prefix arg \\[universal-argument] \\[universal-argument], open the file for editing.
+"
+ (interactive "P")
+ (if org-passwords-file
+ (progn
+ (add-to-list 'auto-mode-alist
+ (cons
+ (regexp-quote
+ (expand-file-name org-passwords-file))
+ 'org-passwords-mode))
+ (if (equal arg '(4))
+ (find-file-read-only org-passwords-file)
+ (if (equal arg '(16))
+ (find-file org-passwords-file)
+ (progn
+ (find-file-read-only org-passwords-file)
+ (org-passwords-set-up-kill-password-buffer)))))
+ (minibuffer-message "No default password file defined. Set the variable `org-password-file'.")))
+
+(defun org-passwords-set-up-kill-password-buffer ()
+ (run-at-time org-passwords-time-opened
+ nil
+ '(lambda ()
+ (if (get-file-buffer org-passwords-file)
+ (kill-buffer
+ (get-file-buffer org-passwords-file))))))
+
+;;; Password generator
+
+;; Set random number seed from current time and pid. Otherwise
+;; `random' gives the same results every time emacs restarts.
+(random t)
+
+(defun org-passwords-generate-password (arg)
+ "Ask a number of characters and insert a password of that size.
+Password has a random string of numbers, lowercase letters, and
+uppercase letters. Argument ARG include symbols."
+ (interactive "P")
+ (let ((number-of-chars
+ (read-from-minibuffer
+ (concat "Number of characters (default "
+ org-passwords-default-password-size
+ "): ")
+ nil
+ nil
+ t
+ nil
+ org-passwords-default-password-size)))
+ (if arg
+ (insert (org-passwords-generate-password-with-symbols "" number-of-chars))
+ (insert (org-passwords-generate-password-without-symbols "" number-of-chars)))))
+
+(defun org-passwords-generate-password-with-symbols (previous-string nums-of-chars)
+ "Return a string consisting of PREVIOUS-STRING and
+NUMS-OF-CHARS random characters."
+ (if (eq nums-of-chars 0) previous-string
+ (org-passwords-generate-password-with-symbols
+ (concat previous-string
+ (char-to-string
+ ;; symbols, letters, numbers are from 33 to 126
+ (+ (random (- 127 33)) 33)))
+ (1- nums-of-chars))))
+
+(defun org-passwords-generate-password-without-symbols (previous-string nums-of-chars)
+ "Return string consisting of PREVIOUS-STRING and NUMS-OF-CHARS
+random numbers, lowercase letters, and numbers."
+ (if (eq nums-of-chars 0)
+ previous-string
+ ; There are 10 numbers, 26 lowercase letters and 26 uppercase
+ ; letters. 10 + 26 + 26 = 62. The number characters go from 48
+ ; to 57, the uppercase letters from 65 to 90, and the lowercase
+ ; from 97 to 122. The following makes each equally likely.
+ (let ((temp-value (random 62)))
+ (cond ((< temp-value 10)
+ ; If temp-value<10, then add a number
+ (org-passwords-generate-password-without-symbols
+ (concat previous-string
+ (char-to-string (+ 48 temp-value)))
+ (1- nums-of-chars)))
+ ((and (> temp-value 9) (< temp-value 36))
+ ; If 9<temp-value<36, then add an uppercase letter
+ (org-passwords-generate-password-without-symbols
+ (concat previous-string
+ (char-to-string (+ 65 (- temp-value 10))))
+ (1- nums-of-chars)))
+ ((> temp-value 35)
+ ; If temp-value>35, then add a lowecase letter
+ (org-passwords-generate-password-without-symbols
+ (concat previous-string
+ (char-to-string (+ 97 (- temp-value 36))))
+ (1- nums-of-chars)))))))
+
+;;; Random words
+
+(defun org-passwords-random-words (arg)
+ "Ask for a number of words and inserts a sequence of that many
+random words from the list in the file
+`org-passwords-random-words-dictionary' separated by
+`org-passwords-random-words-separator'. ARG make substitutions in
+the words as defined by
+`org-passwords-random-words-substitutions'."
+ (interactive "P")
+ (if org-passwords-random-words-dictionary
+ (let ((number-of-words
+ (read-from-minibuffer
+ (concat "Number of words (default "
+ org-passwords-default-random-words-number
+ "): ")
+ nil
+ nil
+ t
+ nil
+ org-passwords-default-random-words-number))
+ (list-of-words
+ (with-temp-buffer
+ (insert-file-contents
+ org-passwords-random-words-dictionary)
+ (split-string (buffer-string) "\n" t))))
+ (insert
+ (org-passwords-substitute
+ (org-passwords-random-words-attach-number-of-words
+ (nth (random (length list-of-words))
+ list-of-words)
+ (1- number-of-words)
+ list-of-words
+ org-passwords-random-words-separator)
+ (if arg
+ org-passwords-random-words-substitutions
+ nil))))
+ (minibuffer-message
+ "No default dictionary file defined. Set the variable `org-passwords-random-words-dictionary'.")))
+
+(defun org-passwords-random-words-attach-number-of-words
+ (previous-string number-of-words list-of-words separator)
+ "Returns a string consisting of PREVIOUS-STRING followed by a
+succession of NUMBER-OF-WORDS random words from the list LIST-OF-WORDS
+separated SEPARATOR."
+ (if (eq number-of-words 0)
+ previous-string
+ (org-passwords-random-words-attach-number-of-words
+ (concat previous-string
+ separator
+ (nth (random (length list-of-words)) list-of-words))
+ (1- number-of-words)
+ list-of-words
+ separator)))
+
+(defun org-passwords-substitute (string-to-change list-of-substitutions)
+ "Substitutes each appearence in STRING-TO-CHANGE of the `car' of
+each element of LIST-OF-SUBSTITUTIONS by the `cdr' of that
+element. For example:
+ (org-passwords-substitute \"ab\" \'((\"a\" . \"b\") (\"b\" . \"c\")))
+ => \"bc\"
+Substitutions are made in order of the list, so for example:
+ (org-passwords-substitute \"ab\" \'((\"ab\" . \"c\") (\"b\" . \"d\")))
+ => \"c\""
+ (if list-of-substitutions
+ (concat (org-passwords-concat-this-with-string
+ (cdar list-of-substitutions)
+ (mapcar (lambda (x)
+ (org-passwords-substitute
+ x
+ (cdr list-of-substitutions)))
+ (split-string string-to-change
+ (caar list-of-substitutions)))))
+ string-to-change))
+
+(defun org-passwords-concat-this-with-string (this list-of-strings)
+ "Put the string THIS in between every string in LIST-OF-STRINGS. For example:
+ (org-passwords-concat-this-with-string \"Here\" \'(\"First\" \"Second\" \"Third\"))
+ => \"FirstHereSencondHereThird\""
+ (if (cdr list-of-strings)
+ (concat (car list-of-strings)
+ this
+ (org-passwords-concat-this-with-string
+ this
+ (cdr list-of-strings)))
+ (car list-of-strings)))
+
+(provide 'org-passwords)
+
+;;; org-passwords.el ends here
diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el
index 255b79e..622cc02 100644
--- a/contrib/lisp/org-toc.el
+++ b/contrib/lisp/org-toc.el
@@ -338,7 +338,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
(interactive)
(condition-case nil
(outline-forward-same-level 1)
- (error (message "No next headline at this level.")))
+ (error (message "No next headline at this level")))
(if org-toc-info-mode (org-toc-info))
(if org-toc-follow-mode (org-toc-goto)))
@@ -347,7 +347,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
(interactive)
(condition-case nil
(outline-backward-same-level 1)
- (error (message "No previous headline at this level.")))
+ (error (message "No previous headline at this level")))
(if org-toc-info-mode (org-toc-info))
(if org-toc-follow-mode (org-toc-goto)))
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
index 3631a59..a7820f1 100644
--- a/contrib/lisp/org-velocity.el
+++ b/contrib/lisp/org-velocity.el
@@ -1,10 +1,10 @@
-;;; org-velocity.el --- something like Notational Velocity for Org.
+;;; org-velocity.el --- something like Notational Velocity for Org. -*- lexical-binding: t -*-
;; Copyright (C) 2010-2014 Paul M. Rodriguez
;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
;; Created: 2010-05-05
-;; Version: 3.0
+;; Version: 4.0
;; This file is not part of GNU Emacs.
@@ -64,7 +64,7 @@
(require 'button)
(require 'electric)
(require 'dabbrev)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(defgroup org-velocity nil
"Notational Velocity-style interface for Org."
@@ -133,9 +133,9 @@ file."
"Match on whole phrase, any word, or all words?"
:group 'org-velocity
:type '(choice
- (const :tag "Match whole phrase" phrase)
- (const :tag "Match any word" any)
- (const :tag "Match all words" all)
+ (const :tag "Match whole phrase" phrase)
+ (const :tag "Match any word" any)
+ (const :tag "Match all words" all)
(const :tag "Match a regular expression" regexp))
:safe (lambda (v) (memq v '(phrase any all regexp))))
@@ -152,6 +152,17 @@ See the documentation for `org-capture-templates'."
:group 'org-velocity
:type (or (get 'org-capture-templates 'custom-type) 'list))
+(defcustom org-velocity-heading-level 1
+ "Only match headings at this level or higher.
+0 means to match headings at any level."
+ :group 'org-velocity
+ :type 'integer
+ :safe (lambda (x)
+ (and (integerp x)
+ (>= x 0))))
+
+(defvar crm-separator) ;Ensure dynamic binding.
+
(defsubst org-velocity-grab-preview ()
"Grab preview of a subtree.
The length of the preview is determined by `window-width'.
@@ -172,14 +183,14 @@ Replace all contiguous whitespace with single spaces."
(point-max))))
" ")))
-(defstruct org-velocity-heading buffer position name level preview)
+(cl-defstruct org-velocity-heading buffer position name level preview)
(defsubst org-velocity-nearest-heading (position)
"Return last heading at POSITION.
If there is no last heading, return nil."
(save-excursion
(goto-char position)
- (re-search-backward org-velocity-heading-regexp)
+ (re-search-backward (org-velocity-heading-regexp))
(let ((components (org-heading-components)))
(make-org-velocity-heading
:buffer (current-buffer)
@@ -191,15 +202,18 @@ If there is no last heading, return nil."
(defconst org-velocity-index
(eval-when-compile
- (nconc (number-sequence 49 57) ;numbers
+ (nconc (number-sequence 49 57) ;numbers
(number-sequence 97 122) ;lowercase letters
(number-sequence 65 90))) ;uppercase letters
"List of chars for indexing results.")
(defconst org-velocity-match-buffer-name "*Velocity matches*")
-(defconst org-velocity-heading-regexp "^\\* "
- "Regexp to match only top-level headings.")
+(cl-defun org-velocity-heading-regexp (&optional (level org-velocity-heading-level))
+ "Regexp to match headings at LEVEL or deeper."
+ (if (zerop level)
+ "^\\*+ "
+ (format "^\\*\\{1,%d\\} " level)))
(defvar org-velocity-search nil
"Variable to bind to current search.")
@@ -223,12 +237,6 @@ of the base buffer; in the latter, return the file name of
(with-current-buffer (window-buffer (active-minibuffer-window))
(minibuffer-contents))))
-(defsubst org-velocity-singlep (object)
- "Return t when OBJECT is a list or sequence of one element."
- (if (consp object)
- (null (cdr object))
- (= (length object) 1)))
-
(defun org-velocity-bucket-file ()
"Return the proper file for Org-Velocity to search.
If `org-velocity-always-use-bucket' is t, use bucket file;
@@ -260,17 +268,22 @@ use it."
"Return the proper buffer for Org-Velocity to display in."
(get-buffer-create org-velocity-match-buffer-name))
+(defsubst org-velocity-match-window ()
+ (get-buffer-window (org-velocity-match-buffer)))
+
+(defsubst org-velocity-match-staging-buffer ()
+ (get-buffer-create " Velocity matches"))
+
(defun org-velocity-beginning-of-headings ()
"Goto the start of the first heading."
(goto-char (point-min))
;; If we are before the first heading we could still be at the
;; first heading.
- (or (looking-at org-velocity-heading-regexp)
- (re-search-forward org-velocity-heading-regexp)))
+ (or (looking-at (org-velocity-heading-regexp))
+ (re-search-forward (org-velocity-heading-regexp))))
(defun org-velocity-make-indirect-buffer (heading)
"Make or switch to an indirect buffer visiting HEADING."
-
(let* ((bucket (org-velocity-heading-buffer heading))
(name (org-velocity-heading-name heading))
(existing (get-buffer name)))
@@ -279,7 +292,8 @@ use it."
existing
(make-indirect-buffer
bucket
- (generate-new-buffer-name (org-velocity-heading-name heading))))))
+ (generate-new-buffer-name (org-velocity-heading-name heading))
+ t))))
(defun org-velocity-capture ()
"Record a note with `org-capture'."
@@ -287,34 +301,38 @@ use it."
org-velocity-capture-templates))
(org-capture nil
;; This is no longer automatically selected.
- (when (org-velocity-singlep org-capture-templates)
+ (when (null (cdr org-capture-templates))
(caar org-capture-templates)))
- (if org-capture-mode (rename-buffer org-velocity-search t))))
+ (when org-capture-mode
+ (rename-buffer org-velocity-search t))))
(defvar org-velocity-saved-winconf nil)
(make-variable-buffer-local 'org-velocity-saved-winconf)
(defun org-velocity-edit-entry (heading)
"Edit entry at HEADING in an indirect buffer."
- (let ((winconf (current-window-configuration)))
- (let ((buffer (org-velocity-make-indirect-buffer heading)))
- (with-current-buffer buffer
- (let ((org-inhibit-startup t))
- (org-mode))
- (setq org-velocity-saved-winconf winconf)
- (goto-char (org-velocity-heading-position heading))
- (narrow-to-region (point)
- (save-excursion
- (org-end-of-subtree t)
- (point)))
- (goto-char (point-min))
- (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
- (pop-to-buffer buffer)
- (set (make-local-variable 'header-line-format)
- (format "%s Use C-c C-c to finish."
- (abbreviate-file-name
- (buffer-file-name
- (org-velocity-heading-buffer heading))))))))
+ (let ((winconf (current-window-configuration))
+ (buffer (org-velocity-make-indirect-buffer heading))
+ (inhibit-point-motion-hooks t)
+ (inhibit-field-text-motion t))
+ (with-current-buffer buffer
+ (setq org-velocity-saved-winconf winconf)
+ (goto-char (org-velocity-heading-position heading))
+ (let ((start (point))
+ (end (save-excursion
+ (org-end-of-subtree t)
+ (point))))
+ ;; Outline view and narrow-to-region interact poorly.
+ (outline-flag-region start end nil)
+ (narrow-to-region start end))
+ (goto-char (point-max))
+ (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
+ (pop-to-buffer buffer)
+ (set (make-local-variable 'header-line-format)
+ (format "%s Use C-c C-c to finish."
+ (abbreviate-file-name
+ (buffer-file-name
+ (org-velocity-heading-buffer heading)))))))
(defun org-velocity-dismiss ()
"Save current entry and close indirect buffer."
@@ -327,14 +345,18 @@ use it."
(defun org-velocity-visit-button (button)
(run-hooks 'mouse-leave-buffer-hook)
- (if org-velocity-use-search-ring
- (add-to-history 'search-ring
- (button-get button 'search)
- search-ring-max))
- (org-velocity-edit-entry (button-get button 'match)))
+ (when org-velocity-use-search-ring
+ (add-to-history 'search-ring
+ (button-get button 'search)
+ search-ring-max))
+ (let ((match (button-get button 'match)))
+ (throw 'org-velocity-done
+ (lambda ()
+ (org-velocity-edit-entry match)))))
(define-button-type 'org-velocity-button
- 'action #'org-velocity-visit-button)
+ 'action #'org-velocity-visit-button
+ 'follow-link 'mouse-face)
(defsubst org-velocity-buttonize (heading)
"Insert HEADING as a text button with no hints."
@@ -352,8 +374,8 @@ use it."
(org-velocity-heading-preview heading)
'face 'shadow))))
-(defsubst* org-velocity-present-match (&key hint match)
- (with-current-buffer (org-velocity-match-buffer)
+(defsubst org-velocity-present-match (hint match)
+ (with-current-buffer (org-velocity-match-staging-buffer)
(when hint (insert "#" hint " "))
(org-velocity-buttonize match)
(org-velocity-insert-preview match)
@@ -362,19 +384,19 @@ use it."
(defun org-velocity-generic-search (search &optional hide-hints)
"Display any entry containing SEARCH."
(let ((hints org-velocity-index) matches)
- (block nil
+ (cl-block nil
(while (and hints (re-search-forward search nil t))
(let ((match (org-velocity-nearest-heading (point))))
(org-velocity-present-match
- :hint (unless hide-hints (car hints))
- :match match)
+ (unless hide-hints (car hints))
+ match)
(push match matches))
(setq hints (cdr hints))
- (unless (re-search-forward org-velocity-heading-regexp nil t)
+ (unless (re-search-forward (org-velocity-heading-regexp) nil t)
(return))))
(nreverse matches)))
-(defun* org-velocity-all-search (search &optional hide-hints max)
+(cl-defun org-velocity-all-search (search &optional hide-hints)
"Display only entries containing every word in SEARCH."
(let ((keywords (mapcar 'regexp-quote (split-string search)))
(hints org-velocity-index)
@@ -388,23 +410,23 @@ use it."
(setq org-map-continue-from
(save-excursion
(goto-char (line-end-position))
- (if (re-search-forward org-velocity-heading-regexp nil t)
+ (if (re-search-forward (org-velocity-heading-regexp) nil t)
(line-end-position)
(point-max))))
- (when (loop for word in keywords
- always (save-excursion
- (re-search-forward
- (concat "\\<" word "\\>")
- org-map-continue-from t)))
+ (when (cl-loop for word in keywords
+ always (save-excursion
+ (re-search-forward
+ (concat "\\<" word "\\>")
+ org-map-continue-from t)))
(let ((match (org-velocity-nearest-heading (match-end 0))))
(org-velocity-present-match
- :hint (unless hide-hints (car hints))
- :match match)
+ (unless hide-hints (car hints))
+ match)
(push match matches)
(setq hints (cdr hints))))))
(nreverse matches)))
-(defun* org-velocity-present (search &key hide-hints)
+(cl-defun org-velocity-present (search &key hide-hints)
"Buttonize matches for SEARCH in `org-velocity-match-buffer'.
If HIDE-HINTS is non-nil, display entries without indices. SEARCH
binds `org-velocity-search'.
@@ -425,7 +447,7 @@ Return matches."
(inhibit-field-text-motion t))
(save-excursion
(org-velocity-beginning-of-headings)
- (case org-velocity-search-method
+ (cl-case org-velocity-search-method
(all (org-velocity-all-search search hide-hints))
(phrase (org-velocity-generic-search
(concat "\\<" (regexp-quote search))
@@ -440,6 +462,7 @@ Return matches."
(invalid-regexp
(minibuffer-message "%s" lossage))))))))
(with-current-buffer (org-velocity-match-buffer)
+ (buffer-swap-text (org-velocity-match-staging-buffer))
(goto-char (point-min)))))
(with-current-buffer (org-velocity-match-buffer)
(erase-buffer))))
@@ -452,14 +475,14 @@ Return matches."
(add-hook 'org-store-link-functions 'org-velocity-store-link)
-(defun* org-velocity-create (search &key ask)
+(cl-defun org-velocity-create (search &key ask)
"Create new heading named SEARCH.
If ASK is non-nil, ask first."
(when (or (null ask) (y-or-n-p "No match found, create? "))
(let ((org-velocity-search search)
- (org-default-notes-file (org-velocity-bucket-file))
- ;; save a stored link
- org-store-link-plist)
+ (org-default-notes-file (org-velocity-bucket-file))
+ ;; save a stored link
+ org-store-link-plist)
(org-velocity-capture))
search))
@@ -469,17 +492,18 @@ If ASK is non-nil, ask first."
(unless (or
(not (stringp search))
(string= "" search)) ;exit on empty string
- (case
+ (cl-case
(if (and org-velocity-force-new (eq last-command-event ?\C-j))
:force
- (let ((matches (org-velocity-present search)))
+ (let* ((org-velocity-index (org-velocity-adjust-index))
+ (matches (org-velocity-present search)))
(cond ((null matches) :new)
- ((org-velocity-singlep matches) :follow)
+ ((null (cdr matches)) :follow)
(t :prompt))))
(:prompt (progn
(pop-to-buffer (org-velocity-match-buffer))
(let ((hint (org-velocity-electric-read-hint)))
- (when hint (case hint
+ (when hint (cl-case hint
(:edit (org-velocity-read nil search))
(:force (org-velocity-create search))
(otherwise (org-velocity-activate-button hint)))))))
@@ -493,17 +517,10 @@ If ASK is non-nil, ask first."
(button-activate (next-button (point))))
(org-velocity-read nil search)))))))
-(defun org-velocity-position (item list)
- "Return first position of ITEM in LIST."
- (loop for elt in list
- for i from 0
- when (equal elt item)
- return i))
-
(defun org-velocity-activate-button (char)
"Go to button on line number associated with CHAR in `org-velocity-index'."
(goto-char (point-min))
- (forward-line (org-velocity-position char org-velocity-index))
+ (forward-line (cl-position char org-velocity-index))
(goto-char
(button-start
(next-button (point))))
@@ -514,8 +531,8 @@ If ASK is non-nil, ask first."
"Complain about an undefined key."
(interactive)
(message "%s"
- (substitute-command-keys
- "\\[org-velocity-electric-new] for new entry,
+ (substitute-command-keys
+ "\\[org-velocity-electric-new] for new entry,
\\[org-velocity-electric-edit] to edit search,
\\[scroll-up] to scroll up,
\\[scroll-down] to scroll down,
@@ -525,20 +542,11 @@ If ASK is non-nil, ask first."
(defun org-velocity-electric-follow (ev)
"Follow a hint indexed by keyboard event EV."
(interactive (list last-command-event))
- (if (not (> (org-velocity-position ev org-velocity-index)
+ (if (not (> (cl-position ev org-velocity-index)
(1- (count-lines (point-min) (point-max)))))
(throw 'org-velocity-select ev)
(call-interactively 'org-velocity-electric-undefined)))
-(defun org-velocity-electric-click (ev)
- "Follow hint indexed by a mouse event EV."
- (interactive "e")
- (throw 'org-velocity-select
- (nth (1- (count-lines
- (point-min)
- (posn-point (event-start ev))))
- org-velocity-index)))
-
(defun org-velocity-electric-edit ()
"Edit the search string."
(interactive)
@@ -552,14 +560,15 @@ If ASK is non-nil, ask first."
(defvar org-velocity-electric-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'org-velocity-electric-undefined)
- (loop for c in org-velocity-index
- do (define-key map (char-to-string c) 'org-velocity-electric-follow))
+ (dolist (c org-velocity-index)
+ (define-key map (char-to-string c)
+ 'org-velocity-electric-follow))
(define-key map "0" 'org-velocity-electric-new)
(define-key map "\C-v" 'scroll-up)
(define-key map "\M-v" 'scroll-down)
(define-key map (kbd "RET") 'org-velocity-electric-edit)
- (define-key map [mouse-1] 'org-velocity-electric-click)
- (define-key map [mouse-2] 'org-velocity-electric-click)
+ (define-key map [mouse-1] nil)
+ (define-key map [mouse-2] nil)
(define-key map [escape] 'keyboard-quit)
(define-key map "\C-h" 'help-command)
map))
@@ -567,29 +576,19 @@ If ASK is non-nil, ask first."
(defun org-velocity-electric-read-hint ()
"Read index of button electrically."
(with-current-buffer (org-velocity-match-buffer)
+ (when (featurep 'evil)
+ ;; NB Idempotent.
+ (evil-make-overriding-map org-velocity-electric-map))
(use-local-map org-velocity-electric-map)
(catch 'org-velocity-select
(Electric-command-loop 'org-velocity-select "Follow: "))))
(defvar org-velocity-incremental-keymap
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'org-velocity-click-for-incremental)
- (define-key map [mouse-2] 'org-velocity-click-for-incremental)
(define-key map "\C-v" 'scroll-up)
(define-key map "\M-v" 'scroll-down)
map))
-(defun org-velocity-click-for-incremental ()
- "Jump out of search and select hint clicked on."
- (interactive)
- (let ((ev last-command-event))
- (org-velocity-activate-button
- (nth (- (count-lines
- (point-min)
- (posn-point (event-start ev))) 2)
- org-velocity-index)))
- (throw 'click (current-buffer)))
-
(defun org-velocity-displaying-completions-p ()
"Is there a *Completions* buffer showing?"
(get-window-with-predicate
@@ -598,8 +597,7 @@ If ASK is non-nil, ask first."
'completion-list-mode))))
(defun org-velocity-update ()
- "Display results of search without hinting.
-Stop searching once there are more matches than can be displayed."
+ "Display results of search without hinting."
(unless (org-velocity-displaying-completions-p)
(let* ((search (org-velocity-minibuffer-contents))
(matches (org-velocity-present search :hide-hints t)))
@@ -607,20 +605,20 @@ Stop searching once there are more matches than can be displayed."
(select-window (active-minibuffer-window))
(unless (or (null search) (string= "" search))
(minibuffer-message "No match; RET to create")))
- ((and (org-velocity-singlep matches)
+ ((and (null (cdr matches))
org-velocity-exit-on-match)
(throw 'click search))
(t
(with-current-buffer (org-velocity-match-buffer)
(use-local-map org-velocity-incremental-keymap)))))))
-(defvar dabbrev--last-abbrev)
+(defvar dabbrev--last-abbreviation)
(defun org-velocity-dabbrev-completion-list (abbrev)
"Return all dabbrev completions for ABBREV."
;; This is based on `dabbrev-completion'.
(dabbrev--reset-global-variables)
- (setq dabbrev--last-abbrev abbrev)
+ (setq dabbrev--last-abbreviation abbrev)
(dabbrev--find-all-expansions abbrev case-fold-search))
(defvar org-velocity-local-completion-map
@@ -638,7 +636,7 @@ Stop searching once there are more matches than can be displayed."
(completion-no-auto-exit t)
(crm-separator " "))
(funcall
- (case org-velocity-search-method
+ (cl-case org-velocity-search-method
(phrase #'completing-read)
(any #'completing-read-multiple)
(all #'completing-read-multiple))
@@ -652,38 +650,50 @@ Stop searching once there are more matches than can be displayed."
;; `read-from-minibuffer'), but in this case it is the user-friendly
;; thing to do.
(minibuffer-with-setup-hook
- (lexical-let ((initial-input initial-input))
+ (let ((initial-input initial-input))
(lambda ()
(and initial-input (insert initial-input))
(goto-char (point-max))))
(if (eq org-velocity-search-method 'regexp)
- (read-regexp prompt)
+ (read-regexp prompt)
(if org-velocity-use-completion
- (org-velocity-read-with-completion prompt)
- (read-string prompt)))))
+ (org-velocity-read-with-completion prompt)
+ (read-string prompt)))))
+
+(cl-defun org-velocity-adjust-index
+ (&optional (match-window (org-velocity-match-window)))
+ "Truncate or extend `org-velocity-index' to the lines in
+MATCH-WINDOW."
+ (with-selected-window match-window
+ (let ((lines (window-height))
+ (hints (length org-velocity-index)))
+ (cond ((= lines hints)
+ org-velocity-index)
+ ;; Truncate the index to the size of
+ ;; the buffer to be displayed.
+ ((< lines hints)
+ (cl-subseq org-velocity-index 0 lines))
+ ;; If the window is so tall we run out of indices, at
+ ;; least make the additional results clickable.
+ ((> lines hints)
+ (append org-velocity-index
+ (make-list (- lines hints) nil)))))))
(defun org-velocity-incremental-read (prompt)
- "Read string with PROMPT and display results incrementally."
+ "Read string with PROMPT and display results incrementally.
+Stop searching once there are more matches than can be
+displayed."
(let ((res
(unwind-protect
(let* ((match-window (display-buffer (org-velocity-match-buffer)))
- (org-velocity-index
- ;; Truncate the index to the size of the buffer to be
- ;; displayed.
- (with-selected-window match-window
- (if (> (window-height) (length org-velocity-index))
- ;; (subseq org-velocity-index 0 (window-height))
- (let ((hints (copy-sequence org-velocity-index)))
- (setcdr (nthcdr (window-height) hints) nil)
- hints)
- org-velocity-index))))
+ (org-velocity-index (org-velocity-adjust-index match-window)))
(catch 'click
(add-hook 'post-command-hook 'org-velocity-update)
- (if (eq org-velocity-search-method 'regexp)
- (read-regexp prompt)
- (if org-velocity-use-completion
- (org-velocity-read-with-completion prompt)
- (read-string prompt)))))
+ (cond ((eq org-velocity-search-method 'regexp)
+ (read-regexp prompt))
+ (org-velocity-use-completion
+ (org-velocity-read-with-completion prompt))
+ (t (read-string prompt)))))
(remove-hook 'post-command-hook 'org-velocity-update))))
(if (bufferp res) (org-pop-to-buffer-same-window res) res)))
@@ -697,24 +707,31 @@ created named SEARCH.
If `org-velocity-bucket' is defined and
`org-velocity-always-use-bucket' is non-nil, then the bucket file
will be used; otherwise, this will work when called in any Org
-file. Calling with ARG forces current file."
+file.
+
+Calling with ARG reverses which file – the current file or the
+bucket file – to use. If the bucket file would have been used,
+then the current file is used instead, and vice versa."
(interactive "P")
(let ((org-velocity-always-use-bucket
- (if arg nil org-velocity-always-use-bucket)))
+ (if org-velocity-always-use-bucket
+ (not arg)
+ arg)))
;; complain if inappropriate
- (assert (org-velocity-bucket-file))
+ (cl-assert (org-velocity-bucket-file))
(let ((org-velocity-bucket-buffer
(find-file-noselect (org-velocity-bucket-file))))
(unwind-protect
(let ((dabbrev-search-these-buffers-only
(list (org-velocity-bucket-buffer))))
- (org-velocity-engine
- (if org-velocity-search-is-incremental
- (org-velocity-incremental-read "Velocity search: ")
- (org-velocity-read-string "Velocity search: " search))))
- (progn
- (kill-buffer (org-velocity-match-buffer))
- (delete-other-windows))))))
+ (funcall
+ (catch 'org-velocity-done
+ (org-velocity-engine
+ (if org-velocity-search-is-incremental
+ (org-velocity-incremental-read "Velocity search: ")
+ (org-velocity-read-string "Velocity search: " search)))
+ #'ignore)))
+ (kill-buffer (org-velocity-match-buffer))))))
(defalias 'org-velocity-read 'org-velocity)
diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
index 015e001..ff2d55a 100644
--- a/contrib/lisp/org-wikinodes.el
+++ b/contrib/lisp/org-wikinodes.el
@@ -82,8 +82,6 @@ to `directory'."
;; in heading - deactivate flyspell
(org-remove-flyspell-overlays-in (match-beginning 0)
(match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(org-no-flyspell t))
t)
;; this is a wiki link
(org-remove-flyspell-overlays-in (match-beginning 0)
@@ -270,7 +268,6 @@ If there is no such wiki target, return nil."
(car org-export-target-aliases))))
(push (caar target-alist) (cdr a)))))
-(defvar org-current-export-file)
(defun org-wikinodes-process-links-for-export ()
"Process Wiki links in the export preprocess buffer.
@@ -296,12 +293,6 @@ with working links."
((eq org-wikinodes-scope 'file)
;; No match in file, and other files are not allowed
(insert (format "%s" link)))
- ((setq file
- (and (org-string-nw-p org-current-export-file)
- (org-wikinodes-which-file
- link (file-name-directory org-current-export-file))))
- ;; Match in another file in the current directory
- (insert (format "[[file:%s::%s][%s]]" file link link)))
(t ;; No match for this link
(insert (format "%s" link)))))))))
@@ -325,11 +316,10 @@ with working links."
(defun org-wikinodes-add-to-font-lock-keywords ()
"Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'."
- (let ((m (member '(org-activate-plain-links) org-font-lock-extra-keywords)))
- (if m
- (setcdr m (cons '(org-wikinodes-activate-links) (cdr m)))
- (message
- "Failed to add wikinodes to `org-font-lock-extra-keywords'."))))
+ (let ((m (member '(org-activate-plain-links (0 'org-link t))
+ org-font-lock-extra-keywords)))
+ (if m (push '(org-wikinodes-activate-links) (cdr m))
+ (message "Failed to add wikinodes to `org-font-lock-extra-keywords'."))))
(add-hook 'org-font-lock-set-keywords-hook
'org-wikinodes-add-to-font-lock-keywords)
diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el
index ef69395..0719866 100644
--- a/contrib/lisp/ox-bibtex.el
+++ b/contrib/lisp/ox-bibtex.el
@@ -23,21 +23,31 @@
;;; Commentary:
;;
-;; This is an utility to handle BibTeX export to both LaTeX and html
-;; exports. It uses the bibtex2html software from:
+;; This is an utility to handle BibTeX export to LaTeX, html and ascii
+;; exports. For HTML and ascii it uses the bibtex2html software from:
;;
;; http://www.lri.fr/~filliatr/bibtex2html/
;;
+;; For ascii it uses the pandoc software from:
+;;
+;; http://johnmacfarlane.net/pandoc/
+;;
;; It also introduces "cite" syntax for Org links.
;;
;; The usage is as follows:
;;
-;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options
+;; #+BIBLIOGRAPHY: bibfilename stylename optional-options
;;
;; e.g. given foo.bib and using style plain:
;;
;; #+BIBLIOGRAPHY: foo plain option:-d
;;
+;; "stylename" can also be "nil", in which case no style will be used.
+;;
+;; Full filepaths are also possible:
+;;
+;; #+BIBLIOGRAPHY: /home/user/Literature/foo.bib plain option:-d
+;;
;; Optional options are of the form:
;;
;; option:-foobar pass '-foobar' to bibtex2html
@@ -71,14 +81,18 @@
;; 2) creates a foo.html and foo_bib.html,
;; 3) includes the contents of foo.html in the exported HTML file.
;;
+;; For ascii export it:
+;; 1) converts all \cite{foo} and [[cite:foo]] to links to the
+;; bibliography,
+;; 2) creates a foo.txt and foo_bib.html,
+;; 3) includes the contents of foo.txt in the exported ascii file.
+;;
;; For LaTeX export it:
;; 1) converts all [[cite:foo]] to \cite{foo}.
;; Initialization
(eval-when-compile (require 'cl))
-(org-add-link-type "cite" 'ebib)
-
;;; Internal Functions
@@ -103,9 +117,9 @@ return nil instead."
(defun org-bibtex-get-arguments (keyword)
"Return \"bibtex2html\" arguments specified by the user.
KEYWORD is a \"BIBLIOGRAPHY\" keyword. Return value is a plist
-containing `:options' and `:limit' properties. The former
-contains a list of strings to be passed as options ot
-\"bibtex2html\" process. The latter contains a boolean."
+containing `:options' and `:limit' properties. The former
+contains a list of strings to be passed as options to
+\"bibtex2html\" process. The latter contains a boolean."
(let ((value (org-element-property :value keyword)))
(and value
(string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
@@ -137,6 +151,197 @@ to `org-bibtex-citation-p' predicate."
(and (string-match "\\`\\\\cite{" value)
(substring value (match-end 0) -1)))))
+
+;;; Follow cite: links
+
+(defun org-bibtex-file nil "Org-mode file of bibtex entries.")
+
+(defun org-bibtex-goto-citation (&optional citation)
+ "Visit a citation given its ID."
+ (interactive)
+ (let ((citation (or citation
+ (org-icompleting-read "Citation: "
+ (obe-citations)))))
+ (find-file (or org-bibtex-file
+ (error "`org-bibtex-file' has not been configured")))
+ (goto-char (point-min))
+ (when (re-search-forward (format " :CUSTOM_ID: %s" citation) nil t)
+ (outline-previous-visible-heading 1)
+ t)))
+
+(let ((jump-fn (car (org-remove-if-not #'fboundp '(ebib org-bibtex-goto-citation)))))
+ (org-add-link-type "cite" jump-fn))
+
+
+
+;;; Filters
+
+(defun org-bibtex-process-bib-files (tree backend info)
+ "Send each bibliography in parse tree to \"bibtex2html\" process.
+Return new parse tree."
+ (when (org-export-derived-backend-p backend 'ascii 'html)
+ ;; Initialize dynamically scoped variables. The first one
+ ;; contain an alist between keyword objects and their HTML
+ ;; translation. The second one will contain an alist between
+ ;; citation keys and names in the output (according to style).
+ (setq org-bibtex-html-entries-alist nil
+ org-bibtex-html-keywords-alist nil)
+ (org-element-map tree 'keyword
+ (lambda (keyword)
+ (when (equal (org-element-property :key keyword) "BIBLIOGRAPHY")
+ (let ((arguments (org-bibtex-get-arguments keyword))
+ (file (org-bibtex-get-file keyword))
+ temp-file
+ out-file)
+ ;; Test if filename is given with .bib-extension and strip
+ ;; it off. Filenames with another extensions will be
+ ;; untouched and will finally rise an error in bibtex2html.
+ (setq file (if (equal (file-name-extension file) "bib")
+ (file-name-sans-extension file) file))
+ ;; Outpufiles of bibtex2html will be put into current working directory
+ ;; so define a variable for this.
+ (setq out-file (file-name-sans-extension
+ (file-name-nondirectory file)))
+ ;; limit is set: collect citations throughout the document
+ ;; in TEMP-FILE and pass it to "bibtex2html" as "-citefile"
+ ;; argument.
+ (when (plist-get arguments :limit)
+ (let ((citations
+ (org-element-map tree '(latex-fragment link)
+ (lambda (object)
+ (and (org-bibtex-citation-p object)
+ (org-bibtex-get-citation-key object))))))
+ (with-temp-file (setq temp-file (make-temp-file "ox-bibtex"))
+ (insert (mapconcat 'identity citations "\n")))
+ (setq arguments
+ (plist-put arguments
+ :options
+ (append (plist-get arguments :options)
+ (list "-citefile" temp-file))))))
+ ;; Call "bibtex2html" on specified file.
+ (unless (eq 0 (apply
+ 'call-process
+ (append '("bibtex2html" nil nil nil)
+ '("-a" "-nodoc" "-noheader" "-nofooter")
+ (let ((style
+ (org-not-nil
+ (org-bibtex-get-style keyword))))
+ (and style (list "--style" style)))
+ (plist-get arguments :options)
+ (list (concat file ".bib")))))
+ (error "Executing bibtex2html failed"))
+ (and temp-file (delete-file temp-file))
+ ;; Open produced HTML file, and collect Bibtex key names
+ (with-temp-buffer
+ (insert-file-contents (concat out-file ".html"))
+ ;; Update `org-bibtex-html-entries-alist'.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\(\\w+\\)" nil t)
+ (push (cons (match-string 1) (match-string 2))
+ org-bibtex-html-entries-alist)))
+ ;; Open produced HTML file, wrap references within a block and
+ ;; return it.
+ (with-temp-buffer
+ (cond
+ ((org-export-derived-backend-p backend 'html)
+ (insert (format "<div id=\"bibliography\">\n<h2>%s</h2>\n"
+ (org-export-translate "References" :html info)))
+ (insert-file-contents (concat out-file ".html"))
+ (insert "\n</div>"))
+ ((org-export-derived-backend-p backend 'ascii)
+ ;; convert HTML references to text w/pandoc
+ (unless (eq 0 (call-process "pandoc" nil nil nil
+ (concat out-file ".html")
+ "-o"
+ (concat out-file ".txt")))
+ (error "Executing pandoc failed"))
+ (insert
+ (format
+ "%s\n==========\n\n"
+ (org-export-translate
+ "References"
+ (intern (format ":%s" (plist-get info :ascii-charset)))
+ info)))
+ (insert-file-contents (concat out-file ".txt"))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "\\[ \\[bib\\][^ ]+ \\(\\]\\||[\n\r]\\)" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (while (re-search-forward "\\( \\]\\| \\]\\| |\\)" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (while (re-search-forward "[\n\r]\\([\n\r][\n\r]\\)" nil t)
+ (replace-match "\\1"))))
+ ;; Update `org-bibtex-html-keywords-alist'.
+ (push (cons keyword (buffer-string))
+ org-bibtex-html-keywords-alist)))))))
+ ;; Return parse tree unchanged.
+ tree)
+
+(defun org-bibtex-merge-contiguous-citations (tree backend info)
+ "Merge all contiguous citation in parse tree.
+As a side effect, this filter will also turn all \"cite\" links
+into \"\\cite{...}\" LaTeX fragments and will extract options.
+Cite options are placed into square brackets at the beginning of
+the \"\\cite\" command for the LaTeX backend, and are removed for
+the HTML and ASCII backends."
+ (when (org-export-derived-backend-p backend 'html 'latex 'ascii)
+ (org-element-map tree '(link latex-fragment)
+ (lambda (object)
+ (when (org-bibtex-citation-p object)
+ (let ((new-citation (list 'latex-fragment
+ (list :value ""
+ :post-blank (org-element-property
+ :post-blank object))))
+ option)
+ ;; Insert NEW-CITATION right before OBJECT.
+ (org-element-insert-before new-citation object)
+ ;; Remove all subsequent contiguous citations from parse
+ ;; tree, keeping only their citation key.
+ (let ((keys (list (org-bibtex-get-citation-key object)))
+ next)
+ (while (and (setq next (org-export-get-next-element object info))
+ (or (and (stringp next)
+ (not (org-string-match-p "\\S-" next)))
+ (org-bibtex-citation-p next)))
+ (unless (stringp next)
+ (push (org-bibtex-get-citation-key next) keys))
+ (org-element-extract-element object)
+ (setq object next))
+ ;; Find any options in keys, e.g., "(Chapter 2)key" has
+ ;; the option "Chapter 2".
+ (setq keys
+ (mapcar
+ (lambda (k)
+ (if (string-match "^(\\([^)]\+\\))\\(.*\\)" k)
+ (progn
+ (when (org-export-derived-backend-p backend 'latex)
+ (setq option (format "[%s]" (match-string 1 k))))
+ (match-string 2 k))
+ k))
+ keys))
+ (org-element-extract-element object)
+ ;; Eventually merge all keys within NEW-CITATION. Also
+ ;; ensure NEW-CITATION has the same :post-blank property
+ ;; as the last citation removed.
+ (org-element-put-property
+ new-citation
+ :post-blank (org-element-property :post-blank object))
+ (org-element-put-property
+ new-citation
+ :value (format "\\cite%s{%s}"
+ (or option "")
+ (mapconcat 'identity (nreverse keys) ",")))))))))
+ tree)
+
+(eval-after-load 'ox
+ '(progn (add-to-list 'org-export-filter-parse-tree-functions
+ 'org-bibtex-process-bib-files)
+ (add-to-list 'org-export-filter-parse-tree-functions
+ 'org-bibtex-merge-contiguous-citations)))
+
;;; LaTeX Part
@@ -148,22 +353,13 @@ Fallback to `latex' back-end for other keywords."
(if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
ad-do-it
(let ((file (org-bibtex-get-file keyword))
- (style (org-bibtex-get-style keyword)))
+ (style (org-not-nil (org-bibtex-get-style keyword))))
(setq ad-return-value
(when file
(concat (and style (format "\\bibliographystyle{%s}\n" style))
(format "\\bibliography{%s}" file))))))))
-(defadvice org-latex-link (around bibtex-link)
- "Translate \"cite\" type links into LaTeX syntax.
-Fallback to `latex' back-end for other keywords."
- (let ((link (ad-get-arg 0)))
- (if (not (org-bibtex-citation-p link)) ad-do-it
- (setq ad-return-value
- (format "\\cite{%s}" (org-bibtex-get-citation-key link))))))
-
(ad-activate 'org-latex-keyword)
-(ad-activate 'org-latex-link)
@@ -190,103 +386,46 @@ Fallback to `html' back-end for other keywords."
(let ((fragment (ad-get-arg 0)))
(if (not (org-bibtex-citation-p fragment)) ad-do-it
(setq ad-return-value
- (mapconcat
- (lambda (key)
- (let ((key (org-trim key)))
- (format "[<a href=\"#%s\">%s</a>]"
- key
- (or (cdr (assoc key org-bibtex-html-entries-alist))
- key))))
- (org-split-string (org-bibtex-get-citation-key fragment) ",")
- "")))))
-
-(defadvice org-html-link (around bibtex-link)
- "Translate \"cite:\" type links into HTML syntax.
-Fallback to `html' back-end for other types."
- (let ((link (ad-get-arg 0)))
- (if (not (org-bibtex-citation-p link)) ad-do-it
- (setq ad-return-value
- (mapconcat
- (lambda (key)
- (format "[<a href=\"#%s\">%s</a>]"
- key
- (or (cdr (assoc key org-bibtex-html-entries-alist))
- key)))
- (org-split-string (org-bibtex-get-citation-key link)
- "[ \t]*,[ \t]*")
- "")))))
+ (format "[%s]"
+ (mapconcat
+ (lambda (key)
+ (format "<a href=\"#%s\">%s</a>"
+ key
+ (or (cdr (assoc key org-bibtex-html-entries-alist))
+ key)))
+ (org-split-string
+ (org-bibtex-get-citation-key fragment) ",") ","))))))
(ad-activate 'org-html-keyword)
(ad-activate 'org-html-latex-fragment)
-(ad-activate 'org-html-link)
-
-
-;;;; Filter
-
-(defun org-bibtex-process-bib-files (tree backend info)
- "Send each bibliography in parse tree to \"bibtex2html\" process.
-Return new parse tree. This function assumes current back-end is HTML."
- ;; Initialize dynamically scoped variables. The first one
- ;; contain an alist between keyword objects and their HTML
- ;; translation. The second one will contain an alist between
- ;; citation keys and names in the output (according to style).
- (setq org-bibtex-html-entries-alist nil
- org-bibtex-html-keywords-alist nil)
- (org-element-map tree 'keyword
- (lambda (keyword)
- (when (equal (org-element-property :key keyword) "BIBLIOGRAPHY")
- (let ((arguments (org-bibtex-get-arguments keyword))
- (file (org-bibtex-get-file keyword))
- temp-file)
- ;; limit is set: collect citations throughout the document
- ;; in TEMP-FILE and pass it to "bibtex2html" as "-citefile"
- ;; argument.
- (when (plist-get arguments :limit)
- (let ((citations
- (org-element-map tree '(latex-fragment link)
- (lambda (object)
- (and (org-bibtex-citation-p object)
- (org-bibtex-get-citation-key object))))))
- (with-temp-file (setq temp-file (make-temp-file "ox-bibtex"))
- (insert (mapconcat 'identity citations "\n")))
- (setq arguments
- (plist-put arguments
- :options
- (append (plist-get arguments :options)
- (list "-citefile" temp-file))))))
- ;; Call "bibtex2html" on specified file.
- (unless (eq 0 (apply 'call-process
- (append '("bibtex2html" nil nil nil)
- '("-a" "-nodoc" "-noheader" "-nofooter")
- (list "--style"
- (org-bibtex-get-style keyword))
- (plist-get arguments :options)
- (list (concat file ".bib")))))
- (error "Executing bibtex2html failed"))
- (and temp-file (delete-file temp-file))
- ;; Open produced HTML file, wrap references within a block and
- ;; return it.
- (with-temp-buffer
- (insert "<div id=\"bibliography\">\n<h2>References</h2>\n")
- (insert-file-contents (concat file ".html"))
- (insert "\n</div>")
- ;; Update `org-bibtex-html-keywords-alist'.
- (push (cons keyword (buffer-string))
- org-bibtex-html-keywords-alist)
- ;; Update `org-bibtex-html-entries-alist'.
- (goto-char (point-min))
- (while (re-search-forward
- "a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\(\\w+\\)" nil t)
- (push (cons (match-string 1) (match-string 2))
- org-bibtex-html-entries-alist)))))))
- ;; Return parse tree unchanged.
- tree)
-(eval-after-load 'ox
- '(add-to-list 'org-export-filter-parse-tree-functions
- 'org-bibtex-process-bib-files))
+
+;;; Ascii Part
+(defadvice org-ascii-keyword (around bibtex-keyword)
+ "Translate \"BIBLIOGRAPHY\" keywords into ascii syntax.
+Fallback to `ascii' back-end for other keywords."
+ (let ((keyword (ad-get-arg 0)))
+ (if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
+ ad-do-it
+ (setq ad-return-value
+ (cdr (assq keyword org-bibtex-html-keywords-alist))))))
+(defadvice org-ascii-latex-fragment (around bibtex-citation)
+ "Translate \"\\cite\" LaTeX fragments into ascii syntax.
+Fallback to `ascii' back-end for other keywords."
+ (let ((fragment (ad-get-arg 0)))
+ (if (not (org-bibtex-citation-p fragment)) ad-do-it
+ (setq ad-return-value
+ (format "[%s]"
+ (mapconcat
+ (lambda (key)
+ (or (cdr (assoc key org-bibtex-html-entries-alist))
+ key))
+ (org-split-string
+ (org-bibtex-get-citation-key fragment) ",") ","))))))
+(ad-activate 'org-ascii-keyword)
+(ad-activate 'org-ascii-latex-fragment)
(provide 'ox-bibtex)
diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el
index 538fe02..9b96d5f 100644
--- a/contrib/lisp/ox-confluence.el
+++ b/contrib/lisp/ox-confluence.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2012, 2014 Sébastien Delafond
-;; Author: Sébastien Delafond <sdelafond at gmx dot net>
+;; Author: Sébastien Delafond <sdelafond@gmail.com>
;; Keywords: outlines, confluence, wiki
;; This file is not part of GNU Emacs.
@@ -45,7 +45,9 @@
(footnote-reference . org-confluence-empty)
(headline . org-confluence-headline)
(italic . org-confluence-italic)
+ (item . org-confluence-item)
(link . org-confluence-link)
+ (property-drawer . org-confluence-property-drawer)
(section . org-confluence-section)
(src-block . org-confluence-src-block)
(strike-through . org-confluence-strike-through)
@@ -70,6 +72,11 @@
(defun org-confluence-italic (italic contents info)
(format "_%s_" contents))
+(defun org-confluence-item (item contents info)
+ (concat (make-string (1+ (org-confluence--li-depth item)) ?\-)
+ " "
+ (org-trim contents)))
+
(defun org-confluence-fixed-width (fixed-width contents info)
(format "\{\{%s\}\}" contents))
@@ -93,6 +100,11 @@
(t
raw-link))
"]")))
+
+(defun org-confluence-property-drawer (property-drawer contents info)
+ (and (org-string-nw-p contents)
+ (format "\{\{%s\}\}" contents)))
+
(defun org-confluence-section (section contents info)
contents)
@@ -138,6 +150,22 @@
contents
"\{code\}\n"))
+(defun org-confluence--li-depth (item)
+ "Return depth of a list item; -1 means not a list item"
+ ;; FIXME check whether it's worth it to cache depth
+ ;; (it gets recalculated quite a few times while
+ ;; traversing a list)
+ (let ((depth -1)
+ (tag))
+ (while (and item
+ (setq tag (car item))
+ (or (eq tag 'item) ; list items interleave with plain-list
+ (eq tag 'plain-list)))
+ (when (eq tag 'item)
+ (incf depth))
+ (setq item (org-export-get-parent item)))
+ depth))
+
;; main interactive entrypoint
(defun org-confluence-export-as-confluence
(&optional async subtreep visible-only body-only ext-plist)
diff --git a/contrib/lisp/ox-deck.el b/contrib/lisp/ox-deck.el
index 9d84b03..427c7d7 100644
--- a/contrib/lisp/ox-deck.el
+++ b/contrib/lisp/ox-deck.el
@@ -38,6 +38,12 @@
;; See ox.el and ox-html.el for more details on how this exporter
;; works (it is derived from ox-html.)
+;; TODOs
+;; ------
+;; The title page is formatted using format-spec. This is error prone
+;; when details are missing and may insert empty tags, like <h2></h2>,
+;; for missing values.
+
(require 'ox-html)
(eval-when-compile (require 'cl))
@@ -51,11 +57,13 @@
(if a (org-deck-export-to-html t s v b)
(org-open-file (org-deck-export-to-html nil s v b)))))))
:options-alist
- '((:html-link-home "HTML_LINK_HOME" nil nil)
+ '((:description "DESCRIPTION" nil nil newline)
+ (:keywords "KEYWORDS" nil nil space)
+ (:html-link-home "HTML_LINK_HOME" nil nil)
(:html-link-up "HTML_LINK_UP" nil nil)
(:deck-postamble "DECK_POSTAMBLE" nil org-deck-postamble newline)
(:deck-preamble "DECK_PREAMBLE" nil org-deck-preamble newline)
- (:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" nil nil)
+ (:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" "html-style" nil)
(:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil nil)
(:deck-base-url "DECK_BASE_URL" nil org-deck-base-url)
(:deck-theme "DECK_THEME" nil org-deck-theme)
@@ -259,6 +267,7 @@ Defaults to styles for the title page."
(defcustom org-deck-title-slide-template
"<h1>%t</h1>
+<h2>%s</h2>
<h2>%a</h2>
<h2>%e</h2>
<h2>%d</h2>"
@@ -319,7 +328,7 @@ and have the id \"title-slide\"."
(include (plist-get info :deck-include-extensions))
(exclude (plist-get info :deck-exclude-extensions))
(scripts '()) (sheets '()) (snippets '()))
- (add-to-list 'scripts (concat prefix "jquery-1.7.2.min.js"))
+ (add-to-list 'scripts (concat prefix "jquery.min.js"))
(add-to-list 'scripts (concat prefix "core/deck.core.js"))
(add-to-list 'scripts (concat prefix "modernizr.custom.js"))
(add-to-list 'sheets (concat prefix "core/deck.core.css"))
@@ -368,12 +377,14 @@ holding export options."
"Transcode an ITEM element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information.
-If the containing headline has the property :slide, then
+If the containing headline has the property :STEP, then
the \"slide\" class will be added to the to the list element,
which will make the list into a \"build\"."
(let ((text (org-html-item item contents info)))
(if (org-export-get-node-property :STEP item t)
- (replace-regexp-in-string "^<li>" "<li class='slide'>" text)
+ (progn
+ (replace-regexp-in-string "^<li>" "<li class='slide'>" text)
+ (replace-regexp-in-string "^<li class='checkbox'>" "<li class='checkbox slide'>" text))
text)))
(defun org-deck-link (link desc info)
diff --git a/contrib/lisp/ox-extra.el b/contrib/lisp/ox-extra.el
new file mode 100644
index 0000000..e6d45cc
--- /dev/null
+++ b/contrib/lisp/ox-extra.el
@@ -0,0 +1,190 @@
+;;; ox-extra.el --- Convenience functions for org export
+
+;; Copyright (C) 2014 Aaron Ecay
+
+;; Author: Aaron Ecay <aaronecay@gmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains some convenience functions for org export, which
+;; are not part of org's core. Call `ox-extras-activate' passing a
+;; list of symbols naming extras, which will be installed globally in
+;; your org session.
+;;
+;; For example, you could include the following in your .emacs file:
+;;
+;; (require 'ox-extra)
+;; (ox-extras-activate '(latex-header-blocks ignore-headlines))
+;;
+
+;; Currently available extras:
+
+;; - `latex-header-blocks' -- allow the use of latex blocks, the
+;; contents of which which will be interpreted as #+latex_header lines
+;; for export. These blocks should be tagged with #+header: :header
+;; yes. For example:
+;; #+header: :header yes
+;; #+begin_latex
+;; ...
+;; #+end_latex
+
+;; - `ignore-headlines' -- allow a headline (but not its children) to
+;; be ignored. Any headline tagged with the 'ignore' tag will be
+;; ignored (i.e. will not be included in the export), but any child
+;; headlines will not be ignored (unless explicitly tagged to be
+;; ignored), and will instead have their levels promoted by one.
+
+;; TODO:
+;; - add a function to org-mode-hook that looks for a ox-extras local
+;; variable and activates the specified extras buffer-locally
+;; - allow specification of desired extras to be activated via
+;; customize
+
+;;; Code:
+
+(require 'ox)
+(eval-when-compile (require 'cl))
+
+(defun org-latex-header-blocks-filter (backend)
+ (when (org-export-derived-backend-p backend 'latex)
+ (let ((positions
+ (org-element-map (org-element-parse-buffer 'greater-element nil) 'export-block
+ (lambda (block)
+ (when (and (string= (org-element-property :type block) "LATEX")
+ (string= (org-export-read-attribute
+ :header block :header)
+ "yes"))
+ (list (org-element-property :begin block)
+ (org-element-property :end block)
+ (org-element-property :post-affiliated block)))))))
+ (mapc (lambda (pos)
+ (goto-char (nth 2 pos))
+ (destructuring-bind
+ (beg end &rest ignore)
+ (org-edit-src-find-region-and-lang)
+ (let ((contents-lines (split-string
+ (buffer-substring-no-properties beg end)
+ "\n")))
+ (delete-region (nth 0 pos) (nth 1 pos))
+ (dolist (line contents-lines)
+ (insert (concat "#+latex_header: "
+ (replace-regexp-in-string "\\` *" "" line)
+ "\n"))))))
+ ;; go in reverse, to avoid wrecking the numeric positions
+ ;; earlier in the file
+ (reverse positions)))))
+
+
+;; During export headlines which have the "ignore" tag are removed
+;; from the parse tree. Their contents are retained (leading to a
+;; possibly invalid parse tree, which nevertheless appears to function
+;; correctly with most export backends) all children headlines are
+;; retained and are promoted to the level of the ignored parent
+;; headline.
+;;
+;; This makes it possible to add structure to the original Org-mode
+;; document which does not effect the exported version, such as in the
+;; following examples.
+;;
+;; Wrapping an abstract in a headline
+;;
+;; * Abstract :ignore:
+;; #+LaTeX: \begin{abstract}
+;; #+HTML: <div id="abstract">
+;;
+;; ...
+;;
+;; #+HTML: </div>
+;; #+LaTeX: \end{abstract}
+;;
+;; Placing References under a headline (using ox-bibtex in contrib)
+;;
+;; * References :ignore:
+;; #+BIBLIOGRAPHY: dissertation plain
+;;
+;; Inserting an appendix for LaTeX using the appendix package.
+;;
+;; * Appendix :ignore:
+;; #+LaTeX: \begin{appendices}
+;; ** Reproduction
+;; ...
+;; ** Definitions
+;; #+LaTeX: \end{appendices}
+;;
+(defun org-export-ignore-headlines (data backend info)
+ "Remove headlines tagged \"ignore\" retaining contents and promoting children.
+Each headline tagged \"ignore\" will be removed retaining its
+contents and promoting any children headlines to the level of the
+parent."
+ (org-element-map data 'headline
+ (lambda (object)
+ (when (member "ignore" (org-element-property :tags object))
+ (let ((level-top (org-element-property :level object))
+ level-diff)
+ (mapc (lambda (el)
+ ;; recursively promote all nested headlines
+ (org-element-map el 'headline
+ (lambda (el)
+ (when (equal 'headline (org-element-type el))
+ (unless level-diff
+ (setq level-diff (- (org-element-property :level el)
+ level-top)))
+ (org-element-put-property el
+ :level (- (org-element-property :level el)
+ level-diff)))))
+ ;; insert back into parse tree
+ (org-element-insert-before el object))
+ (org-element-contents object)))
+ (org-element-extract-element object)))
+ info nil)
+ data)
+
+(defconst ox-extras
+ '((latex-header-blocks org-latex-header-blocks-filter org-export-before-parsing-hook)
+ (ignore-headlines org-export-ignore-headlines org-export-filter-parse-tree-functions))
+ "A list of org export extras that can be enabled.
+
+Should be a list of items of the form (NAME FN HOOK). NAME is a
+symbol, which can be passed to `ox-extras-activate'. FN is a
+function which will be added to HOOK.")
+
+(defun ox-extras-activate (extras)
+ "Activate certain org export extras.
+
+EXTRAS should be a list of extras (defined in `ox-extras') which
+should be activated."
+ (dolist (extra extras)
+ (let* ((lst (assq extra ox-extras))
+ (fn (nth 1 lst))
+ (hook (nth 2 lst)))
+ (when (and fn hook)
+ (add-hook hook fn)))))
+
+(defun ox-extras-deactivate (extras)
+ "Deactivate certain org export extras.
+
+This function is the opposite of `ox-extras-activate'. EXTRAS
+should be a list of extras (defined in `ox-extras') which should
+be activated."
+ (dolist (extra extras)
+ (let* ((lst (assq extra ox-extras))
+ (fn (nth 1 lst))
+ (hook (nth 2 lst)))
+ (when (and fn hook)
+ (remove-hook hook fn)))))
+
+(provide 'ox-extra)
+;;; ox-extra.el ends here
diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el
index 39fb1cc..3287d5d 100644
--- a/contrib/lisp/ox-freemind.el
+++ b/contrib/lisp/ox-freemind.el
@@ -312,7 +312,7 @@ will result in following node:
(org-element-property :title element))
(org-data
(plist-get info :title))
- (t (error "Shouldn't come here."))))
+ (t (error "Shouldn't come here"))))
(element-contents (org-element-contents element))
(section (assq 'section element-contents))
(section-contents
diff --git a/contrib/lisp/ox-gfm.el b/contrib/lisp/ox-gfm.el
new file mode 100644
index 0000000..f7acc94
--- /dev/null
+++ b/contrib/lisp/ox-gfm.el
@@ -0,0 +1,193 @@
+;;; ox-gfm.el --- Github Flavored Markdown Back-End for Org Export Engine
+
+;; Copyright (C) 2014 Lars Tveito
+
+;; Author: Lars Tveito
+;; Keywords: org, wp, markdown, github
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implements a Markdown back-end (github flavor) for Org
+;; exporter, based on the `md' back-end.
+
+;;; Code:
+
+(require 'ox-md)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-gfm nil
+ "Options specific to Markdown export back-end."
+ :tag "Org Github Flavored Markdown"
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defcustom org-gfm-lang '(("emacs-lisp" . "lisp") ("elisp" . "lisp"))
+ "Alist of languages that are not recognized by Github, to
+ languages that are. Emacs lisp is a good example of this, where
+ we can use lisp as a nice replacement."
+ :group 'org-export-gfm)
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend 'gfm 'md
+ :export-block '("GFM" "GITHUB FLAVORED MARKDOWN")
+ :filters-alist '((:filter-parse-tree . org-md-separate-elements))
+ :menu-entry
+ '(?g "Export to Github Flavored Markdown"
+ ((?G "To temporary buffer"
+ (lambda (a s v b) (org-gfm-export-as-markdown a s v)))
+ (?g "To file" (lambda (a s v b) (org-gfm-export-to-markdown a s v)))
+ (?o "To file and open"
+ (lambda (a s v b)
+ (if a (org-gfm-export-to-markdown t s v)
+ (org-open-file (org-gfm-export-to-markdown nil s v)))))))
+ :translate-alist '((inner-template . org-gfm-inner-template)
+ (strike-through . org-gfm-strike-through)
+ (src-block . org-gfm-src-block)))
+
+
+
+;;; Transcode Functions
+
+;;;; Src Block
+
+(defun org-gfm-src-block (src-block contents info)
+ "Transcode SRC-BLOCK element into Github Flavored Markdown
+format. CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let* ((lang (org-element-property :language src-block))
+ (lang (or (assoc-default lang org-gfm-lang) lang))
+ (code (org-export-format-code-default src-block info))
+ (prefix (concat "```" lang "\n"))
+ (suffix "```"))
+ (concat prefix code suffix)))
+
+
+;;;; Strike-Through
+
+(defun org-html-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to Markdown (GFM).
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "~~%s~~" contents))
+
+;;;; Table of contents
+
+(defun org-gfm-format-toc (headline)
+ "Return an appropriate table of contents entry for HEADLINE. INFO is a
+plist used as a communication channel."
+ (let* ((title (org-export-data
+ (org-export-get-alt-title headline info) info))
+ (level (1- (org-element-property :level headline)))
+ (indent (concat (make-string (* level 2) ? )))
+ (ref-str (replace-regexp-in-string " " "-" (downcase title))))
+ (concat indent "- [" title "]" "(#" ref-str ")")))
+
+
+;;;; Template
+
+(defun org-gfm-inner-template (contents info)
+ "Return body of document after converting it to Markdown syntax.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let* ((depth (plist-get info :with-toc))
+ (headlines (and depth (org-export-collect-headlines info depth)))
+ (toc-string (or (mapconcat 'org-gfm-format-toc headlines "\n") ""))
+ (toc-tail (if headlines "\n\n" "")))
+ (concat toc-string toc-tail contents)))
+
+
+
+;;; Interactive function
+
+;;;###autoload
+(defun org-gfm-export-as-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Github Flavored Markdown buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Export is done in a buffer named \"*Org GFM Export*\", which will
+be displayed when `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (org-export-to-buffer 'gfm "*Org GFM Export*"
+ async subtreep visible-only nil nil (lambda () (text-mode))))
+
+
+;;;###autoload
+(defun org-gfm-convert-region-to-md ()
+ "Assume the current region has org-mode syntax, and convert it
+to Github Flavored Markdown. This can be used in any buffer.
+For example, you can write an itemized list in org-mode syntax in
+a Markdown buffer and use this command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'gfm))
+
+
+;;;###autoload
+(defun org-gfm-export-to-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Github Flavored Markdown file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".md" subtreep)))
+ (org-export-to-file 'gfm outfile async subtreep visible-only)))
+
+(provide 'ox-gfm)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-gfm.el ends here
diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el
index b3e3ad3..ade3478 100644
--- a/contrib/lisp/ox-groff.el
+++ b/contrib/lisp/ox-groff.el
@@ -1,6 +1,6 @@
;;; ox-groff.el --- Groff Back-End for Org Export Engine
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Author: Luis R Anaya <papoanaya aroba hot mail punto com>
@@ -50,8 +50,6 @@
(center-block . org-groff-center-block)
(clock . org-groff-clock)
(code . org-groff-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-groff-drawer)
(dynamic-block . org-groff-dynamic-block)
(entity . org-groff-entity)
@@ -70,13 +68,13 @@
(keyword . org-groff-keyword)
(line-break . org-groff-line-break)
(link . org-groff-link)
+ (node-property . org-groff-node-property)
(paragraph . org-groff-paragraph)
(plain-list . org-groff-plain-list)
(plain-text . org-groff-plain-text)
(planning . org-groff-planning)
- (property-drawer . (lambda (&rest args) ""))
+ (property-drawer . org-groff-property-drawer)
(quote-block . org-groff-quote-block)
- (quote-section . org-groff-quote-section)
(radio-target . org-groff-radio-target)
(section . org-groff-section)
(special-block . org-groff-special-block)
@@ -563,7 +561,8 @@ See `org-groff-text-markup-alist' for details."
(t (format ".AF \"%s\" \n" (or org-groff-organization "")))))
;; 2. Title
- (let ((subtitle1 (plist-get attr :subtitle1))
+ (let ((title (if (plist-get info :with-title) title ""))
+ (subtitle1 (plist-get attr :subtitle1))
(subtitle2 (plist-get attr :subtitle2)))
(cond
@@ -1253,11 +1252,10 @@ INFO is a plist holding contextual information. See
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file://" raw-path))
- (t raw-path)))
- protocol)
+ ((string= type "file") (org-export-file-uri raw-path))
+ (t raw-path))))
(cond
+ ((org-export-custom-protocol-maybe link desc 'groff))
;; Image file.
(imagep (org-groff-link--inline-image link info))
;; import groff files
@@ -1270,8 +1268,7 @@ INFO is a plist holding contextual information. See
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
(format "\\fI [%s] \\fP"
- (org-export-solidify-link-text
- (org-element-property :value destination))))))
+ (org-export-get-reference destination info)))))
;; Links pointing to a headline: find destination and build
;; appropriate referencing command.
@@ -1303,9 +1300,9 @@ INFO is a plist holding contextual information. See
(org-element-property :title destination) info))))))
;; Fuzzy link points to a target. Do as above.
(otherwise
- (let ((path (org-export-solidify-link-text path)))
- (if (not desc) (format "\\fI%s\\fP" path)
- (format "%s \\fBat\\fP \\fI%s\\fP" desc path)))))))
+ (let ((ref (org-export-get-reference destination info)))
+ (if (not desc) (format "\\fI%s\\fP" ref)
+ (format "%s \\fBat\\fP \\fI%s\\fP" desc ref)))))))
;; External link with a description part.
((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
;; External link without a description part.
@@ -1313,6 +1310,17 @@ INFO is a plist holding contextual information. See
;; No path, only description. Try to do something useful.
(t (format org-groff-link-with-unknown-path-format desc)))))
+;;; Node Property
+
+(defun org-groff-node-property (node-property contents info)
+ "Transcode a NODE-PROPERTY element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
+
;;; Paragraph
(defun org-groff-paragraph (paragraph contents info)
@@ -1423,6 +1431,15 @@ information."
"")
""))
+;;;; Property Drawer
+
+(defun org-groff-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to Groff.
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format "\\fC\n%s\\fP" contents)))
+
;;; Quote Block
(defun org-groff-quote-block (quote-block contents info)
@@ -1433,25 +1450,13 @@ holding contextual information."
quote-block
(format ".DS I\n.I\n%s\n.R\n.DE" contents)))
-;;; Quote Section
-
-(defun org-groff-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format ".DS L\n\\fI%s\\fP\n.DE\n" value))))
-
;;; Radio Target
(defun org-groff-radio-target (radio-target text info)
"Transcode a RADIO-TARGET object from Org to Groff.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- (format "%s - %s"
- (org-export-solidify-link-text
- (org-element-property :value radio-target))
- text))
+ (format "%s - %s" (org-export-get-reference radio-target info) text))
;;; Section
@@ -1467,7 +1472,7 @@ holding contextual information."
"Transcode a SPECIAL-BLOCK element from Org to Groff.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let ((type (downcase (org-element-property :type special-block))))
+ (let ((type (org-element-property :type special-block)))
(org-groff--wrap-label
special-block
(format "%s\n" contents))))
@@ -1781,8 +1786,7 @@ a communication channel."
"Transcode a TARGET object from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "\\fI%s\\fP"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "\\fI%s\\fP" (org-export-get-reference target info)))
;;; Timestamp
diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el
index 1755fbe..8ba380c 100644
--- a/contrib/lisp/ox-koma-letter.el
+++ b/contrib/lisp/ox-koma-letter.el
@@ -1,6 +1,6 @@
;;; ox-koma-letter.el --- KOMA Scrlttr2 Back-End for Org Export Engine
-;; Copyright (C) 2007-2012, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou AT gmail DOT com>
;; Alan Schmitt <alan.schmitt AT polytechnique DOT org>
@@ -85,16 +85,10 @@
;; with information is present precedence is determined by
;; `org-koma-letter-prefer-special-headings'.
;;
-;; You will need to add an appropriate association in
-;; `org-latex-classes' in order to use the KOMA Scrlttr2 class.
-;; The easiest way to do this is by adding
-;;
-;; (eval-after-load "ox-koma-letter"
-;; '(org-koma-letter-plug-into-ox))
-;;
-;; to your init file. This will add a sparse scrlttr2 class and
-;; set it as the default `org-koma-latex-default-class'. You can also
-;; add you own letter class. For instace:
+;; You need an appropriate association in `org-latex-classes' in order
+;; to use the KOMA Scrlttr2 class. By default, a sparse scrlttr2
+;; class is provided: "default-koma-letter". You can also add you own
+;; letter class. For instance:
;;
;; (add-to-list 'org-latex-classes
;; '("my-letter"
@@ -127,6 +121,11 @@
(require 'ox-latex)
+;; Install a default letter class.
+(unless (assoc "default-koma-letter" org-latex-classes)
+ (add-to-list 'org-latex-classes
+ '("default-koma-letter" "\\documentclass[11pt]{scrlttr2}")))
+
;;; User-Configurable Variables
@@ -136,17 +135,20 @@
:group 'org-export)
(defcustom org-koma-letter-class-option-file "NF"
- "Letter Class Option File."
+ "Letter Class Option File.
+This option can also be set with the LCO keyword."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-author 'user-full-name
- "The sender's name.
+ "Sender's name.
This variable defaults to calling the function `user-full-name'
-which just returns the current function `user-full-name'. Alternatively a
-string, nil or a function may be given. Functions must return a
-string."
+which just returns the current function `user-full-name'.
+Alternatively a string, nil or a function may be given.
+Functions must return a string.
+
+This option can also be set with the AUTHOR keyword."
:group 'org-export-koma-letter
:type '(radio (function-item user-full-name)
(string)
@@ -154,133 +156,223 @@ string."
(const :tag "Do not export author" nil)))
(defcustom org-koma-letter-email 'org-koma-letter-email
- "The sender's email address.
+ "Sender's email address.
This variable defaults to the value `org-koma-letter-email' which
-returns `user-mail-address'. Alternatively a string, nil or a
-function may be given. Functions must return a string."
+returns `user-mail-address'. Alternatively a string, nil or
+a function may be given. Functions must return a string.
+
+This option can also be set with the EMAIL keyword."
:group 'org-export-koma-letter
:type '(radio (function-item org-koma-letter-email)
(string)
(function)
(const :tag "Do not export email" nil)))
-(defcustom org-koma-letter-from-address nil
- "Sender's address, as a string."
+(defcustom org-koma-letter-from-address ""
+ "Sender's address, as a string.
+This option can also be set with one or more FROM_ADDRESS
+keywords."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-phone-number nil
- "Sender's phone number, as a string."
+(defcustom org-koma-letter-phone-number ""
+ "Sender's phone number, as a string.
+This option can also be set with the PHONE_NUMBER keyword."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-place nil
- "Place from which the letter is sent."
+(defcustom org-koma-letter-place ""
+ "Place from which the letter is sent, as a string.
+This option can also be set with the PLACE keyword."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-opening nil
+(defcustom org-koma-letter-opening ""
"Letter's opening, as a string.
-If (1) this value is nil; (2) the letter is started with a
-headline; and (3) `org-koma-letter-headline-is-opening-maybe' is
-t the value opening will be implicit set as the headline title."
+This option can also be set with the OPENING keyword. Moreover,
+when:
+ (1) this value is the empty string;
+ (2) there's no OPENING keyword or it is empty;
+ (3) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (4) the letter contains a headline without a special
+ tag (e.g. \"to\" or \"ps\");
+then the opening will be implicitly set as the headline title."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-closing nil
- "Koma-Letter's closing, as a string."
+(defcustom org-koma-letter-closing ""
+ "Letter's closing, as a string.
+This option can also be set with the CLOSING keyword. Moreover,
+when:
+ (1) there's no CLOSING keyword or it is empty;
+ (2) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (3) the letter contains a headline with the special
+ tag closing;
+then the opening will be set as the title of the closing special
+heading."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-prefer-special-headings nil
- "If TO and/or FROM is specified using both a heading and a keyword the heading value will be preferred if the variable is t."
+(defcustom org-koma-letter-signature ""
+ "Signature, as a string.
+This option can also be set with the SIGNATURE keyword.
+Moreover, when:
+ (1) there's no CLOSING keyword or it is empty;
+ (2) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (3) the letter contains a headline with the special
+ tag closing;
+then the signature will be set as the content of the
+closing special heading."
:group 'org-export-koma-letter
- :type 'boolean)
+ :type 'string)
-(defcustom org-koma-letter-signature nil
- "String used as the signature."
+(defcustom org-koma-letter-prefer-special-headings nil
+ "Non-nil means prefer headlines over keywords for TO and FROM.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"special-headings:t\"."
:group 'org-export-koma-letter
- :type 'string)
+ :type 'boolean)
(defcustom org-koma-letter-subject-format t
- "Use the title as the subject of the letter.
+ "Non-nil means include the subject.
+
+Support formatting options.
-At this time the following values are allowed:
+When t, insert a subject using default options. When nil, do not
+insert a subject at all. It can also be a list of symbols among
+the following ones:
- - afteropening: subject after opening.
- - beforeopening: subject before opening.
- - centered: subject centered.
- - left:subject left-justified.
- - right: subject right-justified.
- - titled: add title/description to subject.
- - underlined: set subject underlined.
- - untitled: do not add title/description to subject.
- - No-export: do no insert a subject even if present.
+ `afteropening' Subject after opening
+ `beforeopening' Subject before opening
+ `centered' Subject centered
+ `left' Subject left-justified
+ `right' Subject right-justified
+ `titled' Add title/description to subject
+ `underlined' Set subject underlined
+ `untitled' Do not add title/description to subject
Please refer to the KOMA-script manual (Table 4.16. in the
-English manual of 2012-07-22)."
- :type '(radio
- (const :tag "No export" nil)
- (const :tag "Default options" t)
- (set :tag "selection"
- (const 'afteropening)
- (const 'beforeopening)
- (const 'centered)
- (const 'left)
- (const 'right)
- (const 'underlined)
- (const 'titled)
- (const 'untitled))
- (string))
+English manual of 2012-07-22).
+
+This option can also be set with the OPTIONS keyword, e.g.:
+\"subject:(underlined centered)\"."
+ :type
+ '(choice
+ (const :tag "No export" nil)
+ (const :tag "Default options" t)
+ (set :tag "Configure options"
+ (const :tag "Subject after opening" afteropening)
+ (const :tag "Subject before opening" beforeopening)
+ (const :tag "Subject centered" centered)
+ (const :tag "Subject left-justified" left)
+ (const :tag "Subject right-justified" right)
+ (const :tag "Add title or description to subject" underlined)
+ (const :tag "Set subject underlined" titled)
+ (const :tag "Do not add title or description to subject" untitled)))
:group 'org-export-koma-letter)
(defcustom org-koma-letter-use-backaddress nil
- "Print return address in line above to address."
+ "Non-nil prints return address in line above to address.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"backaddress:t\"."
:group 'org-export-koma-letter
:type 'boolean)
-(defcustom org-koma-letter-use-foldmarks "true"
- "Configure appearence of fold marks.
+(defcustom org-koma-letter-use-foldmarks t
+ "Configure appearance of folding marks.
+
+When t, activate default folding marks. When nil, do not insert
+folding marks at all. It can also be a list of symbols among the
+following ones:
+
+ `B' Activate upper horizontal mark on left paper edge
+ `b' Deactivate upper horizontal mark on left paper edge
+
+ `H' Activate all horizontal marks on left paper edge
+ `h' Deactivate all horizontal marks on left paper edge
+
+ `L' Activate left vertical mark on upper paper edge
+ `l' Deactivate left vertical mark on upper paper edge
+
+ `M' Activate middle horizontal mark on left paper edge
+ `m' Deactivate middle horizontal mark on left paper edge
+
+ `P' Activate punch or center mark on left paper edge
+ `p' Deactivate punch or center mark on left paper edge
+
+ `T' Activate lower horizontal mark on left paper edge
+ `t' Deactivate lower horizontal mark on left paper edge
-Accepts any valid value for the KOMA-Script `foldmarks' option.
+ `V' Activate all vertical marks on upper paper edge
+ `v' Deactivate all vertical marks on upper paper edge
-Use `foldmarks:true' to activate default fold marks or
-`foldmarks:nil' to deactivate fold marks."
+This option can also be set with the OPTIONS keyword, e.g.:
+\"foldmarks:(b l m t)\"."
:group 'org-export-koma-letter
- :type 'string)
+ :type '(choice
+ (const :tag "Activate default folding marks" t)
+ (const :tag "Deactivate folding marks" nil)
+ (set
+ :tag "Configure folding marks"
+ (const :tag "Activate upper horizontal mark on left paper edge" B)
+ (const :tag "Deactivate upper horizontal mark on left paper edge" b)
+ (const :tag "Activate all horizontal marks on left paper edge" H)
+ (const :tag "Deactivate all horizontal marks on left paper edge" h)
+ (const :tag "Activate left vertical mark on upper paper edge" L)
+ (const :tag "Deactivate left vertical mark on upper paper edge" l)
+ (const :tag "Activate middle horizontal mark on left paper edge" M)
+ (const :tag "Deactivate middle horizontal mark on left paper edge" m)
+ (const :tag "Activate punch or center mark on left paper edge" P)
+ (const :tag "Deactivate punch or center mark on left paper edge" p)
+ (const :tag "Activate lower horizontal mark on left paper edge" T)
+ (const :tag "Deactivate lower horizontal mark on left paper edge" t)
+ (const :tag "Activate all vertical marks on upper paper edge" V)
+ (const :tag "Deactivate all vertical marks on upper paper edge" v))))
(defcustom org-koma-letter-use-phone nil
- "Print sender's phone number."
+ "Non-nil prints sender's phone number.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"phone:t\"."
:group 'org-export-koma-letter
:type 'boolean)
(defcustom org-koma-letter-use-email nil
- "Print sender's email address."
+ "Non-nil prints sender's email address.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"email:t\"."
:group 'org-export-koma-letter
:type 'boolean)
(defcustom org-koma-letter-use-place t
- "Print the letter's place next to the date."
+ "Non-nil prints the letter's place next to the date.
+This option can also be set with the OPTIONS keyword, e.g.:
+\"place:nil\"."
:group 'org-export-koma-letter
:type 'boolean)
-(defcustom org-koma-letter-default-class nil
+(defcustom org-koma-letter-default-class "default-koma-letter"
"Default class for `org-koma-letter'.
-
The value must be a member of `org-latex-classes'."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-headline-is-opening-maybe t
- "Whether a headline may be used as an opening.
+ "Non-nil means a headline may be used as an opening.
A headline is only used if #+OPENING is not set. See also
`org-koma-letter-opening'."
:group 'org-export-koma-letter
:type 'boolean)
-(defconst org-koma-letter-special-tags-in-letter '(to from)
+(defcustom org-koma-letter-prefer-subject nil
+ "Non-nil means title should be interpreted as subject if subject is missing.
+This option can also be set with the OPTIONS keyword,
+e.g. \"title-subject:t\"."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defconst org-koma-letter-special-tags-in-letter '(to from closing)
"Header tags related to the letter itself.")
(defconst org-koma-letter-special-tags-after-closing '(ps encl cc)
@@ -292,47 +384,58 @@ A headline is only used if #+OPENING is not set. See also
(defvar org-koma-letter-special-contents nil
"Holds special content temporarily.")
+(make-obsolete-variable 'org-koma-letter-use-title
+ 'org-export-with-title
+ "25.1" 'set)
;;; Define Back-End
(org-export-define-derived-backend 'koma-letter 'latex
:options-alist
- '((:lco "LCO" nil org-koma-letter-class-option-file)
- (:latex-class "LATEX_CLASS" nil (if org-koma-letter-default-class
- org-koma-letter-default-class
- org-latex-default-class) t)
- (:author "AUTHOR" nil (org-koma-letter--get-value org-koma-letter-author) t)
+ '((:latex-class "LATEX_CLASS" nil org-koma-letter-default-class t)
+ (:lco "LCO" nil org-koma-letter-class-option-file)
+ (:author "AUTHOR" nil (org-koma-letter--get-value org-koma-letter-author) parse)
(:author-changed-in-buffer-p "AUTHOR" nil nil t)
(:from-address "FROM_ADDRESS" nil org-koma-letter-from-address newline)
(:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
(:email "EMAIL" nil (org-koma-letter--get-value org-koma-letter-email) t)
- (:email-changed-in-buffer-p "EMAIL" nil nil t)
(:to-address "TO_ADDRESS" nil nil newline)
(:place "PLACE" nil org-koma-letter-place)
- (:opening "OPENING" nil org-koma-letter-opening)
- (:closing "CLOSING" nil org-koma-letter-closing)
+ (:subject "SUBJECT" nil nil parse)
+ (:opening "OPENING" nil org-koma-letter-opening parse)
+ (:closing "CLOSING" nil org-koma-letter-closing parse)
(:signature "SIGNATURE" nil org-koma-letter-signature newline)
+ (:special-headings nil "special-headings"
+ org-koma-letter-prefer-special-headings)
(:special-tags nil nil (append
org-koma-letter-special-tags-in-letter
org-koma-letter-special-tags-after-closing
org-koma-letter-special-tags-after-letter))
- (:special-headings nil "special-headings"
- org-koma-letter-prefer-special-headings)
(:with-after-closing nil "after-closing-order"
org-koma-letter-special-tags-after-closing)
(:with-after-letter nil "after-letter-order"
org-koma-letter-special-tags-after-letter)
(:with-backaddress nil "backaddress" org-koma-letter-use-backaddress)
- (:with-backaddress-changed-in-buffer-p nil "backaddress" nil)
+ (:with-email nil "email" org-koma-letter-use-email)
(:with-foldmarks nil "foldmarks" org-koma-letter-use-foldmarks)
- (:with-foldmarks-changed-in-buffer-p nil "foldmarks" "foldmarks-not-set")
(:with-phone nil "phone" org-koma-letter-use-phone)
- (:with-phone-changed-in-buffer-p nil "phone" nil)
- (:with-email nil "email" org-koma-letter-use-email)
- (:with-email-changed-in-buffer-p nil "email" nil)
(:with-place nil "place" org-koma-letter-use-place)
- (:with-subject nil "subject" org-koma-letter-subject-format))
+ (:with-subject nil "subject" org-koma-letter-subject-format)
+ (:with-title-as-subject nil "title-subject" org-koma-letter-prefer-subject)
+ (:with-headline-opening nil nil org-koma-letter-headline-is-opening-maybe)
+ ;; Special properties non-nil when a setting happened in buffer.
+ ;; They are used to prioritize in-buffer settings over "lco"
+ ;; files. See `org-koma-letter-template'.
+ (:inbuffer-author "AUTHOR" nil 'koma-letter:empty)
+ (:inbuffer-email "EMAIL" nil 'koma-letter:empty)
+ (:inbuffer-phone-number "PHONE_NUMBER" nil 'koma-letter:empty)
+ (:inbuffer-place "PLACE" nil 'koma-letter:empty)
+ (:inbuffer-signature "SIGNATURE" nil 'koma-letter:empty)
+ (:inbuffer-with-backaddress nil "backaddress" 'koma-letter:empty)
+ (:inbuffer-with-email nil "email" 'koma-letter:empty)
+ (:inbuffer-with-foldmarks nil "foldmarks" 'koma-letter:empty)
+ (:inbuffer-with-phone nil "phone" 'koma-letter:empty))
:translate-alist '((export-block . org-koma-letter-export-block)
(export-snippet . org-koma-letter-export-snippet)
(headline . org-koma-letter-headline)
@@ -348,19 +451,8 @@ A headline is only used if #+OPENING is not set. See also
(if a (org-koma-letter-export-to-pdf t s v b)
(org-open-file (org-koma-letter-export-to-pdf nil s v b))))))))
-
-;;; Initialize class function
-
-(defun org-koma-letter-plug-into-ox ()
- "Add a sparse `default-koma-letter' to `org-latex-classes' and set `org-koma-letter-default-class' to `default-koma-letter'."
- (let ((class "default-koma-letter"))
- (eval-after-load "ox-latex"
- `(unless (member ,class 'org-latex-classes)
- (add-to-list 'org-latex-classes
- `(,class
- "\\documentclass[11pt]{scrlttr2}") ())
- (setq org-koma-letter-default-class class)))))
+
;;; Helper functions
(defun org-koma-letter-email ()
@@ -372,83 +464,63 @@ A headline is only used if #+OPENING is not set. See also
(defun org-koma-letter--get-tagged-contents (key)
"Get contents from a headline tagged with KEY.
-Technically, the contents is stored in `org-koma-letter-special-contents'."
- (cdr (assoc (org-koma-letter--get-value key)
- org-koma-letter-special-contents)))
+The contents is stored in `org-koma-letter-special-contents'."
+ (cdr (assoc-string (org-koma-letter--get-value key)
+ org-koma-letter-special-contents)))
(defun org-koma-letter--get-value (value)
- "Determines if VALUE is nil, a string, a function or a symbol and return a string or nil."
+ "Turn value into a string whenever possible.
+Determines if VALUE is nil, a string, a function or a symbol and
+return a string or nil."
(when value
(cond ((stringp value) value)
((functionp value) (funcall value))
((symbolp value) (symbol-name value))
(t value))))
+(defun org-koma-letter--special-contents-as-macro
+ (keywords &optional keep-newlines no-tag)
+ "Process KEYWORDS members of `org-koma-letter-special-contents'.
+KEYWORDS is a list of symbols. Return them as a string to be
+formatted.
-(defun org-koma-letter--special-contents-as-macro (a-list &optional keep-newlines no-tag)
- "Find members of `org-koma-letter-special-contents' corresponding to A-LIST.
-Return them as a string to be formatted.
-
-The function is used for inserting content of speciall headings
+The function is used for inserting content of special headings
such as PS.
-If KEEP-NEWLINES is t newlines will not be removed. If NO-TAG is
-is t the content in `org-koma-letter-special-contents' will not
-be wrapped in a macro named whatever the members of A-LIST are
-called."
- (let (output)
- (dolist (ac* a-list output)
- (let*
- ((ac (org-koma-letter--get-value ac*))
- (x (org-koma-letter--get-tagged-contents ac)))
- (when x
- (setq output
- (concat
- output "\n"
- ;; sometimes LaTeX complains about newlines
- ;; at the end or beginning of macros. Remove them.
- (org-koma-letter--format-string-as-macro
- (if keep-newlines x (org-koma-letter--normalize-string x))
- (unless no-tag ac)))))))))
-
-(defun org-koma-letter--format-string-as-macro (string &optional macro)
- "Format STRING as \"\\macro{string}\" if MACRO is given else as \"string\"."
- (if macro
- (format "\\%s{%s}" macro string)
- (format "%s" string)))
-
-(defun org-koma-letter--normalize-string (string)
- "Remove new lines in the beginning and end of `STRING'."
- (replace-regexp-in-string "\\`[ \n\t]+\\|[\n\t ]*\\'" "" string))
+If KEEP-NEWLINES is non-nil leading and trailing newlines are not
+removed. If NO-TAG is non-nil the content in
+`org-koma-letter-special-contents' are not wrapped in a macro
+named whatever the members of KEYWORDS are called."
+ (mapconcat
+ (lambda (keyword)
+ (let* ((name (org-koma-letter--get-value keyword))
+ (value (org-koma-letter--get-tagged-contents name)))
+ (cond ((not value) nil)
+ (no-tag (if keep-newlines value (org-trim value)))
+ (t (format "\\%s{%s}\n"
+ name
+ (if keep-newlines value (org-trim value)))))))
+ keywords
+ ""))
(defun org-koma-letter--determine-to-and-from (info key)
"Given INFO determine KEY for the letter.
KEY should be `to' or `from'.
-`ox-koma-letter' allows two ways to specify to and from. If both
+`ox-koma-letter' allows two ways to specify TO and FROM. If both
are present return the preferred one as determined by
`org-koma-letter-prefer-special-headings'."
- (let* ((plist-alist '((from . :from-address)
- (to . :to-address)))
- (default-alist `((from ,org-koma-letter-from-address)
- (to "\\mbox{}")))
- (option-value (plist-get info (cdr-safe (assoc key plist-alist))))
- (head-value (org-koma-letter--get-tagged-contents key))
- (order (append
- (funcall
- (if (plist-get info :special-headings)
- 'reverse 'identity)
- `(,option-value ,head-value))
- (cdr-safe (assoc key default-alist))))
- tmp
- (adr (dolist (x order tmp)
- (when (and (not tmp) x)
- (setq tmp x)))))
- (when adr
+ (let ((option (org-string-nw-p
+ (plist-get info (if (eq key 'to) :to-address :from-address))))
+ (headline (org-koma-letter--get-tagged-contents key)))
(replace-regexp-in-string
"\n" "\\\\\\\\\n"
- (org-koma-letter--normalize-string adr)))))
+ (org-trim
+ (if (plist-get info :special-headings) (or headline option "")
+ (or option headline ""))))))
+
+
;;; Transcode Functions
;;;; Export Block
@@ -477,12 +549,11 @@ CONTENTS is nil. INFO is a plist used as a communication
channel."
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
- ;; Handle specifically BEAMER and TOC (headlines only) keywords.
- ;; Otherwise, fallback to `latex' back-end.
+ ;; Handle specifically KOMA-LETTER keywords. Otherwise, fallback
+ ;; to `latex' back-end.
(if (equal key "KOMA-LETTER") value
(org-export-with-backend 'latex keyword contents info))))
-
;; Headline
(defun org-koma-letter-headline (headline contents info)
@@ -494,24 +565,21 @@ Note that if a headline is tagged with a tag from
`org-koma-letter-special-tags' it will not be exported, but
stored in `org-koma-letter-special-contents' and included at the
appropriate place."
- (let*
- ((tags (org-export-get-tags headline info))
- (tag* (car tags))
- (tag (when tag*
- (car (member-ignore-case
- tag*
- (mapcar 'symbol-name (plist-get info :special-tags)))))))
- (if tag
- (progn
- (push (cons tag contents)
- org-koma-letter-special-contents)
- nil)
- (unless (or (plist-get info :opening)
- (not org-koma-letter-headline-is-opening-maybe))
- (plist-put info :opening
- (org-export-data (org-element-property :title headline) info)))
- contents)))
-
+ (let ((special-tag (org-koma-letter--special-tag headline info)))
+ (if (not special-tag)
+ contents
+ (push (cons special-tag contents) org-koma-letter-special-contents)
+ "")))
+
+(defun org-koma-letter--special-tag (headline info)
+ "Non-nil if HEADLINE is a special headline.
+INFO is a plist holding contextual information. Return first
+special tag headline."
+ (let ((special-tags (plist-get info :special-tags)))
+ (catch 'exit
+ (dolist (tag (org-export-get-tags headline info))
+ (let ((tag (assoc-string tag special-tags)))
+ (when tag (throw 'exit tag)))))))
;;;; Template
@@ -519,123 +587,89 @@ appropriate place."
"Return complete document string after KOMA Scrlttr2 conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- ;; FIXME: instead of setq'ing org-koma-letter-special-contents and
- ;; callying varioues stuff it might be nice to put a big let* around the templace
- ;; as in org-groff...
(concat
;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
;; 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 ; Defined in org.el.
- org-latex-packages-alist nil ; Defined in org.el.
- (concat (org-element-normalize-string (plist-get info :latex-header))
- (plist-get info :latex-header-extra)))))
- info)))
- (let ((lco (plist-get info :lco))
- (author (plist-get info :author))
- (author-set (plist-get info :author-changed-in-buffer-p))
- (from-address (org-koma-letter--determine-to-and-from info 'from))
- (phone-number (plist-get info :phone-number))
- (email (plist-get info :email))
- (email-set (plist-get info :email-changed-in-buffer-p))
- (signature (plist-get info :signature)))
- (concat
- ;; author or email not set in file: may be overridden by lco
- (unless author-set
- (when author (format "\\setkomavar{fromname}{%s}\n"
- (org-export-data author info))))
- (unless email-set
- (when email (format "\\setkomavar{fromemail}{%s}\n" email)))
- ;; Letter Class Option File
- (when lco
- (let ((lco-files (split-string lco " "))
- (lco-def ""))
- (dolist (lco-file lco-files lco-def)
- (setq lco-def (format "%s\\LoadLetterOption{%s}\n" lco-def lco-file)))
- lco-def))
- ;; Define "From" data.
- (when (and author author-set) (format "\\setkomavar{fromname}{%s}\n"
- (org-export-data author info)))
- (when from-address (format "\\setkomavar{fromaddress}{%s}\n" from-address))
- (when phone-number
- (format "\\setkomavar{fromphone}{%s}\n" phone-number))
- (when (and email email-set) (format "\\setkomavar{fromemail}{%s}\n" email))
- (when signature (format "\\setkomavar{signature}{%s}\n" signature))))
+ (org-latex--make-header info)
+ ;; Settings. They can come from three locations, in increasing
+ ;; order of precedence: global variables, LCO files and in-buffer
+ ;; settings. Thus, we first insert settings coming from global
+ ;; variables, then we insert LCO files, and, eventually, we insert
+ ;; settings coming from buffer keywords.
+ (org-koma-letter--build-settings 'global info)
+ (mapconcat #'(lambda (file) (format "\\LoadLetterOption{%s}\n" file))
+ (org-split-string (or (plist-get info :lco) "") " ")
+ "")
+ (org-koma-letter--build-settings 'buffer info)
+ ;; From address.
+ (let ((from-address (org-koma-letter--determine-to-and-from info 'from)))
+ (when (org-string-nw-p from-address)
+ (format "\\setkomavar{fromaddress}{%s}\n" from-address)))
;; Date.
(format "\\date{%s}\n" (org-export-data (org-export-get-date info) info))
- ;; Place
- (let ((with-place (plist-get info :with-place))
- (place (plist-get info :place)))
- (when (or place (not with-place))
- (format "\\setkomavar{place}{%s}\n" (if with-place place ""))))
- ;; KOMA options
- (let ((with-backaddress (plist-get info :with-backaddress))
- (with-backaddress-set (plist-get info :with-backaddress-changed-in-buffer-p))
- (with-foldmarks (plist-get info :with-foldmarks))
- (with-foldmarks-set
- (not (string-equal (plist-get info :with-foldmarks-changed-in-buffer-p)
- "foldmarks-not-set")))
- (with-phone (plist-get info :with-phone))
- (with-phone-set (plist-get info :with-phone-changed-in-buffer-p))
- (with-email (plist-get info :with-email))
- (with-email-set (plist-get info :with-email-changed-in-buffer-p)))
- (concat
- (when with-backaddress-set
- (format "\\KOMAoption{backaddress}{%s}\n" (if with-backaddress "true" "false")))
- (when with-foldmarks-set
- (format "\\KOMAoption{foldmarks}{%s}\n" (if with-foldmarks with-foldmarks "false")))
- (when with-phone-set
- (format "\\KOMAoption{fromphone}{%s}\n" (if with-phone "true" "false")))
- (when with-email-set
- (format "\\KOMAoption{fromemail}{%s}\n" (if with-email "true" "false")))))
- ;; Document start
- "\\begin{document}\n\n"
- ;; Subject
+ ;; Hyperref, document start, and subject and title.
(let* ((with-subject (plist-get info :with-subject))
- (subject-format (cond ((member with-subject '("true" "t" t)) nil)
- ((stringp with-subject) (list with-subject))
- ((symbolp with-subject)
- (list (symbol-name with-subject)))
- (t with-subject)))
- (subject (org-export-data (plist-get info :title) info))
- (l (length subject-format))
- (y ""))
+ (with-title (plist-get info :with-title))
+ (title-as-subject (and with-subject
+ (plist-get info :with-title-as-subject)))
+ (subject* (org-string-nw-p
+ (org-export-data (plist-get info :subject) info)))
+ (title* (and with-title
+ (org-string-nw-p
+ (org-export-data (plist-get info :title) info))))
+ (subject (cond ((not with-subject) nil)
+ (title-as-subject (or subject* title*))
+ (t subject*)))
+ (title (cond ((not with-title) nil)
+ (title-as-subject (and subject* title*))
+ (t title*)))
+ (hyperref-template (plist-get info :latex-hyperref-template))
+ (spec (append (list (cons ?t (or title subject "")))
+ (org-latex--format-spec info))))
(concat
- (when (and with-subject subject-format)
- (concat
- "\\KOMAoption{subject}{"
- (apply 'format
- (dotimes (x l y)
- (setq y (concat (if (> x 0) "%s," "%s") y)))
- subject-format) "}\n"))
- (when (and subject with-subject)
- (format "\\setkomavar{subject}{%s}\n\n" subject))))
- ;; Letter start
+ (when (and with-subject (not (eq with-subject t)))
+ (format "\\KOMAoption{subject}{%s}\n"
+ (if (symbolp with-subject) with-subject
+ (mapconcat #'symbol-name with-subject ","))))
+ ;; Hyperref.
+ (format-spec hyperref-template spec)
+ ;; Document start.
+ "\\begin{document}\n\n"
+ ;; Subject and title.
+ (when subject (format "\\setkomavar{subject}{%s}\n" subject))
+ (when title (format "\\setkomavar{title}{%s}\n" title))
+ (when (or (org-string-nw-p title) (org-string-nw-p subject)) "\n")))
+ ;; Letter start.
(format "\\begin{letter}{%%\n%s}\n\n"
(org-koma-letter--determine-to-and-from info 'to))
;; Opening.
- (format "\\opening{%s}\n\n" (or (plist-get info :opening) ""))
+ (format "\\opening{%s}\n\n"
+ (org-export-data
+ (or (org-string-nw-p (plist-get info :opening))
+ (when (plist-get info :with-headline-opening)
+ (org-element-map (plist-get info :parse-tree) 'headline
+ (lambda (head)
+ (unless (org-koma-letter--special-tag head info)
+ (org-element-property :title head)))
+ info t))
+ "")
+ info))
;; Letter body.
contents
;; Closing.
- (format "\n\\closing{%s}\n" (or (plist-get info :closing) ""))
+ (format "\n\\closing{%s}\n"
+ (org-export-data
+ (or (org-string-nw-p (plist-get info :closing))
+ (when (plist-get info :with-headline-opening)
+ (org-element-map (plist-get info :parse-tree) 'headline
+ (lambda (head)
+ (when (eq (org-koma-letter--special-tag head info)
+ 'closing)
+ (org-element-property :title head)))
+ info t)))
+ info))
(org-koma-letter--special-contents-as-macro
(plist-get info :with-after-closing))
;; Letter end.
@@ -643,8 +677,75 @@ holding export options."
(org-koma-letter--special-contents-as-macro
(plist-get info :with-after-letter) t t)
;; Document end.
- "\n\\end{document}"
- ))
+ "\n\\end{document}"))
+
+(defun org-koma-letter--build-settings (scope info)
+ "Build settings string according to type.
+SCOPE is either `global' or `buffer'. INFO is a plist used as
+a communication channel."
+ (let ((check-scope
+ (function
+ ;; Non-nil value when SETTING was defined in SCOPE.
+ (lambda (setting)
+ (let ((property (intern (format ":inbuffer-%s" setting))))
+ (if (eq scope 'global)
+ (eq (plist-get info property) 'koma-letter:empty)
+ (not (eq (plist-get info property) 'koma-letter:empty))))))))
+ (concat
+ ;; Name.
+ (let ((author (plist-get info :author)))
+ (and author
+ (funcall check-scope 'author)
+ (format "\\setkomavar{fromname}{%s}\n"
+ (org-export-data author info))))
+ ;; Email.
+ (let ((email (plist-get info :email)))
+ (and email
+ (funcall check-scope 'email)
+ (format "\\setkomavar{fromemail}{%s}\n" email)))
+ (and (funcall check-scope 'with-email)
+ (format "\\KOMAoption{fromemail}{%s}\n"
+ (if (plist-get info :with-email) "true" "false")))
+ ;; Phone number.
+ (let ((phone-number (plist-get info :phone-number)))
+ (and (org-string-nw-p phone-number)
+ (funcall check-scope 'phone-number)
+ (format "\\setkomavar{fromphone}{%s}\n" phone-number)))
+ (and (funcall check-scope 'with-phone)
+ (format "\\KOMAoption{fromphone}{%s}\n"
+ (if (plist-get info :with-phone) "true" "false")))
+ ;; Signature.
+ (let* ((heading-val
+ (and (plist-get info :with-headline-opening)
+ (org-string-nw-p
+ (org-trim
+ (org-export-data
+ (org-koma-letter--get-tagged-contents 'closing)
+ info)))))
+ (signature (org-string-nw-p (plist-get info :signature)))
+ (signature-scope (funcall check-scope 'signature)))
+ (and (or (and signature signature-scope)
+ heading-val)
+ (not (and (eq scope 'global) heading-val))
+ (format "\\setkomavar{signature}{%s}\n"
+ (if signature-scope signature heading-val))))
+ ;; Back address.
+ (and (funcall check-scope 'with-backaddress)
+ (format "\\KOMAoption{backaddress}{%s}\n"
+ (if (plist-get info :with-backaddress) "true" "false")))
+ ;; Place.
+ (and (funcall check-scope 'place)
+ (format "\\setkomavar{place}{%s}\n"
+ (if (plist-get info :with-place) (plist-get info :place) "")))
+ ;; Folding marks.
+ (and (funcall check-scope 'with-foldmarks)
+ (let ((foldmarks (plist-get info :with-foldmarks)))
+ (cond ((consp foldmarks)
+ (format "\\KOMAoptions{foldmarks=true,foldmarks=%s}\n"
+ (mapconcat #'symbol-name foldmarks "")))
+ (foldmarks "\\KOMAoptions{foldmarks=true}\n")
+ (t "\\KOMAoptions{foldmarks=false}\n")))))))
+
;;; Commands
diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el
index 5fd2afc..4cdfe0e 100644
--- a/contrib/lisp/ox-rss.el
+++ b/contrib/lisp/ox-rss.el
@@ -1,6 +1,6 @@
;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine
-;; Copyright (C) 2013, 2014 Bastien Guerry
+;; Copyright (C) 2013-2015 Bastien Guerry
;; Author: Bastien Guerry <bzg@gnu.org>
;; Keywords: org, wp, blog, feed, rss
@@ -42,6 +42,9 @@
;; PUBDATE property. If `org-rss-use-entry-url-as-guid', it will also add
;; an ID property, later used as the guid for the feed's item.
;;
+;; The top-level headline is used as the title of each RSS item unless
+;; an RSS_TITLE property is set on the headline.
+;;
;; You typically want to use it within a publishing project like this:
;;
;; (add-to-list
@@ -119,7 +122,9 @@ When nil, Org will create ids using `org-icalendar-create-uid'."
(if a (org-rss-export-to-rss t s v)
(org-open-file (org-rss-export-to-rss nil s v)))))))
:options-alist
- '((:with-toc nil nil nil) ;; Never include HTML's toc
+ '((:description "DESCRIPTION" nil nil newline)
+ (:keywords "KEYWORDS" nil nil space)
+ (:with-toc nil nil nil) ;; Never include HTML's toc
(:rss-extension "RSS_EXTENSION" nil org-rss-extension)
(:rss-image-url "RSS_IMAGE_URL" nil org-rss-image-url)
(:rss-categories nil nil org-rss-categories))
@@ -204,10 +209,12 @@ publishing directory.
Return output file name."
(let ((bf (get-file-buffer filename)))
(if bf
- (with-current-buffer bf
- (org-rss-add-pubdate-property)
- (write-file filename))
+ (with-current-buffer bf
+ (org-icalendar-create-uid filename 'warn-user)
+ (org-rss-add-pubdate-property)
+ (write-file filename))
(find-file filename)
+ (org-icalendar-create-uid filename 'warn-user)
(org-rss-add-pubdate-property)
(write-file filename) (kill-buffer)))
(org-publish-org-to
@@ -222,29 +229,29 @@ communication channel."
(unless (or (org-element-property :footnote-section-p headline)
;; Only consider first-level headlines
(> (org-export-get-relative-level headline info) 1))
- (let* ((htmlext (plist-get info :html-extension))
+ (let* ((author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (htmlext (plist-get info :html-extension))
(hl-number (org-export-get-headline-number headline info))
(hl-home (file-name-as-directory (plist-get info :html-link-home)))
(hl-pdir (plist-get info :publishing-directory))
(hl-perm (org-element-property :RSS_PERMALINK headline))
- (anchor
- (org-export-solidify-link-text
- (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-" (mapconcat 'number-to-string hl-number "-")))))
+ (anchor (org-export-get-reference headline info))
(category (org-rss-plain-text
(or (org-element-property :CATEGORY headline) "") info))
- (pubdate
- (let ((system-time-locale "C"))
- (format-time-string
- "%a, %d %b %Y %H:%M:%S %z"
- (org-time-string-to-time
- (or (org-element-property :PUBDATE headline)
- (error "Missing PUBDATE property"))))))
- (title (replace-regexp-in-string
- org-bracket-link-regexp
- (lambda (m) (or (match-string 3 m)
- (match-string 1 m)))
- (org-element-property :raw-value headline)))
+ (pubdate0 (org-element-property :PUBDATE headline))
+ (pubdate (let ((system-time-locale "C"))
+ (if pubdate0
+ (format-time-string
+ "%a, %d %b %Y %H:%M:%S %z"
+ (org-time-string-to-time pubdate0)))))
+ (title (or (org-element-property :RSS_TITLE headline)
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ (lambda (m) (or (match-string 3 m)
+ (match-string 1 m)))
+ (org-element-property :raw-value headline))))
(publink
(or (and hl-perm (concat (or hl-home hl-pdir) hl-perm))
(concat
@@ -259,17 +266,19 @@ communication channel."
(org-element-property :CUSTOM_ID headline)
publink)
info))))
- (format
- (concat
- "<item>\n"
- "<title>%s</title>\n"
- "<link>%s</link>\n"
- "<guid isPermaLink=\"false\">%s</guid>\n"
- "<pubDate>%s</pubDate>\n"
- (org-rss-build-categories headline info) "\n"
- "<description><![CDATA[%s]]></description>\n"
- "</item>\n")
- title publink guid pubdate contents))))
+ (if (not pubdate0) "" ;; Skip entries with no PUBDATE prop
+ (format
+ (concat
+ "<item>\n"
+ "<title>%s</title>\n"
+ "<link>%s</link>\n"
+ "<author>%s</author>\n"
+ "<guid isPermaLink=\"false\">%s</guid>\n"
+ "<pubDate>%s</pubDate>\n"
+ (org-rss-build-categories headline info) "\n"
+ "<description><![CDATA[%s]]></description>\n"
+ "</item>\n")
+ title publink author guid pubdate contents)))))
(defun org-rss-build-categories (headline info)
"Build categories for the RSS item."
diff --git a/contrib/lisp/ox-s5.el b/contrib/lisp/ox-s5.el
index 26e83a3..503bfd0 100644
--- a/contrib/lisp/ox-s5.el
+++ b/contrib/lisp/ox-s5.el
@@ -48,7 +48,14 @@
;; in an Org mode buffer. See ox.el and ox-html.el for more details
;; on how this exporter works.
+;; TODOs
+;; ------
+;; The title page is formatted using format-spec. This is error prone
+;; when details are missing and may insert empty tags, like <h2></h2>,
+;; for missing values.
+
(require 'ox-html)
+(eval-when-compile (require 'cl))
(org-export-define-derived-backend 's5 'html
:menu-entry
@@ -173,6 +180,7 @@ or an empty string."
(defcustom org-s5-title-slide-template
"<h1>%t</h1>
+<h2>%s</h2>
<h2>%a</h2>
<h3>%e</h3>
<h4>%d</h4>"
@@ -201,7 +209,7 @@ INFO is a plist used as a communication channel."
(concat section-number
(org-export-data
(org-export-get-alt-title headline info) info)
- (and tags "&nbsp;&nbsp;&nbsp;") (org-html--tags tags))))
+ (and tags "&nbsp;&nbsp;&nbsp;") (org-html--tags tags info))))
(defun org-s5-toc (depth info)
(let* ((headlines (org-export-collect-headlines info depth))
diff --git a/contrib/lisp/ox-taskjuggler.el b/contrib/lisp/ox-taskjuggler.el
index 761e180..2bd47e6 100644
--- a/contrib/lisp/ox-taskjuggler.el
+++ b/contrib/lisp/ox-taskjuggler.el
@@ -64,7 +64,7 @@
;; should end up with something similar to the example by Peter Jones
;; in:
;;
-;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org.
+;; http://www.devalot.com/assets/articles/2008/07/project-planning/project-planning.org.
;;
;; Now mark the top node of your tasks with a tag named
;; "taskjuggler_project" (or whatever you customized
@@ -307,7 +307,23 @@ but before any resource and task declarations."
startbuffer startcredit statusnote chargeset charge)
"Valid attributes for Taskjuggler tasks.
If one of these appears as a property for a headline, it will be
-exported with the corresponding task."
+exported with the corresponding task.
+
+Note that multiline properties are not supported, so attributes
+like note or journalentry have to be on a single line."
+ :group 'org-export-taskjuggler)
+
+(defcustom org-taskjuggler-valid-project-attributes
+ '(timingresolution timezone alertlevels currency currencyformat
+ dailyworkinghours extend includejournalentry now numberformat
+ outputdir scenario shorttimeformat timeformat trackingscenario
+ weekstartsmonday weekstartssunday workinghours
+ yearlyworkingdays)
+ "Valid attributes for Taskjuggler project.
+If one of these appears as a property for a headline that is a
+project definition, it will be exported with the corresponding
+task. Attribute 'timingresolution' should be the first in the
+list."
:group 'org-export-taskjuggler)
(defcustom org-taskjuggler-valid-resource-attributes
@@ -483,9 +499,9 @@ Return new string. If S is the empty string, return it."
(if (equal "" s) s (replace-regexp-in-string "^ *\\S-" " \\&" s)))
(defun org-taskjuggler--build-attributes (item attributes)
- "Return attributes string for task, resource or report ITEM.
-ITEM is a headline. ATTRIBUTES is a list of symbols
-representing valid attributes for ITEM."
+ "Return attributes string for ITEM.
+ITEM is a project, task, resource or report headline. ATTRIBUTES
+is a list of symbols representing valid attributes for ITEM."
(mapconcat
(lambda (attribute)
(let ((value (org-element-property
@@ -587,7 +603,7 @@ doesn't include leading \"depends\"."
(let ((id (org-element-property :TASK_ID dep)))
(and id
(string-match (concat id " +\\({.*?}\\)") dep-str)
- (org-match-string-no-properties 1))))
+ (org-match-string-no-properties 1 dep-str))))
path)
;; Compute number of exclamation marks by looking for the
;; common ancestor between TASK and DEP.
@@ -715,18 +731,27 @@ PROJECT is a headline. INFO is a plist used as a communication
channel. If no start date is specified, start today. If no end
date is specified, end `org-taskjuggler-default-project-duration'
days from now."
- (format "project %s \"%s\" \"%s\" %s %s {\n}\n"
- (org-taskjuggler-get-id project info)
- (org-taskjuggler-get-name project)
- ;; Version is obtained through :TASKJUGGLER_VERSION:
- ;; property or `org-taskjuggler-default-project-version'.
- (or (org-element-property :VERSION project)
- org-taskjuggler-default-project-version)
- (or (org-taskjuggler-get-start project)
- (format-time-string "%Y-%m-%d"))
- (let ((end (org-taskjuggler-get-end project)))
- (or (and end (format "- %s" end))
- (format "+%sd" org-taskjuggler-default-project-duration)))))
+ (concat
+ ;; Opening project.
+ (format "project %s \"%s\" \"%s\" %s %s {\n"
+ (org-taskjuggler-get-id project info)
+ (org-taskjuggler-get-name project)
+ ;; Version is obtained through :TASKJUGGLER_VERSION:
+ ;; property or `org-taskjuggler-default-project-version'.
+ (or (org-element-property :VERSION project)
+ org-taskjuggler-default-project-version)
+ (or (org-taskjuggler-get-start project)
+ (format-time-string "%Y-%m-%d"))
+ (let ((end (org-taskjuggler-get-end project)))
+ (or (and end (format "- %s" end))
+ (format "+%sd"
+ org-taskjuggler-default-project-duration))))
+ ;; Add attributes.
+ (org-taskjuggler--indent-string
+ (org-taskjuggler--build-attributes
+ project org-taskjuggler-valid-project-attributes))
+ ;; Closing project.
+ "}\n"))
(defun org-taskjuggler--build-resource (resource info)
"Return a resource declaration.
diff --git a/contrib/scripts/ditaa.jar b/contrib/scripts/ditaa.jar
deleted file mode 100644
index 5894de4..0000000
--- a/contrib/scripts/ditaa.jar
+++ /dev/null
Binary files differ
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 421b016..a14f3a3 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -3,14 +3,635 @@ ORG NEWS -- history of user-visible changes. -*- org -*-
#+LINK: doc http://orgmode.org/worg/doc.html#%s
#+LINK: git http://orgmode.org/w/?p=org-mode.git;a=commit;h=%s
-Copyright (C) 2012-2013 Free Software Foundation, Inc.
+Copyright (C) 2012-2015 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Org bug reports to emacs-orgmode@gnu.org.
+* Version 8.3
+
+** Incompatible changes
+
+*** Properties drawers syntax changes
+
+Properties drawers are now required to be located right after a
+headline and its planning line, when applicable.
+
+It will break some documents as TODO states changes were sometimes
+logged before the property drawer.
+
+The following function will repair them:
+
+#+BEGIN_SRC emacs-lisp
+(defun org-repair-property-drawers ()
+ "Fix properties drawers in current buffer.
+ Ignore non Org buffers."
+ (when (eq major-mode 'org-mode)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (inline-re (and (featurep 'org-inlinetask)
+ (concat (org-inlinetask-outline-regexp)
+ "END[ \t]*$"))))
+ (org-map-entries
+ (lambda ()
+ (unless (and inline-re (org-looking-at-p inline-re))
+ (save-excursion
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (forward-line)
+ (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (and (< (point) end)
+ (not (org-looking-at-p org-property-drawer-re))
+ (save-excursion
+ (and (re-search-forward org-property-drawer-re end t)
+ (eq (org-element-type
+ (save-match-data (org-element-at-point)))
+ 'drawer))))
+ (insert (delete-and-extract-region
+ (match-beginning 0)
+ (min (1+ (match-end 0)) end)))
+ (unless (bolp) (insert "\n"))))))))))))
+#+END_SRC
+*** =#+CATEGORY= keywords no longer apply partially to document
+
+It was possible to use several such keywords and have them apply to
+the text below until the next one, but strongly deprecated since Org
+5.14 (2008).
+
+=#+CATEGORY= keywords are now global to the document. You can use node
+properties to set category for a subtree, e.g.,
+
+#+BEGIN_SRC org
+,* Headline
+ :PROPERTIES:
+ :CATEGORY: some category
+ :END:
+#+END_SRC
+*** New variable to control visibility when revealing a location
+
+~org-show-following-heading~, ~org-show-siblings~,
+~org-show-entry-below~ and ~org-show-hierarchy-above~ no longer exist.
+Instead, visibility is controlled through a single variable:
+~org-show-context-detail~, which see.
+
+*** Replace disputed keys again when reading a date
+
+~org-replace-disputed-keys~ has been ignored when reading date since
+version 8.1, but the former behavior is restored again.
+
+Keybinding for reading date can be customized with a new variable
+~org-read-date-minibuffer-local-map~.
+
+*** No default title is provided when =TITLE= keyword is missing
+
+Skipping =TITLE= keyword no longer provides the current file name, or
+buffer name, as the title. Instead, simply ignore the title.
+
+*** Functions signature changes
+
+The following functions require an additional argument. See their
+docstring for more information.
+
+- ~org-export-collect-footnote-definitions~
+- ~org-html-format-headline-function~
+- ~org-html-format-inlinetask-function~
+- ~org-latex-format-headline-function~
+- ~org-latex-format-inlinetask-function~
+- ~org-link-search~
+
+*** Default bindings of =C-c C-n= and =C-c C-p= changed
+
+The key sequences =C-c C-n= and =C-c C-p= are now bound to
+~org-next-visible-heading~ and ~org-next-visible-heading~
+respectively, rather than the =outline-mode= versions of these
+functions. The Org version of these functions skips over inline tasks
+(and even-level headlines when ~org-odd-levels-only~ is set).
+
+*** ~org-element-context~ no longer return objects in keywords
+
+~org-element-context~ used to return objects on some keywords, i.e.,
+=TITLE=, =DATE= and =AUTHOR=. It now returns only the keyword.
+
+*** Behavior of ~org-return~ changed
+
+If point is before or after the headline title, insert a new line
+without changing the headline.
+
+*** ~org-timer-default-timer~ type changed from number to string
+
+If you have, in your configuration, something like =(setq
+org-timer-default-timer 10)= replace it with =(setq
+org-timer-default-timer "10")=.
+** New features
+
+*** Hierarchies of tags
+The functionality of nesting tags in hierarchies is added to org-mode.
+This is the generalization of what was previously called "Tag groups"
+in the manual. That term is now changed to "Tag hierarchy".
+
+The following in-buffer definition:
+#+BEGIN_SRC org
+ ,#+TAGS: [ Group : SubOne SubTwo ]
+ ,#+TAGS: [ SubOne : SubOne1 SubOne2 ]
+ ,#+TAGS: [ SubTwo : SubTwo1 SubTwo2 ]
+#+END_SRC
+
+Should be seen as the following tree of tags:
+- Group
+ - SubOne
+ - SubOne1
+ - SubOne2
+ - SubTwo
+ - SubTwo1
+ - SubTwo2
+
+Searching for "Group" should return all tags defined above. Filtering
+on SubOne filters also it's sub-tags. Etc.
+
+There is no limit on the depth for the tag hierarchy.
+
+*** Additional syntax for non-unique grouptags
+Additional syntax is defined for grouptags if the tags in the group
+don't have to be distinct on a heading.
+
+Grouptags had to previously be defined with { }. This syntax is
+already used for exclusive tags and Grouptags need their own,
+non-exclusive syntax. This behaviour is achieved with [ ]. Note: {
+} can still be used also for Grouptags but then only one of the
+given tags can be used on the headline at the same time. Example:
+
+[ group : sub1 sub2 ]
+
+#+BEGIN_SRC org
+ ,* Test :sub1:sub2:
+#+END_SRC
+
+This is a more general case than the already existing syntax for
+grouptags; { }.
+
+*** Define regular expression patterns as tags
+Tags can be defined as grouptags with regular expressions as
+"sub-tags".
+
+The regular expressions in the group must be marked up within { }.
+Example use:
+
+: #+TAGS: [ Project : {P@.+} ]
+
+Searching for the tag Project will now list all tags also including
+regular expression matches for P@.+. Good for example if tags for a
+certain project is tagged with a common project-identifier,
+i.e. P@2014_OrgTags.
+
+*** Filtering in the agenda on grouptags (Tag hierarchies)
+Filtering in the agenda on grouptags filter all of the related tags.
+Exception if filter is applied with a (double) prefix-argument.
+
+Filtering in the agenda on subcategories does not filter the "above"
+levels anymore.
+
+If a grouptag contains a regular expression the regular expression
+is also used as a filter.
+
+*** Minor refactoring of ~org-agenda-filter-by-tag~
+Now uses the argument arg and optional argument exclude instead of
+strip and narrow. ARG because the argument has multiple purposes and
+makes more sense than strip now. The term narrowing is changed to
+exclude.
+
+The main purpose is for the function to make more logical sense when
+filtering on tags now when tags can be structured in hierarchies.
+
+*** Babel: support for sed scripts
+
+Thanks to Bjarte Johansen for this feature.
+
+*** Babel: support for Processing language
+
+New ob-processing.el library.
+
+This library implements necessary functions for implementing editing
+of Processing code blocks, viewing the resulting sketches in an
+external viewer, and HTML export of the sketches.
+
+Check the documentation for more.
+
+Thanks to Jarmo Hurri for this feature.
+
+*** New behaviour for `org-toggle-latex-fragment'
+The new behaviour is the following:
+
+- With a double prefix argument or with a single prefix argument
+ when point is before the first headline, toggle overlays in the
+ whole buffer;
+
+- With a single prefix argument, toggle overlays in the current
+ subtree;
+
+- On latex code, toggle overlay at point;
+
+- Otherwise, toggle overlays in the current section.
+
+*** Additional markup with =#+INCLUDE= keyword
+
+The content of the included file can now be optionally marked up, for
+instance as HTML. See the documentation for details.
+
+*** File links with =#+INCLUDE= keyword
+
+Objects can be extracted via =#+INCLUDE= using file links. It is
+possible to include only the contents of the object. See manual for
+more information.
+
+*** Drawers do not need anymore to be referenced in =#+DRAWERS=
+
+One can use a drawer without listing it in the =#+DRAWERS= keyword,
+which is now obsolete. As a consequence, this change also deprecates
+~org-drawers~ variable.
+
+*** ~org-edit-special~ can edit export blocks
+
+Using C-c ' on an export block now opens a sub-editing buffer. Major
+mode in that buffer is determined by export backend name (e.g.,
+"latex" \to "latex-mode"). You can define exceptions to this rule by
+configuring ~org-src-lang-modes~, which see.
+
+*** Additional =:hline= processing to ob-shell
+
+If the argument =:hlines yes= is present in a babel call, an optional
+argument =:hlines-string= can be used to define a string to use as a
+representation for the lisp symbol ='hline= in the shell program. The
+default is =hline=.
+
+*** Markdown export supports switches in source blocks
+
+For example, it is now possible to number lines using the =-n= switch
+in a source block.
+
+*** New option in ASCII export
+
+Plain lists can have an extra margin by setting
+~org-ascii-list-margin~ variable to an appopriate integer.
+
+*** New blocks in ASCII export
+
+ASCII export now supports =#+BEGIN_JUSTIFYRIGHT= and
+=#+BEGIN_JUSTIFYLEFT= blocks. See documentation for details.
+
+*** More back-end specific publishing options
+
+The number of publishing options specific to each back-end has been
+increased. See manual for details.
+
+*** Export inline source blocks
+
+Inline source code was used to be removed upon exporting. They are
+now handled as standard code blocks, i.e., the source code can appear
+in the output, depending on the parameters.
+
+*** Extend ~org-export-first-sibling-p~ and ~org-export-last-sibling-p~
+
+These functions now support any element or object, not only headlines.
+
+*** New function: ~org-export-table-row-in-header-p~
+
+*** New function: ~org-export-get-reference~
+
+*** New function: ~org-element-lineage~
+
+This function deprecates ~org-export-get-genealogy~. It also provides
+more features. See docstring for details.
+
+*** New function: ~org-element-copy~
+
+*** New filter: ~org-export-filter-body-functions~
+
+Functions in this filter are applied on the body of the exported
+document, befor wrapping it within the template.
+
+*** Various improvements on radio tables
+
+Radio tables feature now relies on Org's export framework ("ox.el").
+~:no-escape~ parameter no longer exists, but additional global
+parameters are now supported: ~:raw~, ~:backend~. Moreover, there are
+new parameters specific to some pre-defined translators, e.g.,
+~:environment~ and ~:booktabs~ for ~orgtbl-to-latex~. See translators
+docstrings (including ~orgtbl-to-generic~) for details.
+
+*** Non-floating minted listings in Latex export
+
+It is not possible to specify =#+attr_latex: :float nil= in conjunction with
+source blocks exported by the minted package.
+
+*** Field formulas can now create columns as needed
+
+Previously, evaluating formulas that referenced out-of-bounds columns
+would throw an error. A new variable
+~org-table-formula-create-columns~ was added to adjust this
+behavior. It is now possible to silently add new columns, to do so
+with a warning or to explicitly ask the user each time.
+
+*** ASCII plot
+
+Ability to plot values in a column through ASCII-art bars. See manual
+for details.
+
+*** New hook: ~org-archive-hook~
+
+This hook is called after successfully archiving a subtree, with point
+on the original subtree, not yet deleted.
+
+*** New option: ~org-attach-archive-delete~
+
+When non-nil, attachments from archived subtrees are removed.
+
+*** New option: ~org-latex-caption-above~
+
+This variable generalizes ~org-latex-table-caption-above~, which is
+now deprecated. In addition to tables, it applies to source blocks,
+special blocks and images. See docstring for more information.
+
+*** New option: ~org-latex-prefer-user-labels~
+
+See docstring for more information.
+
+*** Export unnumbered headlines
+
+Headlines, for which the property ~UNNUMBERED~ is non-nil, are now
+exported without section numbers irrespective of their levels. The
+property is inherited by children.
+
+*** Tables can be sorted with an arbitrary function
+
+It is now possible to specify a function, both programatically,
+through a new optional argument, and interactively with ~f~ or ~F~
+keys, to sort a table.
+
+*** Table of contents can be local to a section
+
+The ~TOC~ keywords now accepts an optional ~local~ parameter. See
+manual for details.
+
+*** Countdown timers can now be paused
+
+~org-timer-pause-time~ now pauses and restarts both relative and
+countdown timers.
+
+*** New option ~only-window~ for ~org-agenda-window-setup~
+
+When ~org-agenda-window-setup~ is set to ~only-window~, the agenda is
+displayed as the sole window of the current frame.
+
+*** ~{{{date}}}~ macro supports optional formatting argument
+
+It is now possible to supply and optional formatting argument to
+~{{{date}}}~. See manual for details.
+
+*** ~{{{property}}}~ macro supports optional search argument
+
+It is now possible to supply an optional search option to
+~{{{property}}}~ in order to retrieve remote properties optional. See
+manual for details.
+
+*** New option ~org-export-with-title~
+
+It is possible to suppress the title insertion with ~#+OPTIONS:
+title:nil~ or globally using the variable ~org-export-with-title~.
+
+*** New entities family: "\_ "
+
+"\_ " are used to insert up to 20 contiguous spaces in various
+back-ends. In particular, this family can be used to introduce
+leading spaces within table cells.
+
+*** New MathJax configuration options
+
+Org uses the MathJax CDN by default. See the manual and the docstring
+of ~org-html-mathjax-options~ for details.
+
+*** New behaviour in `org-export-options-alist'
+
+When defining a back-end, it is now possible to specify to give
+`parse' behaviour on a keyword. It is equivalent to call
+`org-element-parse-secondary-string' on the value.
+
+However, parsed =KEYWORD= is automatically associated to an
+=:EXPORT_KEYWORD:= property, which can be used to override the keyword
+value during a subtree export. Moreover, macros are expanded in such
+keywords and properties.
+
+*** Viewport support in html export
+
+Viewport for mobile-optimized website is now automatically inserted
+when exporting to html. See ~org-html-viewport~ for details.
+
+*** New ~#+SUBTITLE~ export keyword
+
+Org can typeset a subtitle in some export backends. See the manual
+for details.
+
+*** Remotely edit a footnote definition
+
+Calling ~org-edit-footnote-reference~ (C-c ') on a footnote reference
+allows to edit its definition, as long as it is not anonymous, in
+a dedicated buffer. It works even if buffer is currently narrowed.
+
+*** New function ~org-delete-indentation~ bound to ~M-^~
+
+Work as ~delete-indentation~ unless at heading, in which case text is
+added to headline text.
+
+*** Support for images in Texinfo export
+
+~Texinfo~ back-end now handles images. See manual for details.
+
+*** Support for captions in Texinfo export
+
+Tables and source blocks can now have captions. Additionally, lists
+of tables and lists of listings can be inserted in the document with
+=#+TOC= keyword.
+
+*** Countdown timer support hh:mm:ss format
+
+In addition to setting countdown timers in minutes, they can also be
+set using the hh:mm:ss format.
+
+*** Extend ~org-clone-subtree-with-time-shift~
+
+~org-clone-subtree-with-time-shift~ now accepts 0 as an argument for
+the number of clones, which removes the repeater from the original
+subtree and creates one shifted, repeating clone.
+
+*** New time block for clock tables: ~untilnow~
+
+It encompasses all past closed clocks.
+
+*** Support for the ~polyglossia~ LaTeX package
+
+See the docstring of ~org-latex-classes~ and
+~org-latex-guess-polyglossia-language~ for details.
+
+*** None-floating tables, graphics and blocks can have captions
+
+*** `org-insert-heading' can be forced to insert top-level headline
+
+** Removed functions
+
+*** Removed function ~org-translate-time~
+
+Use ~org-timestamp-translate~ instead.
+
+*** Removed function ~org-beamer-insert-options-template~
+
+This function inserted a Beamer specific template at point or in
+current subtree. Use ~org-export-insert-default-template~ instead, as
+it provides more features and covers all export back-ends. It is also
+accessible from the export dispatcher.
+
+*** Removed function ~org-timer-cancel-timer~
+
+~org-timer-stop~ now stops both relative and countdown timers.
+
+*** Removed function ~org-export-solidify-link-text~
+
+This function, being non-bijective, introduced bug in internal
+references. Use ~org-export-get-reference~ instead.
+
+*** Removed function ~org-end-of-meta-data-and-drawers~
+
+The function is superseded by ~org-end-of-meta-data~, called with an
+optional argument.
+
+*** Removed functions ~org-table-colgroup-line-p~, ~org-table-cookie-line-p~
+
+These functions were left-over from pre 8.0 era. They are not correct
+anymore. Since they are not needed, they have no replacement.
+** Removed options
+
+*** ~org-list-empty-line-terminates-plain-lists~ is deprecated
+
+It will be kept in code base until next release, for backward
+compatibility.
+
+If you need to separate consecutive lists with blank lines, always use
+two of them, as if this option was nil (default value).
+
+*** ~org-export-with-creator~ is a boolean
+
+Special ~comment~ value is no longer allowed. It is possible to use
+a body filter to add comments about the creator at the end of the
+document instead.
+
+*** Removed option =org-babel-sh-command=
+
+This undocumented option defaulted to the value of =shell-file-name=
+at the time of loading =ob-shell=. The new behaviour is to use the
+value of =shell-file-name= directly when the shell langage is =shell=.
+To chose a different shell, either customize =shell-file-name= or bind
+this variable locally.
+
+*** Removed option =org-babel-sh-var-quote-fmt=
+
+This undocumented option was supposed to provide different quoting
+styles when changing the shell type. Changing the shell type can now
+be done directly from the source block and the quoting style has to be
+compatible across all shells, so a customization doesn't make sense
+anymore. The chosen hard coded quoting style conforms to POSIX.
+
+*** Removed option ~org-insert-labeled-timestamps-at-point~
+
+Setting this option to anything else that the default value (nil)
+would create invalid planning info. This dangerous option is now
+removed.
+
+*** Removed option ~org-koma-letter-use-title~
+
+Use org-export-with-title instead. See also below.
+
+*** Removed option ~org-entities-ascii-explanatory~
+
+This variable has no effect since Org 8.0.
+
+*** Removed option ~org-table-error-on-row-ref-crossing-hline~
+
+This variable has no effect since August 2009.
+
+*** Removed MathML-related options from ~org-html-mathjax-options~
+
+MathJax automatically chooses the best display technology based on the
+end-users browser. You may force initial usage of MathML via
+~org-html-mathjax-template~ or by setting the ~path~ property of
+~org-html-mathjax-options~.
+
+*** Removed comment-related filters
+
+~org-export-filter-comment-functions~ and
+~org-export-filter-comment-block-functions~ variables do not exist
+anymore.
+** Miscellaneous
+
+*** Strip all meta data from ITEM special property
+
+ITEM special property does not contain TODO, priority or tags anymore.
+
+*** File names in links accept are now compatible with URI syntax
+
+Absolute file names can now start with =///= in addition to =/=. E.g.,
+=[[file:///home/me/unicorn.jpg]]=.
+
+*** Footnotes in included files are now local to the file
+
+As a consequence, it is possible to include multiple Org files with
+footnotes in a master document without being concerned about footnote
+labels colliding.
+
+*** Mailto links now use regular URI syntax
+
+This change deprecates old Org syntax for mailto links:
+=mailto:user@domain::Subject=.
+
+*** =QUOTE= keywords do not exist anymore
+
+=QUOTE= keywords have been deprecated since Org 8.2.
+
+*** Select tests to perform with the build system
+
+The build system has been enhanced to allow test selection with a
+regular expression by defining =BTEST_RE= during the test invocation.
+This is especially useful during bisection to find just when a
+particular test failure was introduced.
+
+*** Exact heading search for external links ignore spaces and cookies
+
+Exact heading search for links now ignore spaces and cookies. This is
+the case for links of the form ~file:projects.org::*task title~, as
+well as links of the form ~file:projects.org::some words~
+when ~org-link-search-must-match-exact-headline~ is not nil.
+
+*** ~org-latex-hyperref-template~, ~org-latex-title-command~ formatting
+
+New formatting keys are supported. See the respective docstrings.
+Note, ~org-latex-hyperref-template~ has a new default value.
+
+*** ~float, wasysym, marvosym~ are removed from ~org-latex-default-packages-alist~
+
+If you require any of these package add them to your preamble via
+~org-latex-packages-alist~. Org also uses default LaTeX ~\tolerance~
+now.
+
+*** When exporting, throw an error on unresolved id/fuzzy links and code refs
+
+This helps spotting wrong links.
+
* Version 8.2
** Incompatible changes
+*** =ob-sh.el= renamed to =ob-shell=
+This may require two changes in user config.
+
+1. In =org-babel-do-load-languages=, change =(sh . t)= to =(shell . t)=.
+2. Edit =local.mk= files to change the value of =BTEST_OB_LANGUAGES=
+ to remove "sh" and include "shell".
*** Combine org-mac-message.el and org-mac-link-grabber into org-mac-link.el
@@ -37,7 +658,7 @@ So you need to replace
: #+HTML_INCLUDE_STYLE: t
-by
+by
: #+OPTIONS: :html-include-style t
@@ -91,13 +712,13 @@ of the list.
now use =amssymb= symbols by default instead.
*** New functions for paragraph motion
-
+
The commands =C-down= and =C-up= now invoke special commands
that use knowledge from the org-elements parser to move the cursor
in a paragraph-like way.
*** New entities in =org-entities.el=
-
+
Add support for ell, imath, jmath, varphi, varpi, aleph, gimel, beth,
dalet, cdots, S (§), dag, ddag, colon, therefore, because, triangleq,
leq, geq, lessgtr, lesseqgtr, ll, lll, gg, ggg, prec, preceq,
@@ -205,7 +826,7 @@ instructions:
- when updating through ELPA (either from GNU ELPA or from Org ELPA),
you have to install Org's ELPA package in a session where no Org
function has been called already.
-
+
When in doubt, run =M-x org-version RET= and see if you have a mixed-up
installation.
@@ -1077,7 +1698,7 @@ See http://orgmode.org/elpa/
| =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] |
| | =#= | [[doc::org-toggle-comment][org-toggle-comment]] |
| | =:= | [[doc::org-columns][org-columns]] |
- | | =W= | Set =APPT_WARNTIME= |
+ | | =W= | Set =APPT_WARNTIME= |
| =k= | | [[doc::org-agenda-capture][org-agenda-capture]] |
| C-c , | , | [[doc::org-priority][org-priority]] |
diff --git a/etc/styles/OrgOdtStyles.xml b/etc/styles/OrgOdtStyles.xml
index f41d984..1a8edee 100644
--- a/etc/styles/OrgOdtStyles.xml
+++ b/etc/styles/OrgOdtStyles.xml
@@ -110,33 +110,53 @@
<style:style style:name="Heading_20_1" style:display-name="Heading 1" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="1" style:class="text">
<style:text-properties fo:font-size="115%" fo:font-weight="bold" style:font-size-asian="115%" style:font-weight-asian="bold" style:font-size-complex="115%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_1_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_1" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_2" style:display-name="Heading 2" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="2" style:class="text">
<style:text-properties fo:font-size="14pt" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="14pt" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-style-complex="italic" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_2_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_2" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_3" style:display-name="Heading 3" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="3" style:class="text">
<style:text-properties fo:font-size="14pt" fo:font-weight="bold" style:font-size-asian="14pt" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_3_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_3" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_4" style:display-name="Heading 4" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="4" style:class="text">
<style:text-properties fo:font-size="85%" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="85%" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="85%" style:font-style-complex="italic" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_4_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_4" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_5" style:display-name="Heading 5" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="5" style:class="text">
<style:text-properties fo:font-size="85%" fo:font-weight="bold" style:font-size-asian="85%" style:font-weight-asian="bold" style:font-size-complex="85%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_5_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_5" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_6" style:display-name="Heading 6" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="6" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_6_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_6" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_7" style:display-name="Heading 7" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="7" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_7_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_7" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_8" style:display-name="Heading 8" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="8" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_8_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_8" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_9" style:display-name="Heading 9" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="9" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_9_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_9" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_10" style:display-name="Heading 10" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="10" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_10_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_10" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_1.title" style:display-name="Heading 1.title" style:family="paragraph" style:parent-style-name="Heading_20_1">
<style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
</style:style>
diff --git a/lisp/ob-C.el b/lisp/ob-C.el
index 2fcec79..8d5ff2f 100644
--- a/lisp/ob-C.el
+++ b/lisp/ob-C.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte
+;; Thierry Banel
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
@@ -23,37 +24,55 @@
;;; Commentary:
-;; Org-Babel support for evaluating C code.
+;; Org-Babel support for evaluating C, C++, D code.
;;
;; very limited implementation:
;; - currently only support :results output
;; - not much in the way of error feedback
;;; Code:
-(eval-when-compile
- (require 'cl))
(require 'ob)
(require 'cc-mode)
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
-
+(declare-function org-remove-indentation "org" (code &optional n))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp"))
+(add-to-list 'org-babel-tangle-lang-exts '("D" . "d"))
(defvar org-babel-default-header-args:C '())
-(defvar org-babel-C-compiler "gcc"
- "Command used to compile a C source code file into an
-executable.")
-
-(defvar org-babel-C++-compiler "g++"
- "Command used to compile a C++ source code file into an
-executable.")
+(defcustom org-babel-C-compiler "gcc"
+ "Command used to compile a C source code file into an executable.
+May be either a command in the path, like gcc
+or an absolute path name, like /usr/local/bin/gcc
+parameter may be used, like gcc -v"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
+
+(defcustom org-babel-C++-compiler "g++"
+ "Command used to compile a C++ source code file into an executable.
+May be either a command in the path, like g++
+or an absolute path name, like /usr/local/bin/g++
+parameter may be used, like g++ -v"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
+
+(defcustom org-babel-D-compiler "rdmd"
+ "Command used to compile and execute a D source code file.
+May be either a command in the path, like rdmd
+or an absolute path name, like /usr/local/bin/rdmd
+parameter may be used, like rdmd --chatty"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
(defvar org-babel-c-variant nil
- "Internal variable used to hold which type of C (e.g. C or C++)
+ "Internal variable used to hold which type of C (e.g. C or C++ or D)
is currently being evaluated.")
(defun org-babel-execute:cpp (body params)
@@ -61,6 +80,11 @@ is currently being evaluated.")
This function calls `org-babel-execute:C++'."
(org-babel-execute:C++ body params))
+(defun org-babel-expand-body:cpp (body params)
+ "Expand a block of C++ code with org-babel according to it's
+header arguments."
+ (org-babel-expand-body:C++ body params))
+
(defun org-babel-execute:C++ (body params)
"Execute a block of C++ code with org-babel.
This function is called by `org-babel-execute-src-block'."
@@ -68,81 +92,168 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-expand-body:C++ (body params)
"Expand a block of C++ code with org-babel according to it's
-header arguments (calls `org-babel-C-expand')."
- (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
+header arguments."
+ (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand-C++ body params)))
+
+(defun org-babel-execute:D (body params)
+ "Execute a block of D code with org-babel.
+This function is called by `org-babel-execute-src-block'."
+ (let ((org-babel-c-variant 'd)) (org-babel-C-execute body params)))
+
+(defun org-babel-expand-body:D (body params)
+ "Expand a block of D code with org-babel according to it's
+header arguments."
+ (let ((org-babel-c-variant 'd)) (org-babel-C-expand-D body params)))
(defun org-babel-execute:C (body params)
"Execute a block of C code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
-(defun org-babel-expand-body:c (body params)
+(defun org-babel-expand-body:C (body params)
"Expand a block of C code with org-babel according to it's
-header arguments (calls `org-babel-C-expand')."
- (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params)))
+header arguments."
+ (let ((org-babel-c-variant 'c)) (org-babel-C-expand-C body params)))
(defun org-babel-C-execute (body params)
"This function should only be called by `org-babel-execute:C'
-or `org-babel-execute:C++'."
+or `org-babel-execute:C++' or `org-babel-execute:D'."
(let* ((tmp-src-file (org-babel-temp-file
"C-src-"
- (cond
- ((equal org-babel-c-variant 'c) ".c")
- ((equal org-babel-c-variant 'cpp) ".cpp"))))
- (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext))
- (cmdline (cdr (assoc :cmdline params)))
- (flags (cdr (assoc :flags params)))
- (full-body (org-babel-C-expand body params))
- (compile
- (progn
- (with-temp-file tmp-src-file (insert full-body))
- (org-babel-eval
- (format "%s -o %s %s %s"
- (cond
- ((equal org-babel-c-variant 'c) org-babel-C-compiler)
- ((equal org-babel-c-variant 'cpp) org-babel-C++-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)) ""))))
+ (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)))
+ (cmdline (if cmdline (concat " " cmdline) ""))
+ (flags (cdr (assoc :flags params)))
+ (flags (mapconcat 'identity
+ (if (listp flags) flags (list flags)) " "))
+ (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)))))
+ (with-temp-file tmp-src-file (insert full-body))
+ (case org-babel-c-variant
+ ((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))
+ (org-babel-process-file-name tmp-bin-file)
+ flags
+ (org-babel-process-file-name tmp-src-file)) ""))
+ (d nil)) ;; no separate compilation for D
(let ((results
- (org-babel-trim
- (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-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)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- ))
-
-(defun org-babel-C-expand (body params)
+ (org-babel-eval
+ (case org-babel-c-variant
+ ((c cpp)
+ (concat tmp-bin-file cmdline))
+ (d
+ (format "%s %s %s %s"
+ org-babel-D-compiler
+ flags
+ (org-babel-process-file-name tmp-src-file)
+ cmdline)))
+ "")))
+ (when results
+ (setq results (org-babel-trim (org-remove-indentation results)))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assoc :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)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
+ )))
+
+(defun org-babel-C-expand-C++ (body params)
+ "Expand a block of C or C++ code with org-babel according to
+it's header arguments."
+ (org-babel-C-expand-C body params))
+
+(defun org-babel-C-expand-C (body params)
"Expand a block of C or C++ code with org-babel according to
it's 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))
- (org-babel-read (org-entry-get nil "includes" t))))
- (defines (org-babel-read
- (or (cdr (assoc :defines params))
- (org-babel-read (org-entry-get nil "defines" t))))))
+ (colnames (cdar (org-babel-get-header params :colname-names)))
+ (main-p (not (string= (cdr (assoc :main params)) "no")))
+ (includes (org-babel-read
+ (or (cdr (assoc :includes params))
+ (org-entry-get nil "includes" t))
+ nil))
+ (defines (org-babel-read
+ (or (cdr (assoc :defines params))
+ (org-entry-get nil "defines" t))
+ nil)))
+ (when (stringp includes)
+ (setq includes (split-string includes)))
+ (when (stringp defines)
+ (let ((y nil)
+ (result (list t)))
+ (dolist (x (split-string defines))
+ (if (null y)
+ (setq y x)
+ (nconc result (list (concat y " " x)))
+ (setq y nil)))
+ (setq defines (cdr result))))
(mapconcat 'identity
(list
;; includes
(mapconcat
(lambda (inc) (format "#include %s" inc))
- (if (listp includes) includes (list includes)) "\n")
+ includes "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n")
+ ;; table sizes
+ (mapconcat 'org-babel-C-table-sizes-to-C vars "\n")
+ ;; tables headers utility
+ (when colnames
+ (org-babel-C-utility-header-to-C))
+ ;; tables headers
+ (mapconcat 'org-babel-C-header-to-C colnames "\n")
+ ;; body
+ (if main-p
+ (org-babel-C-ensure-main-wrap body)
+ body) "\n") "\n")))
+
+(defun org-babel-C-expand-D (body params)
+ "Expand a block of D code with org-babel according to
+it's 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))
+ (org-babel-read (org-entry-get nil "imports" t)))))
+ (when (stringp imports)
+ (setq imports (split-string imports)))
+ (setq imports (append imports '("std.stdio" "std.conv")))
+ (mapconcat 'identity
+ (list
+ "module mmm;"
+ ;; imports
+ (mapconcat
+ (lambda (inc) (format "import %s;" inc))
+ imports "\n")
+ ;; variables
+ (mapconcat 'org-babel-C-var-to-C vars "\n")
+ ;; table sizes
+ (mapconcat 'org-babel-C-table-sizes-to-C vars "\n")
+ ;; tables headers utility
+ (when colnames
+ (org-babel-C-utility-header-to-C))
+ ;; tables headers
+ (mapconcat 'org-babel-C-header-to-C colnames "\n")
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
@@ -177,58 +288,79 @@ support for sessions"
"Determine the type of VAL.
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
+ (list
+ (if (equal org-babel-c-variant 'd) "string" "const char*")
+ "\"%s\""))
+ (t (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
+ ((and (listp val) (listp (car val))) ;; a table
+ `(,(car type)
+ (lambda (val)
+ (cons
+ (format "[%d][%d]" (length val) (length (car val)))
+ (concat
+ (if (equal org-babel-c-variant 'd) "[\n" "{\n")
+ (mapconcat
+ (lambda (v)
+ (concat
+ (if (equal org-babel-c-variant 'd) " [" " {")
+ (mapconcat (lambda (w) (format ,(cadr type) w)) v ",")
+ (if (equal org-babel-c-variant 'd) "]" "}")))
+ val
+ ",\n")
+ (if (equal 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) "[" "{")
+ (mapconcat (lambda (v) (format ,(cadr type) v)) val ",")
+ (if (equal org-babel-c-variant 'd) "]" "}"))))))
+ (t ;; treat unknown types as string
+ type))))
+
+(defun org-babel-C-val-to-base-type (val)
+ "Determine the base type of VAL which may be
+'integerp if all base values are integers
+'floatp if all base values are either floating points or integers
+'stringp otherwise."
(cond
- ((integerp val) '("int" "%d"))
- ((floatp val) '("double" "%f"))
+ ((integerp val) 'integerp)
+ ((floatp val) 'floatp)
((or (listp val) (vectorp val))
- (lexical-let ((type (org-babel-C-val-to-C-list-type val)))
- (list (car type)
- (lambda (val)
- (cons
- (format "[%d]%s"
- (length val)
- (car (org-babel-C-format-val type (elt val 0))))
- (concat "{ "
- (mapconcat (lambda (v)
- (cdr (org-babel-C-format-val type v)))
- val
- ", ")
- " }"))))))
- (t ;; treat unknown types as string
- '("char" (lambda (val)
- (let ((s (format "%s" val))) ;; convert to string for unknown types
- (cons (format "[%d]" (1+ (length s)))
- (concat "\"" s "\""))))))))
-
-(defun org-babel-C-val-to-C-list-type (val)
- "Determine the C array type of a VAL."
- (let (type)
- (mapc
- #'(lambda (i)
- (let* ((tmp-type (org-babel-C-val-to-C-type i))
- (type-name (car type))
- (tmp-type-name (car tmp-type)))
- (when (and type (not (string= type-name tmp-type-name)))
- (if (and (member type-name '("int" "double" "int32_t"))
- (member tmp-type-name '("int" "double" "int32_t")))
- (setq tmp-type '("double" "" "%f"))
- (error "Only homogeneous lists are supported by C. You can not mix %s and %s"
- type-name
- tmp-type-name)))
- (setq type tmp-type)))
- val)
- type))
+ (let ((type nil))
+ (mapc (lambda (v)
+ (case (org-babel-C-val-to-base-type v)
+ (stringp (setq type 'stringp))
+ (floatp
+ (if (or (not type) (eq type 'integerp))
+ (setq type 'floatp)))
+ (integerp
+ (unless type (setq type 'integerp)))))
+ val)
+ type))
+ (t 'stringp)))
(defun org-babel-C-var-to-C (pair)
"Convert an elisp val into a string of C code specifying a var
of the same value."
;; TODO list support
(let ((var (car pair))
- (val (cdr pair)))
+ (val (cdr pair)))
(when (symbolp val)
(setq val (symbol-name val))
(when (= (length val) 1)
- (setq val (string-to-char val))))
+ (setq val (string-to-char val))))
(let* ((type-data (org-babel-C-val-to-C-type val))
(type (car type-data))
(formated (org-babel-C-format-val type-data val))
@@ -240,6 +372,68 @@ of the same value."
suffix
data))))
+(defun org-babel-C-table-sizes-to-C (pair)
+ "Create constants of table dimensions, if PAIR is a table."
+ (when (listp (cdr pair))
+ (cond
+ ((listp (cadr pair)) ;; a table
+ (concat
+ (format "const int %s_rows = %d;" (car pair) (length (cdr pair)))
+ "\n"
+ (format "const int %s_cols = %d;" (car pair) (length (cadr pair)))))
+ (t ;; a list declared in the #+begin_src line
+ (format "const int %s_cols = %d;" (car pair) (length (cdr pair)))))))
+
+(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)
+ "int get_column_num (int nbcols, const char** header, const char* column)
+{
+ int c;
+ for (c=0; c<nbcols; c++)
+ if (strcmp(header[c],column)==0)
+ return c;
+ return -1;
+}
+"
+ )
+ (d
+ "int get_column_num (string[] header, string column)
+{
+ foreach (c, h; header)
+ if (h==column)
+ 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
+specifying a variable with the name of the table."
+ (let ((table (car head))
+ (headers (cdr head)))
+ (concat
+ (format
+ (case org-babel-c-variant
+ ((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)
+ (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
+ (format
+ "string %s_h (ulong row, string col) { return %s[row][get_column_num(%s_header,col)]; }"
+ table table table))))))
+
(provide 'ob-C)
;;; ob-C.el ends here
diff --git a/lisp/ob-J.el b/lisp/ob-J.el
new file mode 100644
index 0000000..500ce9e
--- /dev/null
+++ b/lisp/ob-J.el
@@ -0,0 +1,179 @@
+;;; ob-J.el --- org-babel functions for J evaluation
+
+;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+;; 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 J code.
+;;
+;; Session interaction depends on `j-console' from package `j-mode'
+;; (available in MELPA).
+
+;;; Code:
+(require 'ob)
+
+(declare-function org-trim "org" (S))
+(declare-function j-console-ensure-session "ext:j-console" ())
+
+(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))
+
+(defun org-babel-J-interleave-echos (body)
+ "Interleave echo',' between each source line of BODY."
+ (mapconcat #'identity (split-string body "\n") "\necho','\n"))
+
+(defun org-babel-J-interleave-echos-except-functions (body)
+ "Interleave echo',' between source lines of BODY that aren't functions."
+ (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body)
+ (let ((s1 (substring body 0 (match-beginning 0)))
+ (s2 (match-string 0 body))
+ (s3 (substring body (match-end 0))))
+ (concat
+ (if (string= s1 "")
+ ""
+ (concat (org-babel-J-interleave-echos s1)
+ "\necho','\n"))
+ s2
+ "\necho','\n"
+ (org-babel-J-interleave-echos-except-functions s3)))
+ (org-babel-J-interleave-echos body)))
+
+(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))
+ (full-body (org-babel-expand-body:J
+ body params processed-params))
+ (tmp-script-file (org-babel-temp-file "J-src")))
+ (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-J-eval-string full-body)))))
+
+(defun org-babel-J-eval-string (str)
+ "Sends STR to the `j-console-cmd' session and exectues it."
+ (let ((session (j-console-ensure-session)))
+ (with-current-buffer (process-buffer session)
+ (goto-char (point-max))
+ (insert (format "\n%s\n" str))
+ (let ((beg (point)))
+ (comint-send-input)
+ (sit-for .1)
+ (buffer-substring-no-properties
+ beg (point-max))))))
+
+(defun org-babel-J-strip-whitespace (str)
+ "Remove whitespace from jconsole output STR."
+ (mapconcat
+ #'identity
+ (delete "" (mapcar
+ #'org-babel-J-print-block
+ (split-string str "^ *,\n" t)))
+ "\n\n"))
+
+(defun obj-get-string-alignment (str)
+ "Return a number to describe STR alignment.
+STR represents a table.
+Positive/negative/zero result means right/left/undetermined.
+Don't trust first line."
+ (let* ((str (org-trim str))
+ (lines (split-string str "\n" t))
+ n1 n2)
+ (cond ((<= (length lines) 1)
+ 0)
+ ((= (length lines) 2)
+ ;; numbers are right-aligned
+ (if (and
+ (numberp (read (car lines)))
+ (numberp (read (cadr lines)))
+ (setq n1 (obj-match-second-space-right (nth 0 lines)))
+ (setq n2 (obj-match-second-space-right (nth 1 lines))))
+ n2
+ 0))
+ ((not (obj-match-second-space-left (nth 0 lines)))
+ 0)
+ ((and
+ (setq n1 (obj-match-second-space-left (nth 1 lines)))
+ (setq n2 (obj-match-second-space-left (nth 2 lines)))
+ (= n1 n2))
+ n1)
+ ((and
+ (setq n1 (obj-match-second-space-right (nth 1 lines)))
+ (setq n2 (obj-match-second-space-right (nth 2 lines)))
+ (= n1 n2))
+ (- n1))
+ (t 0))))
+
+(defun org-babel-J-print-block (x)
+ "Prettify jconsole output X."
+ (let* ((x (org-trim x))
+ (a (obj-get-string-alignment x))
+ (lines (split-string x "\n" t))
+ b)
+ (cond ((< a 0)
+ (setq b (obj-match-second-space-right (nth 0 lines)))
+ (concat (make-string (+ a b) ? ) x))
+ ((> a 0)
+ (setq b (obj-match-second-space-left (nth 0 lines)))
+ (concat (make-string (- a b) ? ) x))
+ (t x))))
+
+(defun obj-match-second-space-left (s)
+ "Return position of leftmost space in second space block of S or nil."
+ (and (string-match "^ *[^ ]+\\( \\)" s)
+ (match-beginning 1)))
+
+(defun obj-match-second-space-right (s)
+ "Return position of rightmost space in second space block of S or nil."
+ (and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s)
+ (match-beginning 1)))
+
+(defun obj-string-match-m (regexp string &optional start)
+ "Call (string-match REGEXP STRING START).
+REGEXP is modified so that .* matches newlines as well."
+ (string-match
+ (replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp)
+ string
+ start))
+
+(defun org-babel-j-initiate-session (&optional session)
+ "Initiate a J session.
+SESSION is a parameter given by org-babel."
+ (unless (string= session "none")
+ (require 'j-console)
+ (j-console-ensure-session)))
+
+(provide 'ob-J)
+
+;;; ob-J.el ends here
diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index b97fd91..ac84d7d 100644
--- a/lisp/ob-R.el
+++ b/lisp/ob-R.el
@@ -1,6 +1,6 @@
;;; ob-R.el --- org-babel functions for R code evaluation
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
@@ -35,8 +35,11 @@
(declare-function inferior-ess-send-input "ext:ess-inf" ())
(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))
(defconst org-babel-header-args:R
'((width . :any)
@@ -60,12 +63,25 @@
(useDingbats . :any)
(horizontal . :any)
(results . ((file list vector table scalar verbatim)
- (raw org html latex code pp wrap)
- (replace silent append prepend)
+ (raw html latex org code pp drawer)
+ (replace silent none append prepend)
(output value graphics))))
"R-specific header arguments.")
+(defconst ob-R-safe-header-args
+ (append org-babel-safe-header-args
+ '(:width :height :bg :units :pointsize :antialias :quality
+ :compression :res :type :family :title :fonts
+ :version :paper :encoding :pagecentre :colormodel
+ :useDingbats :horizontal))
+ "Header args which are safe for R babel blocks.
+
+See `org-babel-safe-header-args' for documentation of the format of
+this variable.")
+
(defvar org-babel-default-header-args:R '())
+(put 'org-babel-default-header-args:R 'safe-local-variable
+ (org-babel-header-args-safe-fn ob-R-safe-header-args))
(defcustom org-babel-R-command "R --slave --no-save"
"Name of command to use for executing R code."
@@ -73,34 +89,67 @@
:version "24.1"
:type 'string)
-(defvar ess-local-process-name) ; dynamically scoped
+(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)))))
+;; The usage of utils::read.table() ensures that the command
+;; read.table() can be found even in circumstances when the utils
+;; package is not in the search path from R.
+(defconst ob-R-transfer-variable-table-with-header
+ "%s <- local({
+ con <- textConnection(
+ %S
+ )
+ res <- utils::read.table(
+ con,
+ header = %s,
+ row.names = %s,
+ sep = \"\\t\",
+ as.is = TRUE
+ )
+ close(con)
+ res
+ })"
+ "R code used to transfer a table defined as a variable from org to R.
+
+This function is used when the table contains a header.")
+
+(defconst ob-R-transfer-variable-table-without-header
+ "%s <- local({
+ con <- textConnection(
+ %S
+ )
+ res <- utils::read.table(
+ con,
+ header = %s,
+ row.names = %s,
+ sep = \"\\t\",
+ as.is = TRUE,
+ fill = TRUE,
+ col.names = paste(\"V\", seq_len(%d), sep =\"\")
+ )
+ close(con)
+ res
+ })"
+ "R code used to transfer a table defined as a variable from org to R.
+
+This function is used when the table does not contain a header.")
+
(defun org-babel-expand-body:R (body params &optional graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((graphics-file
- (or graphics-file (org-babel-R-graphical-output-file params))))
- (mapconcat
- #'identity
- (let ((inside
- (append
- (when (cdr (assoc :prologue params))
- (list (cdr (assoc :prologue params))))
- (org-babel-variable-assignments:R params)
- (list body)
- (when (cdr (assoc :epilogue params))
- (list (cdr (assoc :epilogue params)))))))
- (if graphics-file
- (append
- (list (org-babel-R-construct-graphics-device-call
- graphics-file params))
- inside
- (list "dev.off()"))
- inside))
- "\n")))
+ (mapconcat 'identity
+ (append
+ (when (cdr (assoc :prologue params))
+ (list (cdr (assoc :prologue params))))
+ (org-babel-variable-assignments:R params)
+ (list body)
+ (when (cdr (assoc :epilogue params))
+ (list (cdr (assoc :epilogue params)))))
+ "\n"))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
@@ -112,8 +161,20 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assoc :session params)) params))
(colnames-p (cdr (assoc :colnames params)))
(rownames-p (cdr (assoc :rownames params)))
- (graphics-file (org-babel-R-graphical-output-file params))
- (full-body (org-babel-expand-body:R body params graphics-file))
+ (graphics-file (and (member "graphics" (assq :result-params params))
+ (org-babel-graphical-output-file params)))
+ (full-body
+ (let ((inside
+ (list (org-babel-expand-body:R body params graphics-file))))
+ (mapconcat 'identity
+ (if graphics-file
+ (append
+ (list (org-babel-R-construct-graphics-device-call
+ graphics-file params))
+ inside
+ (list "},error=function(e){plot(x=-1:1, y=-1:1, type='n', xlab='', ylab='', axes=FALSE); text(x=0, y=0, labels=e$message, col='red'); paste('ERROR', e$message, sep=' : ')}); dev.off()"))
+ inside)
+ "\n")))
(result
(org-babel-R-evaluate
session full-body result-type result-params
@@ -148,7 +209,7 @@ 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 (mapcar 'cdr (org-babel-get-header params :var))))
(mapcar
(lambda (pair)
(org-babel-R-assign-elisp
@@ -175,33 +236,23 @@ This function is called by `org-babel-execute-src-block'."
(if (listp value)
(let* ((lengths (mapcar 'length (org-remove-if-not 'sequencep value)))
(max (if lengths (apply 'max lengths) 0))
- (min (if lengths (apply 'min lengths) 0))
- (transition-file (org-babel-temp-file "R-import-")))
+ (min (if lengths (apply 'min lengths) 0)))
;; Ensure VALUE has an orgtbl structure (depth of at least 2).
(unless (listp (car value)) (setq value (list value)))
- (with-temp-file transition-file
- (insert
- (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))
- "\n"))
- (let ((file (org-babel-process-file-name transition-file 'noquote))
+ (let ((file (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
(header (if (or (eq (nth 1 value) 'hline) colnames-p)
"TRUE" "FALSE"))
(row-names (if rownames-p "1" "NULL")))
(if (= max min)
- (format "%s <- read.table(\"%s\",
- header=%s,
- row.names=%s,
- sep=\"\\t\",
- as.is=TRUE)" name file header row-names)
- (format "%s <- read.table(\"%s\",
- header=%s,
- row.names=%s,
- sep=\"\\t\",
- as.is=TRUE,
- fill=TRUE,
- col.names = paste(\"V\", seq_len(%d), sep =\"\"))"
+ (format ob-R-transfer-variable-table-with-header
+ name file header row-names)
+ (format ob-R-transfer-variable-table-without-header
name file header row-names max))))
- (format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
+ (cond ((integerp value) (format "%s <- %s" name (concat (number-to-string value) "L")))
+ ((floatp value) (format "%s <- %s" name value))
+ ((stringp value) (format "%s <- %S" name (org-no-properties value)))
+ (t (format "%s <- %S" name (prin1-to-string value))))))
+
(defvar ess-ask-for-ess-directory) ; dynamically scoped
(defun org-babel-R-initiate-session (session params)
@@ -209,7 +260,8 @@ This function is called by `org-babel-execute-src-block'."
(unless (string= session "none")
(let ((session (or session "*R*"))
(ess-ask-for-ess-directory
- (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
+ (and (boundp 'ess-ask-for-ess-directory)
+ ess-ask-for-ess-directory
(not (cdr (assoc :dir params))))))
(if (org-babel-comint-buffer-livep session)
session
@@ -218,6 +270,10 @@ This function is called by `org-babel-execute-src-block'."
;; Session buffer exists, but with dead process
(set-buffer session))
(require 'ess) (R)
+ (let ((R-proc (get-process (or ess-local-process-name
+ ess-current-process-name))))
+ (while (process-get R-proc 'callbacks)
+ (ess-wait-for-process R-proc)))
(rename-buffer
(if (bufferp session)
(buffer-name session)
@@ -234,11 +290,6 @@ current code buffer."
(process-name (get-buffer-process session)))
(ess-make-buffer-current))
-(defun org-babel-R-graphical-output-file (params)
- "Name of file to which R should send graphical output."
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
-
(defvar org-babel-R-graphics-devices
'((:bmp "bmp" "filename")
(:jpg "jpeg" "filename")
@@ -280,14 +331,43 @@ Each member of this list is a list with three members:
(substring (symbol-name (car pair)) 1)
(cdr pair)) ""))
params ""))
- (format "%s(%s=\"%s\"%s%s%s)"
+ (format "%s(%s=\"%s\"%s%s%s); tryCatch({"
device filearg out-file args
(if extra-args "," "") (or extra-args ""))))
-(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'")
-(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
-
-(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")")
+(defconst org-babel-R-eoe-indicator "'org_babel_R_eoe'")
+(defconst org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
+
+(defconst org-babel-R-write-object-command "{
+ function(object,transfer.file) {
+ object
+ invisible(
+ if (
+ inherits(
+ try(
+ {
+ tfile<-tempfile()
+ write.table(object, file=tfile, sep=\"\\t\",
+ na=\"nil\",row.names=%s,col.names=%s,
+ quote=FALSE)
+ file.rename(tfile,transfer.file)
+ },
+ silent=TRUE),
+ \"try-error\"))
+ {
+ if(!file.exists(transfer.file))
+ file.create(transfer.file)
+ }
+ )
+ }
+}(object=%s,transfer.file=\"%s\")"
+ "A template for an R command to evaluate a block of code and write the result to a file.
+
+Has four %s escapes to be filled in:
+1. Row names, \"TRUE\" or \"FALSE\"
+2. Column names, \"TRUE\" or \"FALSE\"
+3. The code to be run (must be an expression, not a statement)
+4. The name of the file to write to")
(defun org-babel-R-evaluate
(session body result-type result-params column-names-p row-names-p)
@@ -358,7 +438,7 @@ last statement in BODY, as elisp."
column-names-p)))
(output
(mapconcat
- #'org-babel-chomp
+ 'org-babel-chomp
(butlast
(delq nil
(mapcar
@@ -370,7 +450,7 @@ last statement in BODY, as elisp."
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
- (insert (mapconcat #'org-babel-chomp
+ (insert (mapconcat 'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))))) "\n"))))
diff --git a/lisp/ob-abc.el b/lisp/ob-abc.el
new file mode 100644
index 0000000..a980b02
--- /dev/null
+++ b/lisp/ob-abc.el
@@ -0,0 +1,94 @@
+;;; ob-abc.el --- org-babel functions for template evaluation
+
+;; Copyright (C) Free Software Foundation
+
+;; Author: William Waites
+;; Keywords: literate programming, music
+;; Homepage: http://www.tardis.ed.ac.uk/wwaites
+;; Version: 0.01
+
+;;; License:
+
+;; 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, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;;; This file adds support to Org Babel for music in ABC notation.
+;;; It requires that the abcm2ps program is installed.
+;;; See http://moinejf.free.fr/
+
+(require 'ob)
+
+;; optionally define a file extension for this language
+(add-to-list 'org-babel-tangle-lang-exts '("abc" . "abc"))
+
+;; optionally declare default header arguments for this language
+(defvar org-babel-default-header-args:abc
+ '((:results . "file") (:exports . "results"))
+ "Default arguments to use when evaluating an ABC source block.")
+
+(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))))
+ (mapc
+ (lambda (pair)
+ (let ((name (symbol-name (car pair)))
+ (value (cdr pair)))
+ (setq body
+ (replace-regexp-in-string
+ (concat "\$" (regexp-quote name))
+ (if (stringp value) value (format "%S" value))
+ body))))
+ vars)
+ body))
+
+(defun org-babel-execute:abc (body params)
+ "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)))))
+ (in-file (org-babel-temp-file "abc-"))
+ (render (concat "abcm2ps" " " cmdline
+ " -O " (org-babel-process-file-name out-file)
+ " " (org-babel-process-file-name in-file))))
+ (with-temp-file in-file (insert (org-babel-expand-body:abc body params)))
+ (org-babel-eval render "")
+ ;;; handle where abcm2ps changes the file name (to support multiple files
+ (when (or (string= (file-name-extension out-file) "eps")
+ (string= (file-name-extension out-file) "svg"))
+ (rename-file (concat
+ (file-name-sans-extension out-file) "001."
+ (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))) ""))
+ ;;; 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)
+ "Return an error because abc does not support sessions."
+ (error "ABC does not support sessions"))
+
+(provide 'ob-abc)
+;;; ob-abc.el ends here
diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el
index 21c0a17..ca58ecb 100644
--- a/lisp/ob-asymptote.el
+++ b/lisp/ob-asymptote.el
@@ -1,6 +1,6 @@
;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -45,9 +45,6 @@
(require 'ob)
(eval-when-compile (require 'cl))
-(declare-function orgtbl-to-generic "org-table" (table params))
-(declare-function org-combine-plists "org" (&rest plists))
-
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el
index ed98afd..a96ba1a 100644
--- a/lisp/ob-awk.el
+++ b/lisp/ob-awk.el
@@ -46,9 +46,6 @@
(defun org-babel-expand-body:awk (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
- (setf body (replace-regexp-in-string
- (regexp-quote (format "$%s" (car pair))) (cdr pair) body)))
body)
(defun org-babel-execute:awk (body params)
@@ -68,10 +65,17 @@ called by `org-babel-execute-src-block'"
(with-temp-file tmp
(insert (org-babel-awk-var-to-awk res)))
tmp))))
- (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command
- "-f" code-file
- cmd-line
- in-file))
+ (cmd (mapconcat #'identity
+ (append
+ (list org-babel-awk-command
+ "-f" code-file cmd-line)
+ (mapcar (lambda (pair)
+ (format "-v %s='%s'"
+ (cadr pair)
+ (org-babel-awk-var-to-awk
+ (cddr pair))))
+ (org-babel-get-header params :var))
+ (list in-file))
" ")))
(org-babel-reassemble-table
(let ((results
@@ -101,11 +105,6 @@ called by `org-babel-execute-src-block'"
(mapconcat echo-var var "\n"))
(t (funcall echo-var var)))))
-(defun org-babel-awk-table-or-string (results)
- "If the results look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
(provide 'ob-awk)
diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
index 78f3c6d..21a3ef8 100644
--- a/lisp/ob-clojure.el
+++ b/lisp/ob-clojure.el
@@ -2,8 +2,8 @@
;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
-;; Author: Joel Boehland
-;; Eric Schulte
+;; Author: Joel Boehland, Eric Schulte, Oleh Krehel
+;;
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
@@ -24,21 +24,27 @@
;;; Commentary:
-;; Support for evaluating clojure code, relies on slime for all eval.
+;; Support for evaluating clojure code
-;;; Requirements:
+;; Requirements:
;; - clojure (at least 1.2.0)
;; - clojure-mode
-;; - slime
+;; - either cider or SLIME
-;; By far, the best way to install these components is by following
+;; For Cider, see https://github.com/clojure-emacs/cider
+
+;; For SLIME, the best way to install these components is by following
;; the directions as set out by Phil Hagelberg (Technomancy) on the
;; web page: http://technomancy.us/126
;;; Code:
(require 'ob)
+(eval-when-compile
+ (require 'cl))
+(declare-function nrepl-dict-get "ext:nrepl-client" (dict key))
+(declare-function nrepl-sync-request:eval "ext:nrepl-client" (input &optional ns session))
(declare-function slime-eval "ext:slime" (sexp &optional package))
(defvar org-babel-tangle-lang-exts)
@@ -47,6 +53,15 @@
(defvar org-babel-default-header-args:clojure '())
(defvar org-babel-header-args:clojure '((package . :any)))
+(defcustom org-babel-clojure-backend
+ (cond ((featurep 'cider) 'cider)
+ (t 'slime))
+ "Backend used to evaluate Clojure code blocks."
+ :group 'org-babel
+ :type '(choice
+ (const :tag "cider" cider)
+ (const :tag "SLIME" slime)))
+
(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)))
@@ -61,35 +76,40 @@
vars "\n ")
"]\n" body ")")
body))))
- (cond ((or (member "code" result-params) (member "pp" result-params))
- (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] "
- "(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch "
- "(clojure.pprint/pprint (do %s) org-mode-print-catcher) "
- "(str org-mode-print-catcher)))")
- (if (member "code" result-params) "code" "simple") body))
- ;; if (:results output), collect printed output
- ((member "output" result-params)
- (format "(clojure.core/with-out-str %s)" body))
- (t body))))
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (format "(clojure.pprint/pprint (do %s))" body)
+ body)))
(defun org-babel-execute:clojure (body params)
"Execute a block of Clojure code with Babel."
- (require 'slime)
- (with-temp-buffer
- (insert (org-babel-expand-body:clojure body params))
- (let ((result
- (slime-eval
- `(swank:eval-and-grab-output
- ,(buffer-substring-no-properties (point-min) (point-max)))
- (cdr (assoc :package params)))))
- (let ((result-params (cdr (assoc :result-params params))))
- (org-babel-result-cond result-params
- result
- (condition-case nil (org-babel-script-escape result)
- (error result)))))))
+ (let ((expanded (org-babel-expand-body:clojure body params))
+ result)
+ (case org-babel-clojure-backend
+ (cider
+ (require 'cider)
+ (let ((result-params (cdr (assoc :result-params params))))
+ (setq result
+ (nrepl-dict-get
+ (nrepl-sync-request:eval expanded)
+ (if (or (member "output" result-params)
+ (member "pp" result-params))
+ "out"
+ "value")))))
+ (slime
+ (require 'slime)
+ (with-temp-buffer
+ (insert expanded)
+ (setq result
+ (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))
+ result
+ (condition-case nil (org-babel-script-escape result)
+ (error result)))))
(provide 'ob-clojure)
-
-
;;; ob-clojure.el ends here
diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el
index 40bfaf7..7c768d3 100644
--- a/lisp/ob-comint.el
+++ b/lisp/ob-comint.el
@@ -48,12 +48,13 @@ BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
executed inside the protection of `save-excursion' and
`save-match-data'."
(declare (indent 1))
- `(save-excursion
+ `(progn
+ (unless (org-babel-comint-buffer-livep ,buffer)
+ (error "Buffer %s does not exist or has no process" ,buffer))
(save-match-data
- (unless (org-babel-comint-buffer-livep ,buffer)
- (error "Buffer %s does not exist or has no process" ,buffer))
- (set-buffer ,buffer)
- ,@body)))
+ (with-current-buffer ,buffer
+ (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)
@@ -69,46 +70,42 @@ elements are optional.
This macro ensures that the filter is removed in case of an error
or user `keyboard-quit' during execution of body."
(declare (indent 1))
- (let ((buffer (car meta))
- (eoe-indicator (cadr meta))
- (remove-echo (cadr (cdr meta)))
- (full-body (cadr (cdr (cdr meta)))))
+ (let ((buffer (nth 0 meta))
+ (eoe-indicator (nth 1 meta))
+ (remove-echo (nth 2 meta))
+ (full-body (nth 3 meta)))
`(org-babel-comint-in-buffer ,buffer
- (let ((string-buffer "") dangling-text raw)
- ;; setup filter
- (setq comint-output-filter-functions
+ (let* ((string-buffer "")
+ (comint-output-filter-functions
(cons (lambda (text) (setq string-buffer (concat string-buffer text)))
comint-output-filter-functions))
- (unwind-protect
- (progn
- ;; got located, and save dangling text
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (let ((start (point))
- (end (point-max)))
- (setq dangling-text (buffer-substring start end))
- (delete-region start end))
- ;; pass FULL-BODY to process
- ,@body
- ;; wait for end-of-evaluation indicator
- (while (progn
- (goto-char comint-last-input-end)
- (not (save-excursion
- (and (re-search-forward
- (regexp-quote ,eoe-indicator) nil t)
- (re-search-forward
- comint-prompt-regexp nil t)))))
- (accept-process-output (get-buffer-process (current-buffer)))
- ;; thought the following this would allow async
- ;; background running, but I was wrong...
- ;; (run-with-timer .5 .5 'accept-process-output
- ;; (get-buffer-process (current-buffer)))
- )
- ;; replace cut dangling text
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (insert dangling-text))
- ;; remove filter
- (setq comint-output-filter-functions
- (cdr comint-output-filter-functions)))
+ dangling-text raw)
+ ;; got located, and save dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (let ((start (point))
+ (end (point-max)))
+ (setq dangling-text (buffer-substring start end))
+ (delete-region start end))
+ ;; pass FULL-BODY to process
+ ,@body
+ ;; wait for end-of-evaluation indicator
+ (while (progn
+ (goto-char comint-last-input-end)
+ (not (save-excursion
+ (and (re-search-forward
+ (regexp-quote ,eoe-indicator) nil t)
+ (re-search-forward
+ comint-prompt-regexp nil t)))))
+ (accept-process-output (get-buffer-process (current-buffer)))
+ ;; thought the following this would allow async
+ ;; background running, but I was wrong...
+ ;; (run-with-timer .5 .5 'accept-process-output
+ ;; (get-buffer-process (current-buffer)))
+ )
+ ;; replace cut dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert dangling-text)
+
;; remove echo'd FULL-BODY from input
(if (and ,remove-echo ,full-body
(string-match
@@ -151,7 +148,7 @@ FILE exists at end of evaluation."
(if (file-exists-p file) (delete-file file))
(process-send-string
(get-buffer-process buffer)
- (if (string-match "\n$" string) string (concat string "\n")))
+ (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)
diff --git a/lisp/ob-coq.el b/lisp/ob-coq.el
new file mode 100644
index 0000000..b6ebcff
--- /dev/null
+++ b/lisp/ob-coq.el
@@ -0,0 +1,77 @@
+;;; ob-coq.el --- org-babel functions for Coq
+
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; 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:
+
+;; Rudimentary support for evaluating Coq code blocks. Currently only
+;; session evaluation is supported. Requires both coq.el and
+;; coq-inferior.el, both of which are distributed with Coq.
+;;
+;; http://coq.inria.fr/
+
+;;; Code:
+(require 'ob)
+
+(declare-function run-coq "ext:coq-inferior.el" (cmd))
+(declare-function coq-proc "ext:coq-inferior.el" ())
+
+(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))
+ string))
+
+(defun org-babel-execute:coq (body params)
+ (let ((full-body (org-babel-expand-body:generic body params))
+ (session (org-babel-coq-initiate-session))
+ (pt (lambda ()
+ (marker-position
+ (process-mark (get-buffer-process (current-buffer)))))))
+ (org-babel-coq-clean-prompt
+ (org-babel-comint-in-buffer session
+ (let ((start (funcall pt)))
+ (with-temp-buffer
+ (insert full-body)
+ (comint-send-region (coq-proc) (point-min) (point-max))
+ (comint-send-string (coq-proc)
+ (if (string= (buffer-substring (- (point-max) 1) (point-max)) ".")
+ "\n"
+ ".\n")))
+ (while (equal start (funcall pt)) (sleep-for 0.1))
+ (buffer-substring start (funcall pt)))))))
+
+(defun org-babel-coq-initiate-session ()
+ "Initiate a coq session.
+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"))
+ (sit-for 0.1)
+ (get-buffer org-babel-coq-buffer))
+
+(provide 'ob-coq)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index eef408f..30020f7 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1,6 +1,6 @@
;;; ob-core.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -39,6 +39,7 @@
(defvar org-babel-library-of-babel)
(declare-function show-all "outline" ())
(declare-function org-every "org" (pred seq))
+(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"
@@ -48,9 +49,8 @@
(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-edit-src-code "org-src"
- (&optional context code edit-buffer-name quietp))
-(declare-function org-edit-src-exit "org-src" (&optional context))
+(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))
@@ -96,7 +96,12 @@
(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-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-property "org-element" (property element))
+(declare-function org-every "org" (pred seq))
+(declare-function org-macro-escape-arguments "org-macro" (&rest args))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
@@ -135,12 +140,16 @@ remove code block execution from the C-c C-c keybinding."
(defcustom org-babel-results-keyword "RESULTS"
"Keyword used to name results generated by code blocks.
-Should be either RESULTS or NAME however any capitalization may
-be used."
+It should be \"RESULTS\". However any capitalization may be
+used."
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
- :type 'string)
+ :type 'string
+ :safe (lambda (v)
+ (and (stringp v)
+ (eq (compare-strings "RESULTS" nil nil v nil nil t)
+ t))))
(defcustom org-babel-noweb-wrap-start "<<"
"String used to begin a noweb reference in a code block.
@@ -159,6 +168,11 @@ See also `org-babel-noweb-wrap-start'."
This string must include a \"%s\" which will be replaced by the results."
:group 'org-babel
:type 'string)
+(put 'org-babel-inline-result-wrap
+ 'safe-local-variable
+ (lambda (value)
+ (and (stringp value)
+ (string-match-p "%s" value))))
(defun org-babel-noweb-wrap (&optional regexp)
(concat org-babel-noweb-wrap-start
@@ -173,14 +187,6 @@ This string must include a \"%s\" which will be replaced by the results."
"^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
"Regular expression used to match multi-line header arguments.")
-(defvar org-babel-src-name-w-name-regexp
- (concat org-babel-src-name-regexp
- "\\("
- org-babel-multi-line-header-regexp
- "\\)*"
- "\\([^ ()\f\t\n\r\v]+\\)")
- "Regular expression matching source name lines with a name.")
-
(defvar org-babel-src-block-regexp
(concat
;; (1) indentation (2) lang
@@ -196,9 +202,9 @@ This string must include a \"%s\" which will be replaced by the results."
(defvar org-babel-inline-src-block-regexp
(concat
;; (1) replacement target (2) lang
- "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)"
+ "\\(?:^\\|[^-[: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.")
@@ -212,35 +218,24 @@ not match KEY should be returned."
(lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
params)))
-(defun org-babel-get-inline-src-block-matches()
+(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"
- (let ((src-at-0-p (save-excursion
- (beginning-of-line 1)
- (string= "src" (thing-at-point 'word))))
- (first-line-p (= (line-beginning-position) (point-min)))
- (orig (point)))
- (let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
- (first-line-p "[[:punct:] \t]src_")
- (t "[[:punct:] \f\t\n\r\v]src_")))
- (lower-limit (if first-line-p
- nil
- (- (point-at-bol) 1))))
- (save-excursion
- (when (or (and src-at-0-p (bobp))
- (and (re-search-forward "}" (point-at-eol) t)
- (re-search-backward search-for lower-limit t)
- (> orig (point))))
- (when (looking-at org-babel-inline-src-block-regexp)
- t ))))))
+ (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()
+(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
- (unless (= (point) (point-at-bol)) ;; move before inline block
- (re-search-backward "[ \f\t\n\r\v]" nil t))
+ (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)))
@@ -268,17 +263,24 @@ Returns a list
(org-babel-merge-params
(nth 2 info)
(org-babel-parse-header-arguments (match-string 1)))))
- (when (looking-at org-babel-src-name-w-name-regexp)
- (setq name (org-no-properties (match-string 3)))))
+ (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)))))
-(defvar org-current-export-file) ; dynamically bound
+(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.
@@ -288,24 +290,27 @@ 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 eval eval-no export eval-no-export)
+ (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-bound-and-true-p org-current-export-file))
+ (,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)
- (funcall org-confirm-babel-evaluate
- ,lang ,block-body)
+ (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) " ")))
@@ -396,12 +401,16 @@ a window into the `org-babel-get-src-block-info' function."
(header-args (nth 2 info)))
(when name (funcall printf "Name: %s\n" name))
(when lang (funcall printf "Lang: %s\n" lang))
+ (funcall printf "Properties:\n")
+ (funcall printf "\t:header-args \t%s\n" (org-entry-get (point) "header-args" t))
+ (funcall printf "\t:header-args:%s \t%s\n" lang (org-entry-get (point) (concat "header-args:" lang) t))
+
(when (funcall full switches) (funcall printf "Switches: %s\n" switches))
(funcall printf "Header Arguments:\n")
(dolist (pair (sort header-args
(lambda (a b) (string< (symbol-name (car a))
(symbol-name (car b))))))
- (when (funcall full (cdr pair))
+ (when (funcall full (format "%s" (cdr pair)))
(funcall printf "\t%S%s\t%s\n"
(car pair)
(if (> (length (format "%S" (car pair))) 7) "" "\t")
@@ -444,11 +453,13 @@ then run `org-babel-switch-to-session'."
(colnames . ((nil no yes)))
(comments . ((no link yes org both noweb)))
(dir . :any)
- (eval . ((never query)))
+ (eval . ((yes no no-export strip-export never-export eval never
+ query)))
(exports . ((code results both none)))
(epilogue . :any)
(file . :any)
(file-desc . :any)
+ (file-ext . :any)
(hlines . ((no yes)))
(mkdirp . ((yes no)))
(no-expand)
@@ -456,6 +467,7 @@ then run `org-babel-switch-to-session'."
(noweb . ((yes no tangle no-export strip-export)))
(noweb-ref . :any)
(noweb-sep . :any)
+ (output-dir . :any)
(padline . ((yes no)))
(post . :any)
(prologue . :any)
@@ -478,14 +490,55 @@ then run `org-babel-switch-to-session'."
Note that individual languages may define their own language
specific header arguments as well.")
+(defconst org-babel-safe-header-args
+ '(:cache :colnames :comments :exports :epilogue :hlines :noeval
+ :noweb :noweb-ref :noweb-sep :padline :prologue :rownames
+ :sep :session :tangle :wrap
+ (:eval . ("never" "query"))
+ (:results . (lambda (str) (not (string-match "file" str)))))
+ "A list of safe header arguments for babel source blocks.
+
+The list can have entries of the following forms:
+- :ARG -> :ARG is always a safe header arg
+- (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is
+ `equal' to one of the VALs.
+- (:ARG . FN) -> :ARG is safe as a header arg if the function FN
+ returns non-nil. FN is passed one
+ argument, the value of the header arg
+ (as a string).")
+
+(defmacro org-babel-header-args-safe-fn (safe-list)
+ "Return a function that determines whether a list of header args are safe.
+
+Intended usage is:
+\(put 'org-babel-default-header-args 'safe-local-variable
+ (org-babel-header-args-safe-p org-babel-safe-header-args)
+
+This allows org-babel languages to extend the list of safe values for
+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
+ (lambda (pair)
+ (and (consp pair)
+ (org-babel-one-header-arg-safe-p pair ,safe-list)))
+ value))))
+
(defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code")
(:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
"Default arguments to use when evaluating a source block.")
+(put 'org-babel-default-header-args 'safe-local-variable
+ (org-babel-header-args-safe-fn org-babel-safe-header-args))
(defvar org-babel-default-inline-header-args
- '((:session . "none") (:results . "replace") (:exports . "results"))
+ '((:session . "none") (:results . "replace")
+ (:exports . "results") (:hlines . "yes"))
"Default arguments to use when evaluating an inline source block.")
+(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"))
@@ -512,11 +565,17 @@ block. Otherwise the output is marked as literal by inserting
colons at the starts of the lines. This variable only takes
effect if the :results output option is in effect.")
+(defvar org-babel-noweb-error-all-langs nil
+ "Raise errors when noweb references don't resolve.
+Also see `org-babel-noweb-error-langs' to control noweb errors on
+a language by language bases.")
+
(defvar org-babel-noweb-error-langs nil
"Languages for which Babel will raise literate programming errors.
List of languages for which errors should be raised when the
source code block satisfying a noweb reference in this language
-can not be resolved.")
+can not be resolved. Also see `org-babel-noweb-error-all-langs'
+to raise errors for all languages.")
(defvar org-babel-hash-show 4
"Number of initial characters to show of a hidden results hash.")
@@ -527,10 +586,15 @@ can not be resolved.")
(defvar org-babel-after-execute-hook nil
"Hook for functions to be called after `org-babel-execute-src-block'")
-(defun org-babel-named-src-block-regexp-for-name (name)
- "This generates a regexp used to match a src block named NAME."
- (concat org-babel-src-name-regexp (regexp-quote name)
- "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*"
+(defun org-babel-named-src-block-regexp-for-name (&optional name)
+ "This generates a regexp used to match a src block named NAME.
+If NAME is nil, match any name. Matched name is then put in
+match group 9. Other match groups are defined in
+`org-babel-src-block-regexp'."
+ (concat org-babel-src-name-regexp
+ (concat (if name (regexp-quote name) "\\(?9:.*?\\)") "[ \t]*" )
+ "\\(?:\n[ \t]*#\\+\\S-+:.*\\)*?"
+ "\n"
(substring org-babel-src-block-regexp 1)))
(defun org-babel-named-data-regexp-for-name (name)
@@ -566,7 +630,10 @@ block."
(let* ((org-babel-current-src-block-location
(or org-babel-current-src-block-location
(nth 6 info)
- (org-babel-where-is-src-block-head)))
+ (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)))
@@ -586,7 +653,8 @@ block."
(cache-current-p
(save-excursion ;; return cached result
(goto-char (org-babel-where-is-src-block-result nil info))
- (end-of-line 1) (forward-char 1)
+ (forward-line)
+ (skip-chars-forward " \t")
(let ((result (org-babel-read-result)))
(message (replace-regexp-in-string
"%" "%%" (format "%S" result))) result)))
@@ -709,8 +777,7 @@ arguments and pop open the results in a preview buffer."
(funcall assignments-cmd params))))))
(if (org-called-interactively-p 'any)
(org-edit-src-code
- nil expanded
- (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
+ expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
expanded)))
(defun org-babel-edit-distance (s1 s2)
@@ -770,37 +837,43 @@ arguments and pop open the results in a preview buffer."
(message "No suspicious header arguments found.")))
;;;###autoload
-(defun org-babel-insert-header-arg ()
+(defun org-babel-insert-header-arg (&optional header-arg value)
"Insert a header argument selecting from lists of common args and values."
(interactive)
- (let* ((lang (car (org-babel-get-src-block-info 'light)))
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (lang (car info))
+ (begin (nth 6 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))))
- (arg (org-icompleting-read
- "Header Arg: "
- (mapcar
- (lambda (header-spec) (symbol-name (car header-spec)))
- headers))))
- (insert ":" arg)
- (let ((vals (cdr (assoc (intern arg) headers))))
- (when vals
- (insert
- " "
- (cond
- ((eq vals :any)
- (read-from-minibuffer "value: "))
- ((listp vals)
- (mapconcat
- (lambda (group)
- (let ((arg (org-icompleting-read
- "value: "
- (cons "default" (mapcar #'symbol-name group)))))
- (if (and arg (not (string= "default" arg)))
- (concat arg " ")
- "")))
- vals ""))))))))
+ (header-arg (or header-arg
+ (org-icompleting-read
+ "Header Arg: "
+ (mapcar
+ (lambda (header-spec) (symbol-name (car header-spec)))
+ headers))))
+ (vals (cdr (assoc (intern header-arg) headers)))
+ (value (or value
+ (cond
+ ((eq vals :any)
+ (read-from-minibuffer "value: "))
+ ((listp vals)
+ (mapconcat
+ (lambda (group)
+ (let ((arg (org-icompleting-read
+ "Value: "
+ (cons "default"
+ (mapcar #'symbol-name group)))))
+ (if (and arg (not (string= "default" arg)))
+ (concat arg " ")
+ "")))
+ vals ""))))))
+ (save-excursion
+ (goto-char begin)
+ (goto-char (point-at-eol))
+ (unless (= (char-before (point)) ?\ ) (insert " "))
+ (insert ":" header-arg) (when value (insert " " value)))))
;; Add support for completing-read insertion of header arguments after ":"
(defun org-babel-header-arg-expand ()
@@ -912,15 +985,15 @@ with a prefix argument then this is passed on to
(org-edit-src-code)
(funcall swap-windows)))
+;;;###autoload
(defmacro org-babel-do-in-edit-buffer (&rest body)
"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."
`(let ((org-src-window-setup 'switch-invisibly))
(when (and (org-babel-where-is-src-block-head)
- (org-edit-src-code nil nil nil))
+ (org-edit-src-code))
(unwind-protect (progn ,@body)
- (if (org-bound-and-true-p org-edit-src-from-org-mode)
- (org-edit-src-exit)))
+ (org-edit-src-exit))
t)))
(def-edebug-spec org-babel-do-in-edit-buffer (body))
@@ -941,7 +1014,7 @@ evaluation mechanisms."
(defvar org-bracket-link-regexp)
(defun org-babel-active-location-p ()
- (memq (car (save-match-data (org-element-context)))
+ (memq (org-element-type (save-match-data (org-element-context)))
'(babel-call inline-babel-call inline-src-block src-block)))
;;;###autoload
@@ -995,7 +1068,8 @@ beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body"
(declare (indent 1))
(let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
+ `(let* ((case-fold-search t)
+ (,tempvar ,file)
(visited-p (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
(point (point)) to-be-removed)
@@ -1034,7 +1108,8 @@ If FILE is nil evaluate BODY forms on source blocks in current
buffer."
(declare (indent 1))
(let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
+ `(let* ((case-fold-search t)
+ (,tempvar ,file)
(visited-p (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
(point (point)) to-be-removed)
@@ -1158,7 +1233,20 @@ the current subtree."
(member (car arg) '(:results :exports)))
(mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " "))
- (t v)))))))
+ (t v))))))
+ ;; expanded body
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (body (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info) (nth 1 info)))
+ (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
+ (assignments-cmd (intern (concat "org-babel-variable-assignments:"
+ lang)))
+ (expanded
+ (if (fboundp expand-cmd) (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params))))))
(let* ((it (format "%s-%s"
(mapconcat
#'identity
@@ -1167,19 +1255,19 @@ the current subtree."
(when normalized
(format "%S" normalized))))
(nth 2 info))) ":")
- (nth 1 info)))
+ expanded))
(hash (sha1 it)))
(when (org-called-interactively-p 'interactive) (message hash))
hash))))
-(defun org-babel-current-result-hash ()
+(defun org-babel-current-result-hash (&optional info)
"Return the current in-buffer hash."
- (org-babel-where-is-src-block-result)
+ (org-babel-where-is-src-block-result nil info)
(org-no-properties (match-string 5)))
-(defun org-babel-set-current-result-hash (hash)
+(defun org-babel-set-current-result-hash (hash info)
"Set the current in-buffer hash to HASH."
- (org-babel-where-is-src-block-result)
+ (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)
@@ -1321,33 +1409,31 @@ specified in the properties of the current outline entry."
(save-match-data
(list
;; DEPRECATED header arguments specified as separate property at
- ;; point of definition
- (let (val sym)
- (org-babel-parse-multiple-vars
- (delq nil
- (mapcar
- (lambda (header-arg)
- (and (setq val (org-entry-get (point) header-arg t))
- (cons (intern (concat ":" header-arg))
- (org-babel-read val))))
- (mapcar
- #'symbol-name
- (mapcar
- #'car
- (org-babel-combine-header-arg-lists
- org-babel-common-header-args-w-values
- (progn
- (setq sym (intern (concat "org-babel-header-args:" lang)))
- (and (boundp sym) (eval sym))))))))))
+ ;; 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
+ ;; point of call.
(org-babel-parse-header-arguments
(org-entry-get org-babel-current-src-block-location
- "header-args" 'inherit))
- (when lang ;; language-specific header arguments at point of call
- (org-babel-parse-header-arguments
- (org-entry-get org-babel-current-src-block-location
- (concat "header-args:" lang) 'inherit))))))
+ "header-args"
+ 'inherit))
+ (and lang ; language-specific header arguments at point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ (concat "header-args:" lang)
+ 'inherit))))))
(defvar org-src-preserve-indentation) ;; declare defcustom from org-src
(defun org-babel-parse-src-block-match ()
@@ -1395,7 +1481,8 @@ specified in the properties of the current outline entry."
(append
(org-babel-params-from-properties lang)
(list (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) "")))))))))
+ (org-no-properties (or (match-string 4) ""))))))
+ nil)))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
@@ -1512,7 +1599,7 @@ shown below.
;; row and column names
(defun org-babel-del-hlines (table)
"Remove all 'hlines from TABLE."
- (remove 'hline table))
+ (remq 'hline table))
(defun org-babel-get-colnames (table)
"Return the column names of TABLE.
@@ -1608,33 +1695,20 @@ to the table for reinsertion to org-mode."
(defun org-babel-where-is-src-block-head ()
"Find where the current source block begins.
-Return the point at the beginning of the current source
-block. Specifically at the beginning of the #+BEGIN_SRC line.
+Return the point at the beginning of the current source block.
+Specifically at the beginning of the #+BEGIN_SRC line. Also set
+match-data relatively to `org-babel-src-block-regexp', which see.
If the point is not on a source block then return nil."
- (let ((initial (point)) (case-fold-search t) top bottom)
- (or
- (save-excursion ;; on a source name line or a #+header line
- (beginning-of-line 1)
- (and (or (looking-at org-babel-src-name-regexp)
- (looking-at org-babel-multi-line-header-regexp))
- (progn
- (while (and (forward-line 1)
- (or (looking-at org-babel-src-name-regexp)
- (looking-at org-babel-multi-line-header-regexp))))
- (looking-at org-babel-src-block-regexp))
- (point)))
- (save-excursion ;; on a #+begin_src line
- (beginning-of-line 1)
- (and (looking-at org-babel-src-block-regexp)
- (point)))
- (save-excursion ;; inside a src block
- (and
- (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point))
- (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point))
- (< top initial) (< initial bottom)
- (progn (goto-char top) (beginning-of-line 1)
- (looking-at org-babel-src-block-regexp))
- (point-marker))))))
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'src-block)
+ (let ((end (org-element-property :end element)))
+ (org-with-wide-buffer
+ ;; Ensure point is not on a blank line after the block.
+ (beginning-of-line)
+ (skip-chars-forward " \r\t\n" end)
+ (when (< (point) end)
+ (prog1 (goto-char (org-element-property :post-affiliated element))
+ (looking-at org-babel-src-block-regexp))))))))
;;;###autoload
(defun org-babel-goto-src-block-head ()
@@ -1682,23 +1756,22 @@ If the point is not on a source block then return nil."
(defun org-babel-find-named-block (name)
"Find a named source-code block.
Return the location of the source block identified by source
-NAME, or nil if no such block exists. Set match data according to
-org-babel-named-src-block-regexp."
+NAME, or nil if no such block exists. Set match data according
+to `org-babel-named-src-block-regexp'."
(save-excursion
- (let ((case-fold-search t)
- (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
- (goto-char (point-min))
- (when (or (re-search-forward regexp nil t)
- (re-search-backward regexp nil t))
- (match-beginning 0)))))
+ (goto-char (point-min))
+ (ignore-errors
+ (org-next-block 1 nil (org-babel-named-src-block-regexp-for-name name)))))
(defun org-babel-src-block-names (&optional file)
"Returns the names of source blocks in FILE or the current buffer."
+ (when file (find-file file))
(save-excursion
- (when file (find-file file)) (goto-char (point-min))
- (let ((case-fold-search t) names)
- (while (re-search-forward org-babel-src-name-w-name-regexp nil t)
- (setq names (cons (match-string 3) names)))
+ (goto-char (point-min))
+ (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))
names)))
;;;###autoload
@@ -1777,10 +1850,14 @@ split. When called from outside of a code block a new code block
is created. In both cases if the region is demarcated and if the
region is not active then the point is demarcated."
(interactive "P")
- (let ((info (org-babel-get-src-block-info 'light))
- (headers (progn (org-babel-where-is-src-block-head)
- (match-string 4)))
- (stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (start (org-babel-where-is-src-block-head))
+ (block (and start (match-string 0)))
+ (headers (and start (match-string 4)))
+ (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)))))
(if info
(mapc
(lambda (place)
@@ -1794,9 +1871,10 @@ region is not active then the point is demarcated."
(delete-region (point-at-bol) (point-at-eol)))
(insert (concat
(if (looking-at "^") "" "\n")
- indent "#+end_src\n"
+ indent (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n")
(if arg stars indent) "\n"
- indent "#+begin_src " lang
+ indent (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ")
+ lang
(if (> (length headers) 1)
(concat " " headers) headers)
(if (looking-at "[\n\r]")
@@ -1816,11 +1894,12 @@ region is not active then the point is demarcated."
(if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
(if arg (concat stars "\n") "")
- "#+begin_src " lang "\n"
+ (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ")
+ lang "\n"
body
(if (or (= (length body) 0)
(string-match "[\r\n]$" body)) "" "\n")
- "#+end_src\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)
@@ -1865,26 +1944,30 @@ following the source block."
(progn (end-of-line 1)
(if (eobp) (insert "\n") (forward-char 1))
(setq end (point))
- (or (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))
- ((looking-at "^[ \t]*#") (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)))
- (prog1 nil
- (forward-line 1)
- (delete-region
- end (org-babel-result-end)))
- (setq end nil)))))))))))
+ (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
@@ -1912,7 +1995,7 @@ following the source block."
((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-babel-trim (match-string 4)))
+ ((looking-at org-block-regexp) (org-remove-indentation (match-string 4)))
((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$"))
(setq result-string
(org-babel-trim
@@ -1969,23 +2052,29 @@ If the path of the link is a file path it is expanded using
(funcall echo-res result))))
(defun org-babel-insert-result
- (result &optional result-params info hash indent lang)
+ (result &optional result-params info hash indent lang)
"Insert RESULT into the current buffer.
-By default RESULT is inserted after the end of the
-current source block. With optional argument RESULT-PARAMS
-controls insertion of results in the org-mode file.
-RESULT-PARAMS can take the following values:
+
+By default RESULT is inserted after the end of the current source
+block. The RESULT of an inline source block usually will be
+wrapped inside a `results' macro and placed on the same line as
+the inline source block. The macro is stripped upon export.
+Multiline and non-scalar RESULTS from inline source blocks are
+not allowed. With optional argument RESULT-PARAMS controls
+insertion of results in the Org mode file. RESULT-PARAMS can
+take the following values:
replace - (default option) insert results after the source block
- replacing any previously inserted results
+ or inline source block replacing any previously
+ inserted results.
silent -- no results are inserted into the Org-mode buffer but
the results are echoed to the minibuffer and are
ingested by Emacs (a potentially time consuming
- process)
+ 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-mode file syntax.
list ---- the results are interpreted as an Org-mode list.
@@ -1994,26 +2083,49 @@ raw ----- results are added directly to the Org-mode file. This
formatted text.
drawer -- results are added directly to the Org-mode file as with
- \"raw\", but are wrapped in a RESULTS drawer, allowing
- them to later be replaced or removed automatically.
+ \"raw\", but are wrapped in a RESULTS drawer or results
+ macro, allowing them to later be replaced or removed
+ automatically.
+
+org ----- results are added inside of a \"src_org{}\" or \"#+BEGIN_SRC
+ org\" block depending on whether the current source block is
+ inline or not. They are not comma-escaped when inserted,
+ 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
+ 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.
-org ----- results are added inside of a \"#+BEGIN_SRC org\" block.
- They are not comma-escaped when inserted, but Org syntax
- here will be discarded when exporting the file.
+code ---- the results are extracted in the syntax of the source
+ code of the language being evaluated and are added
+ inside of a source block with the source-code language
+ set appropriately. Also, source block inlining is
+ preserved in this case. Note this relies on the
+ optional LANG argument.
-html ---- results are added inside of a #+BEGIN_HTML block. This
- is a good option if you code block will output html
- formatted text.
+list ---- the results are rendered as a list. This option not
+ allowed for inline src blocks.
-latex --- results are added inside of a #+BEGIN_LATEX block.
- This is a good option if you code block will output
- latex formatted text.
+table --- the results are rendered as a table. This option not
+ allowed for inline src blocks.
+
+INFO may provide the values of these header arguments (in the
+`header-arguments-alist' see the docstring for
+`org-babel-get-src-block-info'):
+
+:file --- the name of the file to which output should be written.
+
+:wrap --- the effect is similar to `latex' in RESULT-PARAMS but
+ using the argument supplied to specify the export block
+ or snippet type."
-code ---- the results are extracted in the syntax of the source
- code of the language being evaluated and are added
- inside of a #+BEGIN_SRC block with the source-code
- language set appropriately. Note this relies on the
- optional LANG argument."
(if (stringp result)
(progn
(setq result (org-no-properties result))
@@ -2033,15 +2145,23 @@ code ---- the results are extracted in the syntax of the source
(when (or (org-babel-get-inline-src-block-matches)
(org-babel-get-lob-one-liner-matches))
(goto-char (match-end 0))
- (insert (if (listp result) "\n" " "))
+ (org-babel-remove-inline-result)
+ (insert " ")
(point))))
- (existing-result (unless inlinep
- (org-babel-where-is-src-block-result
- t info hash indent)))
+ (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 (copy-marker (point-min)))
- (visible-end (copy-marker (point-max)))
+ (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.
@@ -2074,18 +2194,37 @@ code ---- the results are extracted in the syntax of the source
((member "prepend" result-params)))) ; already there
(setq results-switches
(if results-switches (concat " " results-switches) ""))
- (let ((wrap (lambda (start finish &optional no-escape)
- (goto-char end) (insert (concat finish "\n"))
- (goto-char beg) (insert (concat start "\n"))
+ (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) (goto-char (point-at-eol))
+ (goto-char end)
+ (unless no-newlines (goto-char (point-at-eol)))
(setq end (point-marker))))
- (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
+ (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
+ ;; 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
@@ -2097,51 +2236,78 @@ code ---- the results are extracted in the syntax of the source
(if (listp result) result (split-string result "\n" t))))
'(:splicep nil :istart "- " :iend "\n")))
"\n"))
- ;; assume the result is a table if it's not a string
- ((funcall proper-list-p result)
+ ;; 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 (el) (or (listp el) (eq el 'hline)))
+ (lambda (e)
+ (or (eq e 'hline) (listp e)))
result)
- result (list result))
- '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
- (goto-char beg) (when (org-at-table-p) (org-table-align)))
- ((and (listp result) (not (funcall proper-list-p result)))
- (insert (format "%s\n" 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))
+ (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)))
- (when (funcall proper-list-p result) (goto-char (org-table-end)))
(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))))))
+ (concat "#+END_" (car (org-split-string name)))
+ nil nil (concat "{{{results(@@" name ":") "@@)}}}")))
((member "html" result-params)
- (funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
+ (funcall wrap "#+BEGIN_HTML" "#+END_HTML" nil nil
+ "{{{results(@@html:" "@@)}}}"))
((member "latex" result-params)
- (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
+ (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"))
+ (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil
+ "{{{results(src_org{" "})}}}"))
((member "code" result-params)
- (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
- "#+END_SRC"))
+ (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))
- ((and (not (funcall proper-list-p result))
+ (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)))
- (org-babel-examplize-region beg end results-switches)
- (setq end (point)))))
+ (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
@@ -2157,15 +2323,44 @@ code ---- the results are extracted in the syntax of the source
(set-marker visible-beg nil)
(set-marker visible-end nil))))))
-(defun org-babel-remove-result (&optional info)
+(defun org-babel-remove-result (&optional info keep-keyword)
"Remove the result of the current source block."
(interactive)
- (let ((location (org-babel-where-is-src-block-result nil info)) start)
+ (let ((location (org-babel-where-is-src-block-result nil info)))
(when location
- (setq start (- location 1))
(save-excursion
- (goto-char location) (forward-line 1)
- (delete-region start (org-babel-result-end))))))
+ (goto-char location)
+ (when (looking-at (concat org-babel-result-regexp ".*$"))
+ (delete-region
+ (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 ()
+ "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."
+ (interactive)
+ (let* ((el (org-element-context))
+ (post-blank (org-element-property :post-blank el)))
+ (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)))))))))
+
+(defun org-babel-remove-result-one-or-many (x)
+ "Remove the result of the current source block.
+If called with a prefix argument, remove all result blocks
+in the buffer."
+ (interactive "P")
+ (if x
+ (org-babel-map-src-blocks nil (org-babel-remove-result))
+ (org-babel-remove-result)))
(defun org-babel-result-end ()
"Return the point at the end of the current set of results."
@@ -2203,18 +2398,27 @@ file's directory then expand relative links."
result)
(if description (concat "[" description "]") ""))))
-(defvar org-babel-capitalize-examplize-region-markers nil
+(defvar org-babel-capitalize-example-region-markers nil
"Make true to capitalize begin/end example markers inserted by code blocks.")
-(defun org-babel-examplize-region (beg end &optional results-switches)
+(define-obsolete-function-alias
+ 'org-babel-examplize-region
+ 'org-babel-examplify-region "25.1")
+
+(defun org-babel-examplify-region (beg end &optional results-switches)
"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-examplize-region-markers
- (upcase str) str))))
- (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
- (funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
+ (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)))
(save-excursion
(goto-char beg)
(insert (format org-babel-inline-result-wrap
@@ -2242,7 +2446,8 @@ file's directory then expand relative links."
(if (not (org-babel-where-is-src-block-head))
(error "Not in a source block")
(save-match-data
- (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5))
+ (replace-match (concat (org-babel-trim (org-remove-indentation new-body))
+ "\n") nil t nil 5))
(indent-rigidly (match-beginning 5) (match-end 5) 2)))
(defun org-babel-merge-params (&rest plists)
@@ -2331,6 +2536,16 @@ parameters when merging lists."
(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 (cdr pair)))))
@@ -2523,7 +2738,8 @@ block but are passed literally to the \"example-block\"."
(and expansion
(mapconcat #'identity (nreverse (cdr expansion)) "")))
;; Possibly raise an error if named block doesn't exist.
- (if (member lang org-babel-noweb-error-langs)
+ (if (or org-babel-noweb-error-all-langs
+ (member lang org-babel-noweb-error-langs))
(error "%s" (concat
(org-babel-noweb-wrap source-name)
"could not be resolved (see "
@@ -2533,60 +2749,106 @@ block but are passed literally to the \"example-block\"."
(funcall nb-add (buffer-substring index (point-max))))
new-body))
+(defun org-babel--script-escape-inner (str)
+ (let (in-single in-double backslash out)
+ (mapc
+ (lambda (ch)
+ (setq
+ out
+ (if backslash
+ (progn
+ (setq backslash nil)
+ (cond
+ ((and in-single (eq ch ?'))
+ ;; Escaped single quote inside single quoted string:
+ ;; emit just a single quote, since we've changed the
+ ;; outer quotes to double.
+ (cons ch out))
+ ((eq ch ?\")
+ ;; Escaped double quote
+ (if in-single
+ ;; This should be interpreted as backslash+quote,
+ ;; not an escape. Emit a three backslashes
+ ;; followed by a quote (because one layer of
+ ;; quoting will be stripped by `org-babel-read').
+ (append (list ch ?\\ ?\\ ?\\) out)
+ ;; Otherwise we are in a double-quoted string. Emit
+ ;; a single escaped quote
+ (append (list ch ?\\) out)))
+ ((eq ch ?\\)
+ ;; Escaped backslash: emit a single escaped backslash
+ (append (list ?\\ ?\\) out))
+ ;; Other: emit a quoted backslash followed by whatever
+ ;; the character was (because one layer of quoting will
+ ;; be stripped by `org-babel-read').
+ (t (append (list ch ?\\ ?\\) out))))
+ (case ch
+ (?\[ (if (or in-double in-single)
+ (cons ?\[ out)
+ (cons ?\( out)))
+ (?\] (if (or in-double in-single)
+ (cons ?\] out)
+ (cons ?\) out)))
+ (?\{ (if (or in-double in-single)
+ (cons ?\{ out)
+ (cons ?\( out)))
+ (?\} (if (or in-double in-single)
+ (cons ?\} out)
+ (cons ?\) out)))
+ (?, (if (or in-double in-single)
+ (cons ?, out) (cons ?\s out)))
+ (?\' (if in-double
+ (cons ?\' out)
+ (setq in-single (not in-single)) (cons ?\" out)))
+ (?\" (if in-single
+ (append (list ?\" ?\\) out)
+ (setq in-double (not in-double)) (cons ?\" out)))
+ (?\\ (unless (or in-single in-double)
+ (error "Can't handle backslash outside string in `org-babel-script-escape'"))
+ (setq backslash t)
+ out)
+ (t (cons ch out))))))
+ (string-to-list str))
+ (when (or in-single in-double)
+ (error "Unterminated string in `org-babel-script-escape'"))
+ (apply #'string (reverse out))))
+
(defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists."
+ (unless (stringp str)
+ (error "`org-babel-script-escape' expects a string"))
(let ((escaped
- (if (or force
- (and (stringp str)
- (> (length str) 2)
- (or (and (string-equal "[" (substring str 0 1))
- (string-equal "]" (substring str -1)))
- (and (string-equal "{" (substring str 0 1))
- (string-equal "}" (substring str -1)))
- (and (string-equal "(" (substring str 0 1))
- (string-equal ")" (substring str -1))))))
- (org-babel-read
- (concat
- "'"
- (let (in-single in-double out)
- (mapc
- (lambda (ch)
- (setq
- out
- (case ch
- (91 (if (or in-double in-single) ; [
- (cons 91 out)
- (cons 40 out)))
- (93 (if (or in-double in-single) ; ]
- (cons 93 out)
- (cons 41 out)))
- (123 (if (or in-double in-single) ; {
- (cons 123 out)
- (cons 40 out)))
- (125 (if (or in-double in-single) ; }
- (cons 125 out)
- (cons 41 out)))
- (44 (if (or in-double in-single) ; ,
- (cons 44 out) (cons 32 out)))
- (39 (if in-double ; '
- (cons 39 out)
- (setq in-single (not in-single)) (cons 34 out)))
- (34 (if in-single ; "
- (append (list 34 32) out)
- (setq in-double (not in-double)) (cons 34 out)))
- (t (cons ch out)))))
- (string-to-list str))
- (apply #'string (reverse out)))))
- str)))
+ (cond
+ ((and (> (length str) 2)
+ (or (and (string-equal "[" (substring str 0 1))
+ (string-equal "]" (substring str -1)))
+ (and (string-equal "{" (substring str 0 1))
+ (string-equal "}" (substring str -1)))
+ (and (string-equal "(" (substring str 0 1))
+ (string-equal ")" (substring str -1)))))
+
+ (concat "'" (org-babel--script-escape-inner str)))
+ ((or force
+ (and (> (length str) 2)
+ (or (and (string-equal "'" (substring str 0 1))
+ (string-equal "'" (substring str -1)))
+ ;; We need to pass double-quoted strings
+ ;; through the backslash-twiddling bits, even
+ ;; though we don't need to change their
+ ;; delimiters.
+ (and (string-equal "\"" (substring str 0 1))
+ (string-equal "\"" (substring str -1))))))
+ (org-babel--script-escape-inner str))
+ (t str))))
(condition-case nil (org-babel-read escaped) (error escaped))))
(defun org-babel-read (cell &optional inhibit-lisp-eval)
"Convert the string value of CELL to a number if appropriate.
-Otherwise if cell looks like lisp (meaning it starts with a
-\"(\", \"'\", \"`\" or a \"[\") then read it as lisp,
-otherwise return it unmodified as a string. Optional argument
-NO-LISP-EVAL inhibits lisp evaluation for situations in which is
-it not appropriate."
+Otherwise if CELL looks like lisp (meaning it starts with a
+\"(\", \"'\", \"\\=`\" or a \"[\") then read and evaluate it as
+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)
(if (and (not inhibit-lisp-eval)
@@ -2637,9 +2899,9 @@ If the table is trivial, then return it as a scalar."
cell) t))
(defun org-babel-chomp (string &optional regexp)
- "Strip trailing spaces and carriage returns from STRING.
-Default regexp used is \"[ \f\t\n\r\v]\" but can be
-overwritten by specifying a regexp as a second argument."
+ "Strip a trailing space or carriage return from STRING.
+The default regexp used is \"[ \\f\\t\\n\\r\\v]\" but another one
+can be specified as the REGEXP argument."
(let ((regexp (or regexp "[ \f\t\n\r\v]")))
(while (and (> (length string) 0)
(string-match regexp (substring string -1)))
@@ -2647,12 +2909,12 @@ overwritten by specifying a regexp as a second argument."
string))
(defun org-babel-trim (string &optional regexp)
- "Strip leading and trailing spaces and carriage returns from STRING.
-Like `org-babel-chomp' only it runs on both the front and back
-of the string."
- (org-babel-chomp (org-reverse-string
- (org-babel-chomp (org-reverse-string string) regexp))
- 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)
@@ -2675,11 +2937,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
(defun org-babel-local-file-name (file)
"Return the local name component of FILE."
- (if (file-remote-p file)
- (let (localname)
- (with-parsed-tramp-file-name file nil
- localname))
- file))
+ (or (file-remote-p file 'localname) file))
(defun org-babel-process-file-name (name &optional no-quote-p)
"Prepare NAME to be used in an external process.
@@ -2688,7 +2946,7 @@ name is removed, since in that case the process will be executing
remotely. The file name is then processed by `expand-file-name'.
Unless second argument NO-QUOTE-P is non-nil, the file name is
additionally processed by `shell-quote-argument'"
- (let ((f (expand-file-name (org-babel-local-file-name name))))
+ (let ((f (org-babel-local-file-name (expand-file-name name))))
(if no-quote-p f (shell-quote-argument f))))
(defvar org-babel-temporary-directory)
@@ -2702,6 +2960,11 @@ additionally processed by `shell-quote-argument'"
Used by `org-babel-temp-file'. This directory will be removed on
Emacs shutdown."))
+(defcustom org-babel-remote-temporary-directory "/tmp/"
+ "Directory to hold temporary files on remote hosts."
+ :group 'org-babel
+ :type 'string)
+
(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms)
"Call the code to parse raw string results according to RESULT-PARAMS."
(declare (indent 1)
@@ -2714,6 +2977,7 @@ Emacs shutdown."))
(member "html" ,params)
(member "code" ,params)
(member "pp" ,params)
+ (member "file" ,params)
(and (or (member "output" ,params)
(member "raw" ,params)
(member "org" ,params)
@@ -2731,7 +2995,8 @@ of `org-babel-temporary-directory'."
(if (file-remote-p default-directory)
(let ((prefix
(concat (file-remote-p default-directory)
- (expand-file-name prefix temporary-file-directory))))
+ (expand-file-name
+ prefix org-babel-remote-temporary-directory))))
(make-temp-file prefix nil suffix))
(let ((temporary-file-directory
(or (and (boundp 'org-babel-temporary-directory)
@@ -2766,6 +3031,69 @@ of `org-babel-temporary-directory'."
(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)
+(defun org-babel-one-header-arg-safe-p (pair safe-list)
+ "Determine if the PAIR is a safe babel header arg according to SAFE-LIST.
+
+For the format of SAFE-LIST, see `org-babel-safe-header-args'."
+ (and (consp pair)
+ (keywordp (car pair))
+ (stringp (cdr pair))
+ (or
+ (memq (car pair) safe-list)
+ (let ((entry (assq (car pair) safe-list)))
+ (and entry
+ (consp entry)
+ (cond ((functionp (cdr entry))
+ (funcall (cdr entry) (cdr pair)))
+ ((listp (cdr entry))
+ (member (cdr pair) (cdr entry)))
+ (t nil)))))))
+
+(defun org-babel-generate-file-param (src-name params)
+ "Calculate the filename for source block results.
+
+The directory is calculated from the :output-dir property of the
+source block; if not specified, use the current directory.
+
+If the source block has a #+NAME and the :file parameter does not
+contain any period characters, then the :file parameter is
+treated as an extension, and the output file name is the
+concatenation of the directory (as calculated above), the block
+name, a period, and the parameter value as a file extension.
+Otherwise, the :file parameter is treated as a full file name,
+and the output file name is the directory (as calculated above)
+plus the parameter value."
+ (let* ((file-cons (assq :file params))
+ (file-ext-cons (assq :file-ext params))
+ (file-ext (cdr-safe file-ext-cons))
+ (dir (cdr-safe (assq :output-dir params)))
+ fname)
+ ;; create the output-dir if it does not exist
+ (when dir
+ (make-directory dir t))
+ (if file-cons
+ ;; :file given; add :output-dir if given
+ (when dir
+ (setcdr file-cons (concat (file-name-as-directory dir) (cdr file-cons))))
+ ;; :file not given; compute from name and :file-ext if possible
+ (when (and src-name file-ext)
+ (if dir
+ (setq fname (concat (file-name-as-directory (or dir ""))
+ src-name "." file-ext))
+ (setq fname (concat src-name "." file-ext)))
+ (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))))
+
(provide 'ob-core)
;; Local variables:
diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el
index 26f0e4f..888cafc 100644
--- a/lisp/ob-ditaa.el
+++ b/lisp/ob-ditaa.el
@@ -90,6 +90,14 @@ This function is called by `org-babel-execute-src-block'."
(java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-"))
(eps (cdr (assoc :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))))
+ (concat
+ "epstopdf"
+ " " eps-file
+ " -o=" (org-babel-process-file-name out-file))))
(cmd (concat org-babel-ditaa-java-cmd
" " java " " org-ditaa-jar-option " "
(shell-quote-argument
@@ -97,13 +105,9 @@ This function is called by `org-babel-execute-src-block'."
(if eps org-ditaa-eps-jar-path org-ditaa-jar-path)))
" " cmdline
" " (org-babel-process-file-name in-file)
- " " (org-babel-process-file-name out-file)))
- (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf")
- (cdr (assoc :pdf params))))
- (concat
- "epstopdf"
- " " (org-babel-process-file-name (concat in-file ".eps"))
- " -o=" (org-babel-process-file-name out-file)))))
+ " " (if pdf-cmd
+ eps-file
+ (org-babel-process-file-name out-file)))))
(unless (file-exists-p org-ditaa-jar-path)
(error "Could not find ditaa.jar at %s" org-ditaa-jar-path))
(with-temp-file in-file (insert body))
diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el
index b35d7bb..1e399e7 100644
--- a/lisp/ob-dot.el
+++ b/lisp/ob-dot.el
@@ -55,7 +55,9 @@
(replace-regexp-in-string
(concat "\$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
- body))))
+ body
+ t
+ t))))
vars)
body))
diff --git a/lisp/ob-ebnf.el b/lisp/ob-ebnf.el
new file mode 100644
index 0000000..8c98d30
--- /dev/null
+++ b/lisp/ob-ebnf.el
@@ -0,0 +1,85 @@
+;;; ob-ebnf.el --- org-babel functions for ebnf evaluation
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: Michael Gauland
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+;; Version: 1.00
+
+;;; License:
+
+;; 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, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;;; Org-Babel support for using ebnf2ps to generate encapsulated postscript
+;;; railroad diagrams. It recogises these arguments:
+;;;
+;;; :file is required; it must include the extension '.eps.' All the rules
+;;; in the block will be drawn in the same file. This is done by
+;;; inserting a '[<file>' comment at the start of the block (see the
+;;; documentation for ebnf-eps-buffer for more information).
+;;;
+;;; :style specifies a value in ebnf-style-database. This provides the
+;;; ability to customise the output. The style can also specify the
+;;; grammar syntax (by setting ebnf-syntax); note that only ebnf,
+;;; iso-ebnf, and yacc are supported by this file.
+
+;;; Requirements:
+
+;;; Code:
+(require 'ob)
+(require 'ebnf2ps)
+
+;; optionally declare default header arguments for this language
+(defvar org-babel-default-header-args:ebnf '((:style . nil)))
+
+;; Use ebnf-eps-buffer to produce an encapsulated postscript file.
+;;
+(defun org-babel-execute:ebnf (body params)
+ "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)))
+ (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)
+ (result nil))
+ (with-temp-buffer
+ (when style (ebnf-push-style style))
+ (let ((comment-format
+ (cond ((string= ebnf-syntax 'yacc) "/*%s*/")
+ ((string= ebnf-syntax 'ebnf) ";%s")
+ ((string= ebnf-syntax 'iso-ebnf) "(*%s*)")
+ (t (setq result
+ (format "EBNF error: format %s not supported."
+ ebnf-syntax))))))
+ (setq ebnf-eps-prefix dest-dir)
+ (insert (format comment-format (format "[%s" dest-root)))
+ (newline)
+ (insert body)
+ (newline)
+ (insert (format comment-format (format "]%s" dest-root)))
+ (ebnf-eps-buffer)
+ (when style (ebnf-pop-style))))
+ result)))
+
+(provide 'ob-ebnf)
+;;; ob-ebnf.el ends here
diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el
index 3219344..f9f3671 100644
--- a/lisp/ob-emacs-lisp.el
+++ b/lisp/ob-emacs-lisp.el
@@ -28,12 +28,9 @@
;;; Code:
(require 'ob)
-(defvar org-babel-default-header-args:emacs-lisp
- '((:hlines . "yes") (:colnames . "no"))
+(defvar org-babel-default-header-args:emacs-lisp nil
"Default arguments for evaluating an emacs-lisp source block.")
-(declare-function orgtbl-to-generic "org-table" (table params))
-
(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)))
diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el
index 057590f..b3ce2af 100644
--- a/lisp/ob-eval.el
+++ b/lisp/ob-eval.el
@@ -57,6 +57,13 @@ STDERR with `org-babel-eval-error-notify'."
(progn
(with-current-buffer err-buff
(org-babel-eval-error-notify exit-code (buffer-string)))
+ (save-excursion
+ (when (get-buffer org-babel-error-buffer-name)
+ (with-current-buffer org-babel-error-buffer-name
+ (unless (derived-mode-p 'compilation-mode)
+ (compilation-mode))
+ ;; Compilation-mode enforces read-only, but Babel expects the buffer modifiable.
+ (setq buffer-read-only nil))))
nil)
(buffer-string)))))
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 761c9f1..9707141 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -28,7 +28,6 @@
(eval-when-compile
(require 'cl))
-(defvar org-current-export-file)
(defvar org-babel-lob-one-liner-regexp)
(defvar org-babel-ref-split-regexp)
(defvar org-list-forbidden-blocks)
@@ -39,15 +38,17 @@
(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 type avoid-pos stealth))
+(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-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-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))
(defcustom org-export-babel-evaluate t
@@ -62,35 +63,35 @@ be executed."
(const :tag "Always" t)))
(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
-(defun org-babel-exp-get-export-buffer ()
- "Return the current export buffer if possible."
- (cond
- ((bufferp org-current-export-file) org-current-export-file)
- (org-current-export-file (get-file-buffer org-current-export-file))
- ('otherwise
- (error "Requested export buffer when `org-current-export-file' is 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 (nth 4 (ignore-errors (org-heading-components))))
+ (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))
- (original-buffer (org-babel-exp-get-export-buffer)) results)
- (when original-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 original-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
+ (when heading-query
(condition-case nil
(let ((org-link-search-inhibit-query t))
- (org-link-search heading))
- (error (when heading
+ ;; 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) nil t)))))
+ (re-search-forward (regexp-quote heading-query) nil t)))))
(setq results ,@body))
(set-buffer export-buffer)
results)))
@@ -113,12 +114,14 @@ none ---- do not display either code or results upon export
Assume point is at the beginning of block's starting line."
(interactive)
- (unless noninteractive (message "org-babel-exp processing..."))
(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)
;; bail if we couldn't get any info from the block
+ (unless noninteractive
+ (message "org-babel-exp process %s at line %d..." lang line))
(when info
;; if we're actually going to need the parameters
(when (member (cdr (assoc :exports (nth 2 info))) '("both" "results"))
@@ -151,138 +154,152 @@ this template."
:type 'string)
(defvar org-babel-default-lob-header-args)
-(defun org-babel-exp-process-buffer ()
- "Execute all Babel blocks in current buffer."
+(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."
(interactive)
(save-window-excursion
(save-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)
- (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* ((info (org-babel-parse-inline-src-block-match))
- (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-get-export-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 src
- ;; 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.
+ (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)
- (delete-region begin end)
- (insert rep))))
- (src-block
- (let* ((match-start (copy-marker (match-beginning 0)))
- (ind (org-get-indentation))
- (headers
- (cons
- (org-element-property :language element)
- (let ((params (org-element-property :parameters
- element)))
- (and params (org-split-string params "[ \t]+"))))))
- ;; 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)))))))
+ (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.
@@ -303,13 +320,15 @@ 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)))))
- (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info)))))
+ (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))
+ ('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)))))
+ (org-babel-exp-code info type)))))
(defcustom org-babel-exp-code-template
"#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
@@ -331,7 +350,29 @@ replaced with its value."
:group 'org-babel
:type 'string)
-(defun org-babel-exp-code (info)
+(defcustom org-babel-exp-inline-code-template
+ "src_%lang[%switches%flags]{%body}"
+ "Template used to export the body of inline code blocks.
+This template may be customized to include additional information
+such as the code block name, or the values of particular header
+arguments. The template is filled out using `org-fill-template',
+and the following %keys may be used.
+
+ lang ------ the language of the code block
+ name ------ the name of the code block
+ body ------ the body of the code block
+ switches -- the switches associated to the code block
+ flags ----- the flags passed to the code block
+
+In addition to the keys mentioned above, every header argument
+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"
+ :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))))
@@ -339,10 +380,12 @@ replaced with its value."
(org-babel-noweb-wrap) "" (nth 1 info))
(if (org-babel-noweb-p (nth 2 info) :export)
(org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
+ info org-babel-exp-reference-buffer)
(nth 1 info))))
(org-fill-template
- org-babel-exp-code-template
+ (if (eq type 'inline)
+ org-babel-exp-inline-code-template
+ org-babel-exp-code-template)
`(("lang" . ,(nth 0 info))
("body" . ,(org-escape-code-in-string (nth 1 info)))
("switches" . ,(let ((f (nth 3 info)))
@@ -368,7 +411,7 @@ inhibit insertion of results into the buffer."
(let ((lang (nth 0 info))
(body (if (org-babel-noweb-p (nth 2 info) :eval)
(org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
+ info org-babel-exp-reference-buffer)
(nth 1 info)))
(info (copy-sequence info))
(org-babel-current-src-block-location (point-marker)))
diff --git a/lisp/ob-forth.el b/lisp/ob-forth.el
new file mode 100644
index 0000000..cc2795a
--- /dev/null
+++ b/lisp/ob-forth.el
@@ -0,0 +1,86 @@
+;;; ob-forth.el --- org-babel functions for Forth
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, forth
+;; 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:
+
+;; Requires the gforth forth compiler and `forth-mode' (see below).
+;; https://www.gnu.org/software/gforth/
+
+;;; Requirements:
+
+;; Session evaluation requires the gforth forth compiler as well as
+;; `forth-mode' which is distributed with gforth (in gforth.el).
+
+;;; Code:
+(require 'ob)
+
+(declare-function forth-proc "ext:gforth" ())
+
+(defvar org-babel-default-header-args:forth '((:session . "yes"))
+ "Default header arguments for forth code blocks.")
+
+(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)))
+ (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)))
+ (mapconcat #'identity all-results "\n")
+ (car (last all-results))))))
+
+(defun org-babel-forth-session-execute (body params)
+ (require 'forth-mode)
+ (let ((proc (forth-proc))
+ (rx " \\(\n:\\|compiled\n\\\|ok\n\\)")
+ (result-start))
+ (with-current-buffer (process-buffer (forth-proc))
+ (mapcar (lambda (line)
+ (setq result-start (progn (goto-char (process-mark proc))
+ (point)))
+ (comint-send-string proc (concat line "\n"))
+ ;; wait for forth to say "ok"
+ (while (not (progn (goto-char result-start)
+ (re-search-forward rx nil t)))
+ (accept-process-output proc 0.01))
+ (let ((case (match-string 1)))
+ (cond
+ ((string= "ok\n" case)
+ ;; Collect intermediate output.
+ (buffer-substring (+ result-start 1 (length line))
+ (match-beginning 0)))
+ ((string= "compiled\n" case))
+ ;; Ignore partial compilation.
+ ((string= "\n:" case)
+ ;; Report errors.
+ (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)))))
+
+(provide 'ob-forth)
+
+;;; ob-forth.el ends here
diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el
index 0211fda..baeb4ba 100644
--- a/lisp/ob-fortran.el
+++ b/lisp/ob-fortran.el
@@ -33,6 +33,7 @@
(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))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
@@ -62,8 +63,9 @@
(org-babel-process-file-name tmp-src-file)) ""))))
(let ((results
(org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (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-read results)
diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el
index ffe5dcf..a350186 100644
--- a/lisp/ob-gnuplot.el
+++ b/lisp/ob-gnuplot.el
@@ -64,7 +64,7 @@
(term . :any))
"Gnuplot specific header args.")
-(defvar org-babel-gnuplot-timestamp-fmt nil)
+(defvar org-babel-gnuplot-timestamp-fmt nil) ; Dynamically scoped.
(defvar *org-babel-gnuplot-missing* nil)
@@ -118,14 +118,11 @@ code."
(timefmt (cdr (assoc :timefmt params)))
(time-ind (or (cdr (assoc :timeind params))
(when timefmt 1)))
- (missing (cdr (assoc :missing params)))
(add-to-body (lambda (text) (setq body (concat text "\n" body))))
output)
;; 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))
- (when missing
- (funcall add-to-body (format "set datafile missing '%s'" missing)))
(when sets
(mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
(when x-labels
@@ -267,15 +264,13 @@ then create one. Return the initialized session. The current
"Export TABLE to DATA-FILE in a format readable by gnuplot.
Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
(with-temp-file data-file
- (make-local-variable 'org-babel-gnuplot-timestamp-fmt)
- (setq org-babel-gnuplot-timestamp-fmt (or
- (plist-get params :timefmt)
- "%Y-%m-%d-%H:%M:%S"))
- (insert (orgtbl-to-generic
- table
- (org-combine-plists
- '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field)
- params))))
+ (insert (let ((org-babel-gnuplot-timestamp-fmt
+ (or (plist-get params :timefmt) "%Y-%m-%d-%H:%M:%S")))
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field)
+ params)))))
data-file)
(provide 'ob-gnuplot)
diff --git a/lisp/ob-groovy.el b/lisp/ob-groovy.el
new file mode 100644
index 0000000..8797ec9
--- /dev/null
+++ b/lisp/ob-groovy.el
@@ -0,0 +1,118 @@
+;;; ob-groovy.el --- org-babel functions for Groovy evaluation
+
+;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+
+;; Author: Miro Bezjak
+;; 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:
+;; Currently only supports the external execution. No session support yet.
+
+;;; Requirements:
+;; - Groovy language :: http://groovy.codehaus.org
+;; - Groovy major mode :: Can be installed from MELPA or
+;; https://github.com/russel/Emacs-Groovy-Mode
+
+;;; 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"))
+(defvar org-babel-default-header-args:groovy '())
+(defcustom org-babel-groovy-command "groovy"
+ "Name of the command to use for executing Groovy code.
+May be either a command in the path, like groovy
+or an absolute path name, like /usr/local/bin/groovy
+parameters may be used, like groovy -v"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
+
+(defun org-babel-execute:groovy (body params)
+ "Execute a block of Groovy code with org-babel. This function is
+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)))
+ (full-body (org-babel-expand-body:generic
+ body params))
+ (result (org-babel-groovy-evaluate
+ session full-body result-type result-params)))
+
+ (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))))))
+
+(defvar org-babel-groovy-wrapper-method
+
+ "class Runner extends Script {
+ def out = new PrintWriter(new ByteArrayOutputStream())
+ def run() { %s }
+}
+
+println(new Runner().run())
+")
+
+
+(defun org-babel-groovy-evaluate
+ (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
+ (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
+ (let* ((src-file (org-babel-temp-file "groovy-"))
+ (wrapper (format org-babel-groovy-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ (let ((raw (org-babel-eval
+ (concat org-babel-groovy-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-script-escape raw)))))))
+
+
+(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)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session. Sessions are not
+supported in Groovy."
+ nil)
+
+(provide 'ob-groovy)
+
+
+
+;;; ob-groovy.el ends here
diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el
index 0006670..2e1d390 100644
--- a/lisp/ob-haskell.el
+++ b/lisp/ob-haskell.el
@@ -84,7 +84,7 @@
(output (mapconcat #'identity (reverse (cdr results)) "\n"))
(value (car results)))))
(org-babel-result-cond (cdr (assoc :result-params params))
- result (org-babel-haskell-table-or-string result)))
+ 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))
@@ -133,12 +133,6 @@ then create one. Return the initialized session."
(org-babel-haskell-var-to-haskell (cdr pair))))
(mapcar #'cdr (org-babel-get-header params :var))))
-(defun org-babel-haskell-table-or-string (results)
- "Convert RESULTS to an Emacs-lisp table or string.
-If RESULTS look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
(defun org-babel-haskell-var-to-haskell (var)
"Convert an elisp value VAR into a haskell variable.
The elisp VAR is converted to a string of haskell source code
diff --git a/lisp/ob-io.el b/lisp/ob-io.el
index 971b37f..c309b88 100644
--- a/lisp/ob-io.el
+++ b/lisp/ob-io.el
@@ -62,14 +62,6 @@ called by `org-babel-execute-src-block'"
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
-
-(defun org-babel-io-table-or-string (results)
- "Convert RESULTS into an appropriate elisp value.
-If RESULTS look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
-
(defvar org-babel-io-wrapper-method
"(
%s
@@ -98,7 +90,7 @@ in BODY as elisp."
(concat org-babel-io-command " " src-file) "")))
(org-babel-result-cond result-params
raw
- (org-babel-io-table-or-string raw)))))))
+ (org-babel-script-escape raw)))))))
(defun org-babel-prep-session:io (session params)
diff --git a/lisp/ob-java.el b/lisp/ob-java.el
index 22f8785..8c64171 100644
--- a/lisp/ob-java.el
+++ b/lisp/ob-java.el
@@ -32,11 +32,23 @@
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
-(defvar org-babel-java-command "java"
- "Name of the java command.")
-
-(defvar org-babel-java-compiler "javac"
- "Name of the java compiler.")
+(defcustom org-babel-java-command "java"
+ "Name of the java command.
+May be either a command in the path, like java
+or an absolute path name, like /usr/local/bin/java
+parameters may be used, like java -verbose"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
+
+(defcustom org-babel-java-compiler "javac"
+ "Name of the java compiler.
+May be either a command in the path, like javac
+or an absolute path name, like /usr/local/bin/javac
+parameters may be used, like javac -verbose"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
(defun org-babel-execute:java (body params)
(let* ((classname (or (cdr (assoc :classname params))
diff --git a/lisp/ob-js.el b/lisp/ob-js.el
index 7789449..e126787 100644
--- a/lisp/ob-js.el
+++ b/lisp/ob-js.el
@@ -97,14 +97,15 @@ 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 "^\\[.+\\]$" results))
+ (if (and (stringp results) (string-match "^\\[[^\000]+\\]$" results))
(org-babel-read
(concat "'"
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
- ", " " " (replace-regexp-in-string
- "'" "\"" results))))))
+ ",[[:space:]]" " "
+ (replace-regexp-in-string
+ "'" "\"" results))))))
results)))
(defun org-babel-js-var-to-js (var)
@@ -113,7 +114,7 @@ Convert an elisp value into a string of js source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]")
- (format "%S" var)))
+ (replace-regexp-in-string "\n" "\\\\n" (format "%S" var))))
(defun org-babel-prep-session:js (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el
index 90b5196..dc1f437 100644
--- a/lisp/ob-keys.el
+++ b/lisp/ob-keys.el
@@ -89,6 +89,7 @@ functions which are assigned key bindings, and see
("h" . org-babel-describe-bindings)
("\C-x" . org-babel-do-key-sequence-in-edit-buffer)
("x" . org-babel-do-key-sequence-in-edit-buffer)
+ ("k" . org-babel-remove-result-one-or-many)
("\C-\M-h" . org-babel-mark-block))
"Alist of key bindings and interactive Babel functions.
This list associates interactive Babel functions
diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el
index 35b6650..4efa78d 100644
--- a/lisp/ob-latex.el
+++ b/lisp/ob-latex.el
@@ -50,7 +50,18 @@
'((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a LaTeX source block.")
-(defcustom org-babel-latex-htlatex ""
+(defconst org-babel-header-args:latex
+ '((border . :any)
+ (fit . :any)
+ (iminoptions . :any)
+ (imoutoptions . :any)
+ (packages . :any)
+ (pdfheight . :any)
+ (pdfpng . :any)
+ (pdfwidth . :any))
+ "LaTeX-specific header arguments.")
+
+(defcustom org-babel-latex-htlatex "htlatex"
"The htlatex command to enable conversion of latex to SVG or HTML."
:group 'org-babel
:type 'string)
@@ -99,6 +110,51 @@ This function is called by `org-babel-execute-src-block'."
(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))
+ (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
+ ;; would be unified. This would prevent bugs creeping in
+ ;; such as the one fixed on Aug 16 2014 whereby :headers was
+ ;; not included in the SVG/HTML case.
+ (with-temp-file tex-file
+ (insert (concat
+ "\\documentclass[preview]{standalone}
+\\def\\pgfsysdriver{pgfsys-tex4ht.def}
+"
+ (mapconcat (lambda (pkg)
+ (concat "\\usepackage" pkg))
+ org-babel-latex-htlatex-packages
+ "\n")
+ (if headers
+ (concat "\n"
+ (if (listp headers)
+ (mapconcat #'identity headers "\n")
+ headers) "\n")
+ "")
+ "\\begin{document}"
+ body
+ "\\end{document}")))
+ (when (file-exists-p out-file) (delete-file out-file))
+ (let ((default-directory (file-name-directory tex-file)))
+ (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)
+ (progn
+ (shell-command "pwd")
+ (shell-command (format "mv %s %s"
+ (concat (file-name-sans-extension tex-file) "-1.svg")
+ 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)
+ (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)
(with-temp-file tex-file
(require 'ox-latex)
@@ -135,51 +191,17 @@ This function is called by `org-babel-execute-src-block'."
((string-match "\\.pdf$" out-file)
(rename-file transient-pdf-file out-file))
(imagemagick
- (convert-pdf
+ (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))))))
- ((and (or (string-match "\\.svg$" out-file)
- (string-match "\\.html$" out-file))
- (not (string= "" org-babel-latex-htlatex)))
- (with-temp-file tex-file
- (insert (concat
- "\\documentclass[preview]{standalone}
-\\def\\pgfsysdriver{pgfsys-tex4ht.def}
-"
- (mapconcat (lambda (pkg)
- (concat "\\usepackage" pkg))
- org-babel-latex-htlatex-packages
- "\n")
- "\\begin{document}"
- body
- "\\end{document}")))
- (when (file-exists-p out-file) (delete-file out-file))
- (let ((default-directory (file-name-directory tex-file)))
- (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)
- (progn
- (shell-command "pwd")
- (shell-command (format "mv %s %s"
- (concat (file-name-sans-extension tex-file) "-1.svg")
- 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)
- (shell-command "mv %s %s"
- (concat (file-name-sans-extension tex-file)
- ".html")
- out-file)
- (error "HTML file produced but SVG file requested.")))))
((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))))
nil) ;; signal that output has already been written to file
body))
-(defun convert-pdf (pdffile out-file im-in-options im-out-options)
+(defun org-babel-latex-convert-pdf (pdffile out-file im-in-options im-out-options)
"Generate a file from a pdf file using imagemagick."
(let ((cmd (concat "convert " im-in-options " " pdffile " "
im-out-options " " out-file)))
diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el
index 00a951d..c7ad576 100644
--- a/lisp/ob-lilypond.el
+++ b/lisp/ob-lilypond.el
@@ -28,6 +28,8 @@
;;
;; Lilypond documentation can be found at
;; http://lilypond.org/manuals.html
+;;
+;; This depends on epstopdf --- See http://www.ctan.org/pkg/epstopdf.
;;; Code:
(require 'ob)
@@ -60,47 +62,64 @@ org-babel-lilypond-play-midi-post-tangle determines whether to automate the
playing of the resultant midi file. If the value is nil,
the midi file is not automatically played. Default value is t")
-(defvar org-babel-lilypond-OSX-ly-path
- "/Applications/lilypond.app/Contents/Resources/bin/lilypond")
-(defvar org-babel-lilypond-OSX-pdf-path "open")
-(defvar org-babel-lilypond-OSX-midi-path "open")
-
-(defvar org-babel-lilypond-nix-ly-path "/usr/bin/lilypond")
-(defvar org-babel-lilypond-nix-pdf-path "evince")
-(defvar org-babel-lilypond-nix-midi-path "timidity")
-
-(defvar org-babel-lilypond-w32-ly-path "lilypond")
-(defvar org-babel-lilypond-w32-pdf-path "")
-(defvar org-babel-lilypond-w32-midi-path "")
+(defvar org-babel-lilypond-ly-command ""
+ "Command to execute lilypond on your system.
+Do not set it directly. Customize `org-babel-lilypond-commands' instead.")
+(defvar org-babel-lilypond-pdf-command ""
+ "Command to show a PDF file on your system.
+Do not set it directly. Customize `org-babel-lilypond-commands' instead.")
+(defvar org-babel-lilypond-midi-command ""
+ "Command to play a MIDI file on your system.
+Do not set it directly. Customize `org-babel-lilypond-commands' instead.")
+(defcustom org-babel-lilypond-commands
+ (cond
+ ((eq system-type 'darwin)
+ '("/Applications/lilypond.app/Contents/Resources/bin/lilypond" "open" "open"))
+ ((eq system-type 'windows-nt)
+ '("lilypond" "" ""))
+ (t
+ '("lilypond" "xdg-open" "xdg-open")))
+ "Commands to run lilypond and view or play the results.
+These should be executables that take a filename as an argument.
+On some system it is possible to specify the filename directly
+and the viewer or player will be determined from the file type;
+you can leave the string empty on this case."
+ :group 'org-babel
+ :type '(list
+ (string :tag "Lilypond ")
+ (string :tag "PDF Viewer ")
+ (string :tag "MIDI Player"))
+ :version "24.3"
+ :package-version '(Org . "8.2.7")
+ :set
+ (lambda (symbol value)
+ (setq
+ org-babel-lilypond-ly-command (nth 0 value)
+ org-babel-lilypond-pdf-command (nth 1 value)
+ org-babel-lilypond-midi-command (nth 2 value))))
(defvar org-babel-lilypond-gen-png nil
- "Image generation (png) can be turned on by default by setting
-ORG-BABEL-LILYPOND-GEN-PNG to t")
+ "Non-nil means image generation (PNG) is turned on by default.")
(defvar org-babel-lilypond-gen-svg nil
- "Image generation (SVG) can be turned on by default by setting
-ORG-BABEL-LILYPOND-GEN-SVG to t")
+ "Non-nil means image generation (SVG) is be turned on by default.")
(defvar org-babel-lilypond-gen-html nil
- "HTML generation can be turned on by default by setting
-ORG-BABEL-LILYPOND-GEN-HTML to t")
+ "Non-nil means HTML generation is turned on by default.")
(defvar org-babel-lilypond-gen-pdf nil
- "PDF generation can be turned on by default by setting
-ORG-BABEL-LILYPOND-GEN-PDF to t")
+ "Non-nil means PDF generation is be turned on by default.")
(defvar org-babel-lilypond-use-eps nil
- "You can force the compiler to use the EPS backend by setting
-ORG-BABEL-LILYPOND-USE-EPS to t")
+ "Non-nil forces the compiler to use the EPS backend.")
(defvar org-babel-lilypond-arrange-mode nil
- "Arrange mode is turned on by setting ORG-BABEL-LILYPOND-ARRANGE-MODE
-to t. In Arrange mode the following settings are altered
-from default...
+ "Non-nil turns Arrange mode on.
+In Arrange mode the following settings are altered from default:
:tangle yes, :noweb yes
:results silent :comments yes.
In addition lilypond block execution causes tangling of all lilypond
-blocks")
+blocks.")
(defun org-babel-expand-body:lilypond (body params)
"Expand BODY according to PARAMS, return the expanded body."
@@ -148,7 +167,7 @@ specific arguments to =org-babel-tangle="
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval
(concat
- (org-babel-lilypond-determine-ly-path)
+ org-babel-lilypond-ly-command
" -dbackend=eps "
"-dno-gs-load-fonts "
"-dinclude-eps-fonts "
@@ -175,29 +194,27 @@ If error in compilation, attempt to mark the error in lilypond org file"
(buffer-file-name) ".lilypond"))
(org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension
(buffer-file-name) ".ly")))
- (if (file-exists-p org-babel-lilypond-tangled-file)
- (progn
- (when (file-exists-p org-babel-lilypond-temp-file)
- (delete-file org-babel-lilypond-temp-file))
- (rename-file org-babel-lilypond-tangled-file
- org-babel-lilypond-temp-file))
- (error "Error: Tangle Failed!") t)
+ (if (not (file-exists-p org-babel-lilypond-tangled-file))
+ (error "Error: Tangle Failed!")
+ (when (file-exists-p org-babel-lilypond-temp-file)
+ (delete-file org-babel-lilypond-temp-file))
+ (rename-file org-babel-lilypond-tangled-file
+ org-babel-lilypond-temp-file))
(switch-to-buffer-other-window "*lilypond*")
(erase-buffer)
(org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file)
(goto-char (point-min))
- (if (not (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file))
- (progn
- (other-window -1)
- (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file)
- (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file))
- (error "Error in Compilation!")))) nil)
+ (if (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file)
+ (error "Error in Compilation!")
+ (other-window -1)
+ (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file)
+ (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file)))))
(defun org-babel-lilypond-compile-lilyfile (file-name &optional test)
"Compile lilypond file and check for compile errors
FILE-NAME is full path to lilypond (.ly) file"
(message "Compiling LilyPond...")
- (let ((arg-1 (org-babel-lilypond-determine-ly-path)) ;program
+ (let ((arg-1 org-babel-lilypond-ly-command) ;program
(arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
(arg-4 t) ;display
@@ -223,11 +240,10 @@ FILE-NAME is full path to lilypond file.
If TEST is t just return nil if no error found, and pass
nil as file-name since it is unused in this context"
(let ((is-error (search-forward "error:" nil t)))
- (if (not test)
- (if (not is-error)
- nil
- (org-babel-lilypond-process-compile-error file-name))
- is-error)))
+ (if test
+ is-error
+ (when is-error
+ (org-babel-lilypond-process-compile-error file-name)))))
(defun org-babel-lilypond-process-compile-error (file-name)
"Process the compilation error that has occurred.
@@ -298,13 +314,13 @@ If TEST is non-nil, the shell command is returned and is not run"
(let ((pdf-file (org-babel-lilypond-switch-extension file-name ".pdf")))
(if (file-exists-p pdf-file)
(let ((cmd-string
- (concat (org-babel-lilypond-determine-pdf-path) " " pdf-file)))
+ (concat org-babel-lilypond-pdf-command " " pdf-file)))
(if test
cmd-string
(start-process
"\"Audition pdf\""
"*lilypond*"
- (org-babel-lilypond-determine-pdf-path)
+ org-babel-lilypond-pdf-command
pdf-file)))
(message "No pdf file generated so can't display!")))))
@@ -316,49 +332,16 @@ If TEST is non-nil, the shell command is returned and is not run"
(let ((midi-file (org-babel-lilypond-switch-extension file-name ".midi")))
(if (file-exists-p midi-file)
(let ((cmd-string
- (concat (org-babel-lilypond-determine-midi-path) " " midi-file)))
+ (concat org-babel-lilypond-midi-command " " midi-file)))
(if test
cmd-string
(start-process
"\"Audition midi\""
"*lilypond*"
- (org-babel-lilypond-determine-midi-path)
+ org-babel-lilypond-midi-command
midi-file)))
(message "No midi file generated so can't play!")))))
-(defun org-babel-lilypond-determine-ly-path (&optional test)
- "Return correct path to ly binary depending on OS
-If TEST is non-nil, it contains a simulation of the OS for test purposes"
- (let ((sys-type
- (or test system-type)))
- (cond ((string= sys-type "darwin")
- org-babel-lilypond-OSX-ly-path)
- ((string= sys-type "windows-nt")
- org-babel-lilypond-w32-ly-path)
- (t org-babel-lilypond-nix-ly-path))))
-
-(defun org-babel-lilypond-determine-pdf-path (&optional test)
- "Return correct path to pdf viewer depending on OS
-If TEST is non-nil, it contains a simulation of the OS for test purposes"
- (let ((sys-type
- (or test system-type)))
- (cond ((string= sys-type "darwin")
- org-babel-lilypond-OSX-pdf-path)
- ((string= sys-type "windows-nt")
- org-babel-lilypond-w32-pdf-path)
- (t org-babel-lilypond-nix-pdf-path))))
-
-(defun org-babel-lilypond-determine-midi-path (&optional test)
- "Return correct path to midi player depending on OS
-If TEST is non-nil, it contains a simulation of the OS for test purposes"
- (let ((sys-type
- (or test test system-type)))
- (cond ((string= sys-type "darwin")
- org-babel-lilypond-OSX-midi-path)
- ((string= sys-type "windows-nt")
- org-babel-lilypond-w32-midi-path)
- (t org-babel-lilypond-nix-midi-path))))
-
(defun org-babel-lilypond-toggle-midi-play ()
"Toggle whether midi will be played following a successful compilation."
(interactive)
diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el
index 6bddd61..a59dab3 100644
--- a/lisp/ob-lisp.el
+++ b/lisp/ob-lisp.el
@@ -44,7 +44,7 @@
(defvar org-babel-header-args:lisp '((package . :any)))
(defcustom org-babel-lisp-dir-fmt
- "(let ((*default-pathname-defaults* #P%S)) %%s)"
+ "(let ((*default-pathname-defaults* #P%S\n)) %%s\n)"
"Format string used to wrap code bodies to set the current directory.
For example a value of \"(progn ;; %s\\n %%s)\" would ignore the
current directory string."
@@ -76,23 +76,25 @@ current directory string."
(require 'slime)
(org-babel-reassemble-table
(let ((result
- (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)")
- (buffer-substring-no-properties
- (point-min) (point-max)))))
- (cdr (assoc :package params))))))
+ (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))
- (car result)
+ result
(condition-case nil
- (read (org-babel-lisp-vector-to-list (cadr result)))
- (error (cadr result)))))
+ (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))
diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el
index 4e635da..0267f44 100644
--- a/lisp/ob-lob.el
+++ b/lisp/ob-lob.el
@@ -1,6 +1,6 @@
;;; ob-lob.el --- functions supporting the Library of Babel
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -70,8 +70,8 @@ To add files to this list use the `org-babel-lob-ingest' command."
(defconst org-babel-inline-lob-one-liner-regexp
(concat
- "\\([^\n]*?\\)call_\\([^\(\)\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
- "\(\\([^\n]*?\\)\)\\(\\[\\(.*?\\)\\]\\)?")
+ "\\([^\n]*?\\)call_\\([^\(\)[:space:]\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
+ "\(\\(.*?\\)\)\\(\\[\\(.*?\\)\\]\\)?")
"Regexp to match inline calls to predefined source block functions.")
(defconst org-babel-lob-one-liner-regexp
@@ -116,9 +116,10 @@ if so then run the appropriate source block from the Library."
(match-string 2) (match-string 11)))
(save-excursion
(forward-line -1)
- (and (looking-at (concat org-babel-src-name-regexp
- "\\([^\n]*\\)$"))
- (org-no-properties (match-string 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)
@@ -142,18 +143,32 @@ if so then run the appropriate source block from the Library."
(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 pre-info)))
- (old-hash (when cache-p (org-babel-current-result-hash)))
+ (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))
+ (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))))))
+ (when new-hash
+ (org-babel-set-current-result-hash new-hash pre-info))))))
(provide 'ob-lob)
diff --git a/lisp/ob-maxima.el b/lisp/ob-maxima.el
index 7435f1d..4e559d1 100644
--- a/lisp/ob-maxima.el
+++ b/lisp/ob-maxima.el
@@ -52,7 +52,7 @@
(mapconcat 'identity
(list
;; graphic output
- (let ((graphic-file (org-babel-maxima-graphical-output-file params)))
+ (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params))))
(if graphic-file
(format
"set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);"
@@ -89,7 +89,7 @@ This function is called by `org-babel-execute-src-block'."
(= 0 (length line)))
line))
(split-string raw "[\r\n]"))) "\n")))))
- (if (org-babel-maxima-graphical-output-file params)
+ (if (ignore-errors (org-babel-graphical-output-file params))
nil
(org-babel-result-cond result-params
result
@@ -113,11 +113,6 @@ of the same value."
(format "%S: %s$" var
(org-babel-maxima-elisp-to-maxima val))))
-(defun org-babel-maxima-graphical-output-file (params)
- "Name of file to which maxima should send graphical output."
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
-
(defun org-babel-maxima-elisp-to-maxima (val)
"Return a string of maxima code which evaluates to VAL."
(if (listp val)
diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el
index 1f29a25..9cd72b3 100644
--- a/lisp/ob-ocaml.el
+++ b/lisp/ob-ocaml.el
@@ -1,6 +1,6 @@
;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -70,7 +70,8 @@
(session org-babel-ocaml-eoe-output t full-body)
(insert
(concat
- (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator))
+ (org-babel-chomp full-body) ";;\n"
+ org-babel-ocaml-eoe-indicator))
(tuareg-interactive-send-input)))
(clean
(car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out)
@@ -79,16 +80,25 @@
(progn (setq out nil) line)
(when (string-match re line)
(progn (setq out t) nil))))
- (mapcar #'org-babel-trim (reverse raw))))))))
+ (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\\| \\)\\(.+\\)$"
+ raw))
+ (output (match-string 1 raw))
+ (type (match-string 3 raw))
+ (value (match-string 5 raw)))
(org-babel-reassemble-table
- (let ((raw (org-babel-trim clean))
- (result-params (cdr (assoc :result-params params))))
- (org-babel-result-cond result-params
- ;; strip type information from output unless verbatim is specified
- (if (and (not (member "verbatim" result-params))
- (string-match "= \\(.+\\)$" raw))
- (match-string 1 raw) raw)
- (org-babel-ocaml-parse-output raw)))
+ (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
@@ -121,26 +131,29 @@
(concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]")
(format "%S" val)))
-(defun org-babel-ocaml-parse-output (output)
- "Parse OUTPUT.
-OUTPUT is string output from an ocaml process."
- (let ((regexp "[^:]+ : %s = \\(.+\\)$"))
- (cond
- ((string-match (format regexp "string") output)
- (org-babel-read (match-string 1 output)))
- ((or (string-match (format regexp "int") output)
- (string-match (format regexp "float") output))
- (string-to-number (match-string 1 output)))
- ((string-match (format regexp "list") output)
- (org-babel-ocaml-read-list (match-string 1 output)))
- ((string-match (format regexp "array") output)
- (org-babel-ocaml-read-array (match-string 1 output)))
- (t (message "don't recognize type of %s" output) output))))
+(defun org-babel-ocaml-parse-output (value type)
+ "Parse VALUE of type TYPE.
+VALUE and TYPE are string output from an ocaml process."
+ (cond
+ ((string= "string" type)
+ (org-babel-read value))
+ ((or (string= "int" type)
+ (string= "float" type))
+ (string-to-number value))
+ ((string-match "list" type)
+ (org-babel-ocaml-read-list value))
+ ((string-match "array" type)
+ (org-babel-ocaml-read-array value))
+ (t (message "don't recognize type %s" type) value)))
(defun org-babel-ocaml-read-list (results)
"Convert RESULTS into an elisp table or string.
If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
+ ;; XXX: This probably does not behave as expected when a semicolon
+ ;; is in a string in a list. The same comment applies to
+ ;; `org-babel-ocaml-read-array' below (with even more failure
+ ;; modes).
(org-babel-script-escape (replace-regexp-in-string ";" "," results)))
(defun org-babel-ocaml-read-array (results)
diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el
index 8cc66b6..14b55d2 100644
--- a/lisp/ob-octave.el
+++ b/lisp/ob-octave.el
@@ -82,18 +82,19 @@ end")
(full-body
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:octave params)))
+ (gfx-file (ignore-errors (org-babel-graphical-output-file params)))
(result (org-babel-octave-evaluate
session
- (if (org-babel-octave-graphical-output-file params)
+ (if gfx-file
(mapconcat 'identity
(list
"set (0, \"defaultfigurevisible\", \"off\");"
full-body
- (format "print -dpng %s" (org-babel-octave-graphical-output-file params)))
+ (format "print -dpng %s" gfx-file))
"\n")
full-body)
result-type matlabp)))
- (if (org-babel-octave-graphical-output-file params)
+ (if gfx-file
nil
(org-babel-reassemble-table
result
@@ -268,11 +269,6 @@ This removes initial blank and comment lines and then calls
(match-string 1 string)
string))
-(defun org-babel-octave-graphical-output-file (params)
- "Name of file to which maxima should send graphical output."
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
-
(provide 'ob-octave)
diff --git a/lisp/ob-processing.el b/lisp/ob-processing.el
new file mode 100644
index 0000000..d983afe
--- /dev/null
+++ b/lisp/ob-processing.el
@@ -0,0 +1,197 @@
+;;; ob-processing.el --- Babel functions for evaluation of processing
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Jarmo Hurri (adapted from ob-asymptote.el written by Eric Schulte)
+;; 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:
+
+;; Babel support for evaluating processing source code.
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in processing
+;;
+;; 2) results can only be exported as html; in this case, the
+;; processing code is embedded via a file into a javascript block
+;; using the processing.js module; the script then draws the
+;; resulting output when the web page is viewed in a browser; note
+;; that the user is responsible for making sure that processing.js
+;; is available on the website
+;;
+;; 3) it is possible to interactively view the sketch of the
+;; Processing code block via Processing 2.0 Emacs mode, using
+;; `org-babel-processing-view-sketch'. You can bind this command
+;; to, e.g., C-c C-v C-k with
+;;
+;; (define-key org-babel-map (kbd "C-k") 'org-babel-processing-view-sketch)
+
+
+;;; Requirements:
+
+;; - processing2-emacs mode :: https://github.com/ptrv/processing2-emacs
+;; - Processing.js module :: http://processingjs.org/
+
+;;; Code:
+(require 'ob)
+(require 'sha1)
+(eval-when-compile (require 'cl))
+
+(declare-function processing-sketch-run "ext:processing-mode" ())
+
+(defvar org-babel-temporary-directory)
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("processing" . "pde"))
+
+;; Default header tags depend on whether exporting html or not; if not
+;; exporting html, then no results are produced; otherwise results are
+;; HTML.
+(defvar org-babel-default-header-args:processing
+ '((:results . "html") (:exports . "results"))
+ "Default arguments when evaluating a Processing source block.")
+
+(defvar org-babel-processing-processing-js-filename "processing.js"
+ "Filename of the processing.js file.")
+
+(defun org-babel-processing-view-sketch ()
+ "Show the sketch of the Processing block under point in an external viewer."
+ (interactive)
+ (require 'processing-mode)
+ (let ((info (org-babel-get-src-block-info)))
+ (if (string= (nth 0 info) "processing")
+ (let* ((body (nth 1 info))
+ (params (org-babel-process-params (nth 2 info)))
+ (sketch-code
+ (org-babel-expand-body:generic
+ body
+ params
+ (org-babel-variable-assignments:processing params))))
+ ;; Note: sketch filename can not contain a hyphen, since it
+ ;; has to be a valid java class name; for this reason
+ ;; make-temp-file is repeated until no hyphen is in the
+ ;; name; also sketch dir name must be the same as the
+ ;; basename of the sketch file.
+ (let* ((temporary-file-directory org-babel-temporary-directory)
+ (sketch-dir
+ (let (sketch-dir-candidate)
+ (while
+ (progn
+ (setq sketch-dir-candidate
+ (make-temp-file "processing" t))
+ (when (org-string-match-p
+ "-"
+ (file-name-nondirectory sketch-dir-candidate))
+ (delete-directory sketch-dir-candidate)
+ t)))
+ sketch-dir-candidate))
+ (sketch-filename
+ (concat sketch-dir
+ "/"
+ (file-name-nondirectory sketch-dir)
+ ".pde")))
+ (with-temp-file sketch-filename (insert sketch-code))
+ (find-file sketch-filename)
+ (processing-sketch-run)
+ (kill-buffer)))
+ (message "Not inside a Processing source block."))))
+
+(defun org-babel-execute:processing (body params)
+ "Execute a block of Processing code.
+This function is called by `org-babel-execute-src-block'."
+ (let ((sketch-code
+ (org-babel-expand-body:generic
+ body
+ params
+ (org-babel-variable-assignments:processing params))))
+ ;; Results are HTML.
+ (let ((sketch-canvas-id (concat "ob-" (sha1 sketch-code))))
+ (concat "<script src=\""
+ org-babel-processing-processing-js-filename
+ "\"></script>\n <script type=\"text/processing\""
+ " data-processing-target=\""
+ sketch-canvas-id
+ "\">\n"
+ sketch-code
+ "\n</script> <canvas id=\""
+ sketch-canvas-id
+ "\"></canvas>"))))
+
+(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"))
+
+(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))))
+
+(defun org-babel-processing-var-to-processing (pair)
+ "Convert an elisp value into a Processing variable.
+The elisp value PAIR is converted into Processing code specifying
+a variable of the same value."
+ (let ((var (car pair))
+ (val (let ((v (cdr pair)))
+ (if (symbolp v) (symbol-name v) v))))
+ (cond
+ ((integerp val)
+ (format "int %S=%S;" var val))
+ ((floatp val)
+ (format "float %S=%S;" var val))
+ ((stringp val)
+ (format "String %S=\"%s\";" var val))
+ ((and (listp val) (not (listp (car val))))
+ (let* ((type (org-babel-processing-define-type val))
+ (fmt (if (eq 'String type) "\"%s\"" "%s"))
+ (vect (mapconcat (lambda (e) (format fmt e)) val ", ")))
+ (format "%s[] %S={%s};" type var vect)))
+ ((listp val)
+ (let* ((type (org-babel-processing-define-type val))
+ (fmt (if (eq 'String type) "\"%s\"" "%s"))
+ (array (mapconcat (lambda (row)
+ (concat "{"
+ (mapconcat (lambda (e) (format fmt e))
+ row ", ")
+ "}"))
+ val ",")))
+ (format "%S[][] %S={%s};" type var array))))))
+
+(defun org-babel-processing-define-type (data)
+ "Determine type of DATA.
+
+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)))))))
+ (catch 'exit (funcall find-type data))))
+
+(provide 'ob-processing)
+
+;;; ob-processing.el ends here
diff --git a/lisp/ob-python.el b/lisp/ob-python.el
index 7cee104..dd3cc66 100644
--- a/lisp/ob-python.el
+++ b/lisp/ob-python.el
@@ -1,6 +1,6 @@
;;; ob-python.el --- org-babel functions for python evaluation
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -80,6 +80,8 @@ This function is called by `org-babel-execute-src-block'."
(return-val (when (and (eq result-type 'value) (not session))
(cdr (assoc :return params))))
(preamble (cdr (assoc :preamble params)))
+ (org-babel-python-command
+ (or (cdr (assoc :python params)) org-babel-python-command))
(full-body
(org-babel-expand-body:generic
(concat body (if return-val (format "\nreturn %s" return-val) ""))
@@ -222,13 +224,13 @@ then create. Return the initialized session."
(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'"
"A string to indicate that evaluation has completed.")
-(defvar org-babel-python-wrapper-method
+(defconst org-babel-python-wrapper-method
"
def main():
%s
open('%s', 'w').write( str(main()) )")
-(defvar org-babel-python-pp-wrapper-method
+(defconst org-babel-python-pp-wrapper-method
"
import pprint
def main():
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
index 152af86..b8a921e 100644
--- a/lisp/ob-ref.el
+++ b/lisp/ob-ref.el
@@ -1,6 +1,6 @@
;;; ob-ref.el --- org-babel functions for referencing external data
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -53,6 +53,8 @@
(eval-when-compile
(require 'cl))
+(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))
@@ -63,6 +65,8 @@
(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)
(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]*")
@@ -96,119 +100,125 @@ the variable."
out))))))
(defun org-babel-ref-goto-headline-id (id)
- (goto-char (point-min))
- (let ((rx (regexp-quote id)))
- (or (re-search-forward
- (concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t)
- (let* ((file (org-id-find-id-file id))
- (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))
- (goto-char m)
- (move-marker m nil)
- (org-show-context)
- t)))))
+ (or (let ((h (org-find-property "CUSTOM_ID" id)))
+ (when h (goto-char h)))
+ (let* ((file (org-id-find-id-file id))
+ (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))
+ (goto-char m)
+ (move-marker m nil)
+ (org-show-context)
+ t))))
(defun org-babel-ref-headline-body ()
(save-restriction
(org-narrow-to-subtree)
(buffer-substring
(save-excursion (goto-char (point-min))
- (forward-line 1)
- (when (looking-at "[ \t]*:PROPERTIES:")
- (re-search-forward ":END:" nil)
- (forward-char))
+ (org-end-of-meta-data)
(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."
(save-window-excursion
- (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)
- ;; 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))))
- (setq index (match-string 1 ref))
- (setq ref (substring ref 0 (match-beginning 0))))
- ;; assign any arguments to pass to source block
- (when (string-match
- "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
- (setq new-refere (match-string 1 ref))
- (setq new-header-args (match-string 3 ref))
- (setq new-referent (match-string 5 ref))
- (when (> (length new-refere) 0)
- (when (> (length new-referent) 0)
- (setq args (mapcar (lambda (ref) (cons :var ref))
- (org-babel-ref-split-args new-referent))))
- (when (> (length new-header-args) 0)
- (setq args (append (org-babel-parse-header-arguments
- new-header-args) args)))
- (setq ref new-refere)))
- (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))
- (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)))
- (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)))))))
+ (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)
+ ;; 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))))
+ (setq index (match-string 1 ref))
+ (setq ref (substring ref 0 (match-beginning 0))))
+ ;; assign any arguments to pass to source block
+ (when (string-match
+ "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
+ (setq new-refere (match-string 1 ref))
+ (setq new-header-args (match-string 3 ref))
+ (setq new-referent (match-string 5 ref))
+ (when (> (length new-refere) 0)
+ (when (> (length new-referent) 0)
+ (setq args (mapcar (lambda (ref) (cons :var ref))
+ (org-babel-ref-split-args new-referent))))
+ (when (> (length new-header-args) 0)
+ (setq args (append (org-babel-parse-header-arguments
+ new-header-args) args)))
+ (setq ref new-refere)))
+ (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))))))))
(defun org-babel-ref-index-list (index lis)
"Return the subset of LIS indexed by INDEX.
diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el
index 5b31247..2134fad 100644
--- a/lisp/ob-ruby.el
+++ b/lisp/ob-ruby.el
@@ -58,7 +58,7 @@
:type 'string)
(defcustom org-babel-ruby-nil-to 'hline
- "Replace 'nil' in ruby tables with this before returning."
+ "Replace nil in ruby tables with this before returning."
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
@@ -209,21 +209,32 @@ return the value of the last statement in BODY, as elisp."
;; comint session evaluation
(case result-type
(output
- (mapconcat
- #'identity
- (butlast
- (split-string
- (mapconcat
- #'org-babel-trim
- (butlast
- (org-babel-comint-with-output
- (buffer org-babel-ruby-eoe-indicator t body)
- (mapc
- (lambda (line)
- (insert (org-babel-chomp line)) (comint-send-input nil t))
- (list body org-babel-ruby-eoe-indicator))
- (comint-send-input nil t)) 2)
- "\n") "[\r\n]")) "\n"))
+ (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
+ ;; sometimes show the prompt after the the input has already
+ ;; been inserted and that throws off the extraction of the
+ ;; result for Babel.
+ (org-babel-comint-with-output
+ (buffer org-babel-ruby-eoe-indicator t eoe-string)
+ (insert eoe-string) (comint-send-input nil t))
+ ;; Now we can start the evaluation.
+ (mapconcat
+ #'identity
+ (butlast
+ (split-string
+ (mapconcat
+ #'org-babel-trim
+ (org-babel-comint-with-output
+ (buffer org-babel-ruby-eoe-indicator t body)
+ (mapc
+ (lambda (line)
+ (insert (org-babel-chomp line)) (comint-send-input nil t))
+ (list "conf.echo=false;_org_prompt_mode=conf.prompt_mode;conf.prompt_mode=:NULL"
+ body
+ "conf.prompt_mode=_org_prompt_mode;conf.echo=true"
+ eoe-string)))
+ "\n") "[\r\n]") 4) "\n")))
(value
(let* ((tmp-file (org-babel-temp-file "ruby-"))
(ppp (or (member "code" result-params)
diff --git a/lisp/ob-scala.el b/lisp/ob-scala.el
index 0584342..838bc8f 100644
--- a/lisp/ob-scala.el
+++ b/lisp/ob-scala.el
@@ -60,14 +60,6 @@ called by `org-babel-execute-src-block'"
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
-
-(defun org-babel-scala-table-or-string (results)
- "Convert RESULTS into an appropriate elisp value.
-If RESULTS look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
-
(defvar org-babel-scala-wrapper-method
"var str_result :String = null;
@@ -104,7 +96,7 @@ in BODY as elisp."
(concat org-babel-scala-command " " src-file) "")))
(org-babel-result-cond result-params
raw
- (org-babel-scala-table-or-string raw)))))))
+ (org-babel-script-escape raw)))))))
(defun org-babel-prep-session:scala (session params)
diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index b7117e9..2095534 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -118,6 +118,22 @@ org-babel-scheme-execute-with-geiser will use a temporary session."
(name))))
result))
+(defmacro org-babel-scheme-capture-current-message (&rest body)
+ "Capture current message in both interactive and noninteractive mode"
+ `(if noninteractive
+ (let ((original-message (symbol-function 'message))
+ (current-message nil))
+ (unwind-protect
+ (progn
+ (defun message (&rest args)
+ (setq current-message (apply original-message args)))
+ ,@body
+ current-message)
+ (fset 'message original-message)))
+ (progn
+ ,@body
+ (current-message))))
+
(defun org-babel-scheme-execute-with-geiser (code output impl repl)
"Execute code in specified REPL. If the REPL doesn't exist, create it
using the given scheme implementation.
@@ -142,10 +158,11 @@ is true; otherwise returns the last value."
(current-buffer)))))
(setq geiser-repl--repl repl-buffer)
(setq geiser-impl--implementation nil)
- (geiser-eval-region (point-min) (point-max))
+ (setq result (org-babel-scheme-capture-current-message
+ (geiser-eval-region (point-min) (point-max))))
(setq result
- (if (equal (substring (current-message) 0 3) "=> ")
- (replace-regexp-in-string "^=> " "" (current-message))
+ (if (and (stringp result) (equal (substring result 0 3) "=> "))
+ (replace-regexp-in-string "^=> " "" result)
"\"An error occurred.\""))
(when (not repl)
(save-current-buffer (set-buffer repl-buffer)
diff --git a/lisp/ob-sed.el b/lisp/ob-sed.el
new file mode 100644
index 0000000..9e3db37
--- /dev/null
+++ b/lisp/ob-sed.el
@@ -0,0 +1,107 @@
+;;; ob-sed.el --- org-babel functions for sed scripts
+
+;; Copyright (C) 2015 Free Software Foundation
+
+;; Author: Bjarte Johansen
+;; Keywords: literate programming, reproducible research
+;; Version: 0.1.0
+
+;; This file is part of GNU Emacs.
+
+;;; License:
+
+;; 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, 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:
+
+;; Provides a way to evaluate sed scripts in Org mode.
+
+;;; Usage:
+
+;; Add to your Emacs config:
+
+;; (org-babel-do-load-languages
+;; 'org-babel-load-languages
+;; '((sed . t)))
+
+;; In addition to the normal header arguments, ob-sed also provides
+;; :cmd-line and :in-file. :cmd-line allows one to pass other flags to
+;; the sed command like the "--in-place" flag which makes sed edit the
+;; file pass to it instead of outputting to standard out or to a
+;; different file. :in-file is a header arguments that allows one to
+;; tell Org Babel which file the sed script to act on.
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-sed-command "sed"
+ "Name of the sed executable command.")
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("sed" . "sed"))
+
+(defconst org-babel-header-args:sed
+ '((:cmd-line . :any)
+ (:in-file . :any))
+ "Sed specific header arguments.")
+
+(defvar org-babel-default-header-args:sed '()
+ "Default arguments for evaluating a sed source block.")
+
+(defun org-babel-execute:sed (body params)
+ "Execute a block of sed code with Org Babel.
+BODY is the source inside a sed source block and PARAMS is an
+association list over the source block configurations. This
+function is called by `org-babel-execute-src-block'."
+ (message "executing sed source code block")
+ (let* ((result-params (cdr (assq :result-params params)))
+ (cmd-line (cdr (assq :cmd-line params)))
+ (in-file (cdr (assq :in-file params)))
+ (code-file (let ((file (org-babel-temp-file "sed-")))
+ (with-temp-file file
+ (insert body)) file))
+ (stdin (let ((stdin (cdr (assq :stdin params))))
+ (when stdin
+ (let ((tmp (org-babel-temp-file "sed-stdin-"))
+ (res (org-babel-ref-resolve stdin)))
+ (with-temp-file tmp
+ (insert res))
+ tmp))))
+ (cmd (mapconcat #'identity
+ (remq nil
+ (list org-babel-sed-command
+ (format "--file=\"%s\"" code-file)
+ cmd-line
+ in-file))
+ " ")))
+ (org-babel-reassemble-table
+ (let ((results
+ (cond
+ (stdin (with-temp-buffer
+ (call-process-shell-command cmd stdin (current-buffer))
+ (buffer-string)))
+ (t (org-babel-eval cmd "")))))
+ (when results
+ (org-babel-result-cond result-params
+ results
+ (let ((tmp (org-babel-temp-file "sed-results-")))
+ (with-temp-file tmp (insert results))
+ (org-babel-import-elisp-from-file tmp)))))
+ (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-sed)
+;;; ob-sed.el ends here
diff --git a/lisp/ob-sh.el b/lisp/ob-shell.el
index 856c7a0..3ee2f4d 100644
--- a/lisp/ob-sh.el
+++ b/lisp/ob-shell.el
@@ -1,4 +1,4 @@
-;;; ob-sh.el --- org-babel functions for shell evaluation
+;;; ob-shell.el --- org-babel functions for shell evaluation
;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
@@ -36,19 +36,25 @@
(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body))
(declare-function orgtbl-to-generic "org-table" (table params))
-(defvar org-babel-default-header-args:sh '())
+(defvar org-babel-default-header-args:shell '())
-(defvar org-babel-sh-command "sh"
- "Command used to invoke a shell.
-This will be passed to `shell-command-on-region'")
-
-(defcustom org-babel-sh-var-quote-fmt
- "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)"
- "Format string used to escape variables when passed to shell scripts."
+(defcustom org-babel-shell-names
+ '("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh")
+ "List of names of shell supported by babel shell code blocks."
:group 'org-babel
- :type 'string)
+ :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))))
-(defun org-babel-execute:sh (body params)
+(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
@@ -56,68 +62,108 @@ This function is called by `org-babel-execute-src-block'."
(stdin (let ((stdin (cdr (assoc :stdin params))))
(when stdin (org-babel-sh-var-to-string
(org-babel-ref-resolve stdin)))))
+ (cmdline (cdr (assoc :cmdline params)))
(full-body (org-babel-expand-body:generic
- body params (org-babel-variable-assignments:sh params))))
+ body params (org-babel-variable-assignments:shell params))))
(org-babel-reassemble-table
- (org-babel-sh-evaluate session full-body params stdin)
+ (org-babel-sh-evaluate session full-body params stdin cmdline)
(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))))))
-(defun org-babel-prep-session:sh (session params)
+(defun org-babel-prep-session:shell (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(let* ((session (org-babel-sh-initiate-session session))
- (var-lines (org-babel-variable-assignments:sh params)))
+ (var-lines (org-babel-variable-assignments:shell params)))
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)) var-lines))
session))
-(defun org-babel-load-session:sh (session body params)
+(defun org-babel-load-session:shell (session body params)
"Load BODY into SESSION."
(save-window-excursion
- (let ((buffer (org-babel-prep-session:sh session params)))
+ (let ((buffer (org-babel-prep-session:shell 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:sh-generic
+ (varname values &optional sep hline)
+ "Returns a list of statements declaring the values as a generic variable."
+ (format "%s=%s" varname (org-babel-sh-var-to-sh values sep hline)))
+
+(defun org-babel-variable-assignments:bash_array
+ (varname values &optional sep hline)
+ "Returns a list of statements declaring the values as a bash array."
+ (format "unset %s\ndeclare -a %s=( %s )"
+ varname varname
+ (mapconcat
+ (lambda (value) (org-babel-sh-var-to-sh value sep hline))
+ values
+ " ")))
+
+(defun org-babel-variable-assignments:bash_assoc
+ (varname values &optional sep hline)
+ "Returns a list of statements declaring the values as bash associative array."
+ (format "unset %s\ndeclare -A %s\n%s"
+ varname varname
+ (mapconcat
+ (lambda (items)
+ (format "%s[%s]=%s"
+ varname
+ (org-babel-sh-var-to-sh (car items) sep hline)
+ (org-babel-sh-var-to-sh (cdr items) sep hline)))
+ values
+ "\n")))
-(defun org-babel-variable-assignments:sh (params)
+(defun org-babel-variable-assignments:bash (varname values &optional sep hline)
+ "Represents the parameters as useful Bash shell variables."
+ (if (listp values)
+ (if (and (listp (car values)) (= 1 (length (car values))))
+ (org-babel-variable-assignments:bash_array varname values sep hline)
+ (org-babel-variable-assignments:bash_assoc varname values sep hline))
+ (org-babel-variable-assignments:sh-generic varname values sep hline)))
+
+(defun org-babel-variable-assignments:shell (params)
"Return list of shell statements assigning the block's variables."
- (let ((sep (cdr (assoc :separator params))))
+ (let ((sep (cdr (assoc :separator params)))
+ (hline (when (string= "yes" (cdr (assoc :hlines params)))
+ (or (cdr (assoc :hline-string params))
+ "hline"))))
(mapcar
(lambda (pair)
- (format "%s=%s"
- (car pair)
- (org-babel-sh-var-to-sh (cdr pair) sep)))
+ (if (string-match "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)))))
-(defun org-babel-sh-var-to-sh (var &optional sep)
+(defun org-babel-sh-var-to-sh (var &optional sep hline)
"Convert an elisp value to a shell variable.
Convert an elisp var into a string of shell commands specifying a
var of the same value."
- (format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep)))
+ (concat "'" (replace-regexp-in-string
+ "'" "'\"'\"'"
+ (org-babel-sh-var-to-string var sep hline))
+ "'"))
-(defun org-babel-sh-var-to-string (var &optional sep)
+(defun org-babel-sh-var-to-string (var &optional sep hline)
"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)))
- (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
+ (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-table-or-results (results)
- "Convert RESULTS to an appropriate elisp value.
-If the results look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
(defun org-babel-sh-initiate-session (&optional session params)
"Initiate a session named SESSION according to PARAMS."
(when (and session (not (string= session "none")))
@@ -136,14 +182,14 @@ Emacs-lisp table, otherwise return the results as a string."
(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
"String to indicate that evaluation has completed.")
-(defun org-babel-sh-evaluate (session body &optional params stdin)
+(defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
"Pass BODY to the Shell 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."
(let ((results
(cond
- (stdin ; external shell script w/STDIN
+ ((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)))
@@ -153,14 +199,14 @@ return the value of the last statement in BODY."
(when padline (insert "\n"))
(insert body))
(set-file-modes script-file #o755)
- (with-temp-file stdin-file (insert stdin))
+ (with-temp-file stdin-file (insert (or stdin "")))
(with-temp-buffer
(call-process-shell-command
- (if shebang
- script-file
- (format "%s %s" org-babel-sh-command script-file))
+ (concat (if shebang script-file
+ (format "%s %s" shell-file-name script-file))
+ (and cmdline (concat " " cmdline)))
stdin-file
- (current-buffer))
+ (current-buffer))
(buffer-string))))
(session ; session evaluation
(mapconcat
@@ -196,7 +242,7 @@ return the value of the last statement in BODY."
(insert body))
(set-file-modes script-file #o755)
(org-babel-eval script-file ""))
- (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
+ (org-babel-eval shell-file-name (org-babel-trim body)))))))
(when results
(let ((result-params (cdr (assoc :result-params params))))
(org-babel-result-cond result-params
@@ -211,8 +257,8 @@ return the value of the last statement in BODY."
(setq string (substring string (match-end 0))))
string)
-(provide 'ob-sh)
+(provide 'ob-shell)
-;;; ob-sh.el ends here
+;;; ob-shell.el ends here
diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index 08d4419..c29b175 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -36,6 +36,7 @@
;; - engine
;; - cmdline
;; - dbhost
+;; - dbport
;; - dbuser
;; - dbpassword
;; - database
@@ -68,6 +69,7 @@
'((engine . :any)
(out-file . :any)
(dbhost . :any)
+ (dbport . :any)
(dbuser . :any)
(dbpassword . :any)
(database . :any))
@@ -78,21 +80,32 @@
(org-babel-sql-expand-vars
body (mapcar #'cdr (org-babel-get-header params :var))))
-(defun dbstring-mysql (host user password database)
+(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."
(combine-and-quote-strings
- (remq nil
+ (delq nil
(list (when host (concat "-h" host))
+ (when port (format "-P%d" port))
(when user (concat "-u" user))
(when password (concat "-p" password))
(when database (concat "-D" database))))))
+(defun org-babel-sql-dbstring-postgresql (host 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 user (concat "-U" user))
+ (when database (concat "-d" database))))))
+
(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)))
+ (dbport (cdr (assq :dbport params)))
(dbuser (cdr (assoc :dbuser params)))
(dbpassword (cdr (assoc :dbpassword params)))
(database (cdr (assoc :database params)))
@@ -117,13 +130,16 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
('mysql (format "mysql %s %s %s < %s > %s"
- (dbstring-mysql dbhost dbuser dbpassword database)
+ (org-babel-sql-dbstring-mysql
+ dbhost dbport dbuser dbpassword database)
(if colnames-p "" "-N")
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
('postgresql (format
- "psql -A -P footer=off -F \"\t\" -f %s -o %s %s"
+ "psql --set=\"ON_ERROR_STOP=1\" %s -A -P footer=off -F \"\t\" %s -f %s -o %s %s"
+ (if colnames-p "" "-t")
+ (org-babel-sql-dbstring-postgresql dbhost dbuser database)
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)
(or cmdline "")))
diff --git a/lisp/ob-table.el b/lisp/ob-table.el
index 831e352..b2a8da6 100644
--- a/lisp/ob-table.el
+++ b/lisp/ob-table.el
@@ -47,7 +47,10 @@
;; | 7 | |
;; | 8 | |
;; | 9 | |
-;; #+TBLFM: $2='(org-sbe 'fibbd (n $1))
+;; #+TBLFM: $2='(org-sbe "fibbd" (n $1))
+
+;; NOTE: The quotation marks around the function name, 'fibbd' here,
+;; are optional.
;;; Code:
(require 'ob-core)
@@ -62,23 +65,30 @@ character and replace it with ellipses."
(defmacro org-sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with VARIABLES.
-Each element of VARIABLES should be a two
-element list, whose first element is the name of the variable and
-second element is a string of its value. The following call to
-`org-sbe' would be equivalent to the following source code block.
- (org-sbe 'source-block (n $2) (m 3))
+Each element of VARIABLES should be a list of two elements: the
+first element is the name of the variable and second element is a
+string of its value.
+
+So this `org-sbe' construct
+
+ (org-sbe \"source-block\" (n $2) (m 3))
+
+is the equivalent of the following source code block:
+
+ #+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
+ results
+ #+end_src
-#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
-results
-#+end_src
+NOTE: The quotation marks around the function name,
+'source-block', are optional.
-NOTE: by default string variable names are interpreted as
+NOTE: By default, string variable names are interpreted as
references to source-code blocks, to force interpretation of a
cell's value as a string, prefix the identifier a \"$\" (e.g.,
\"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\").
-NOTE: it is also possible to pass header arguments to the code
+NOTE: It is also possible to pass header arguments to the code
block. In this case a table cell should hold the string value of
the header argument which can then be passed before all variables
as shown in the example below.
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 3a43b42..385d8e2 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -27,21 +27,24 @@
;;; Code:
(require 'org-src)
-(eval-when-compile
- (require 'cl))
+(declare-function make-directory "files" (dir &optional parents))
+(declare-function org-babel-update-block-body "org" (new-body))
+(declare-function org-back-to-heading "org" (invisible-ok))
+(declare-function org-before-first-heading-p "org" ())
(declare-function org-edit-special "org" (&optional arg))
+(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-store-link "org" (arg))
(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
-(declare-function org-heading-components "org" ())
-(declare-function org-back-to-heading "org" (invisible-ok))
-(declare-function org-fill-template "org" (template alist))
-(declare-function org-babel-update-block-body "org" (new-body))
-(declare-function make-directory "files" (dir &optional parents))
+(declare-function org-store-link "org" (arg))
+(declare-function org-up-heading-safe "org" ())
+(declare-function outline-previous-heading "outline" ())
(defcustom org-babel-tangle-lang-exts
- '(("emacs-lisp" . "el"))
+ '(("emacs-lisp" . "el")
+ ("elisp" . "el"))
"Alist mapping languages to their file extensions.
The key is the language name, the value is the string that should
be inserted as the extension commonly used to identify files
@@ -54,6 +57,11 @@ then the name of the language is used."
(string "Language name")
(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."
+ :group 'org-babel-tangle
+ :type 'boolean)
+
(defcustom org-babel-post-tangle-hook nil
"Hook run in code files tangled by `org-babel-tangle'."
:group 'org-babel
@@ -81,6 +89,11 @@ information into the output using `org-fill-template'.
%link --------- Org-mode style link to the code block
%source-name -- name of the code block
+Upon insertion the formatted comment will be commented out, and
+followed by a newline. To inhibit this post-insertion processing
+set the `org-babel-tangle-uncomment-comments' variable to a
+non-nil value.
+
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
@@ -96,17 +109,30 @@ information into the output using `org-fill-template'.
%link --------- Org-mode style link to the code block
%source-name -- name of the code block
+Upon insertion the formatted comment will be commented out, and
+followed by a newline. To inhibit this post-insertion processing
+set the `org-babel-tangle-uncomment-comments' variable to a
+non-nil value.
+
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:version "24.1"
:type 'string)
-(defcustom org-babel-process-comment-text #'org-babel-trim
+(defcustom org-babel-tangle-uncomment-comments nil
+ "Inhibits automatic commenting and addition of trailing newline
+of tangle comments. Use `org-babel-tangle-comment-format-beg'
+and `org-babel-tangle-comment-format-end' to customize the format
+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
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-babel-trim'."
+result. The default value is `org-remove-indentation'."
:group 'org-babel
:version "24.1"
:type 'function)
@@ -176,12 +202,12 @@ used to limit the exported source code blocks by language."
(run-hooks 'org-babel-pre-tangle-hook)
;; Possibly Restrict the buffer to the current code block
(save-restriction
- (when (equal arg '(4))
- (let ((head (org-babel-where-is-src-block-head)))
+ (save-excursion
+ (when (equal arg '(4))
+ (let ((head (org-babel-where-is-src-block-head)))
(if head
(goto-char head)
(user-error "Point is not in a source code block"))))
- (save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
(if target-file
@@ -246,6 +272,10 @@ used to limit the exported source code blocks by language."
(if (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))))
+ (= (point) (point-min)))
+ (insert "\n"))
(insert content)
(write-region nil nil file-name))))
;; if files contain she-bangs, then make the executable
@@ -304,13 +334,23 @@ that the appropriate major-mode is set. SPEC has the form:
\(start-line file link source-name params body comment)"
(let* ((start-line (nth 0 spec))
- (file (nth 1 spec))
- (link (nth 2 spec))
+ (file (if org-babel-tangle-use-relative-file-links
+ (file-relative-name (nth 1 spec))
+ (nth 1 spec)))
+ (link (let ((link (nth 2 spec)))
+ (if org-babel-tangle-use-relative-file-links
+ (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
+ (let* ((type (match-string 1 link))
+ (path (match-string 2 link))
+ (origpath path)
+ (case-fold-search nil))
+ (setq path (file-relative-name path))
+ (concat type path)))
+ link)))
(source-name (nth 3 spec))
(body (nth 5 spec))
(comment (nth 6 spec))
(comments (cdr (assoc :comments (nth 4 spec))))
- (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
(link-p (or (string= comments "both") (string= comments "link")
(string= comments "yes") (string= comments "noweb")))
(link-data (mapcar (lambda (el)
@@ -321,15 +361,20 @@ that the appropriate major-mode is set. SPEC has the form:
(insert-comment (lambda (text)
(when (and comments (not (string= comments "no"))
(> (length text) 0))
- (when padline (insert "\n"))
- (comment-region (point) (progn (insert text) (point)))
- (end-of-line nil) (insert "\n")))))
+ (if org-babel-tangle-uncomment-comments
+ ;; just plain comments with no processing
+ (insert text)
+ ;; ensure comments are made to be
+ ;; comments, and add a trailing newline
+ (comment-region
+ (point) (progn (insert text) (point)))
+ (end-of-line nil)
+ (insert "\n"))))))
(when comment (funcall insert-comment comment))
(when link-p
(funcall
insert-comment
(org-fill-template org-babel-tangle-comment-format-beg link-data)))
- (when padline (insert "\n"))
(insert
(format
"%s\n"
@@ -340,49 +385,36 @@ that the appropriate major-mode is set. SPEC has the form:
insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data)))))
-(defvar org-comment-string) ;; Defined in org.el
(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
- "Collect source blocks in the current Org-mode file.
+ "Collect source blocks in the current Org file.
Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
Optional argument LANGUAGE can be used to limit the collected
source code blocks by language. Optional argument TANGLE-FILE
can be used to limit the collected code blocks by target file."
- (let ((block-counter 1) (current-heading "") blocks by-lang)
+ (let ((counter 0) last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name)
- (lambda (new-heading)
- (if (not (string= new-heading current-heading))
- (progn
- (setq block-counter 1)
- (setq current-heading new-heading))
- (setq block-counter (+ 1 block-counter))))
- (replace-regexp-in-string "[ \t]" "-"
- (condition-case nil
- (or (nth 4 (org-heading-components))
- "(dummy for heading without text)")
- (error (buffer-file-name))))
- (let* ((info (org-babel-get-src-block-info 'light))
- (src-lang (nth 0 info))
- (src-tfile (cdr (assoc :tangle (nth 2 info)))))
- (unless (or (string-match (concat "^" org-comment-string) current-heading)
- (string= (cdr (assoc :tangle (nth 2 info))) "no")
- (and tangle-file (not (equal tangle-file src-tfile))))
- (unless (and language (not (string= language src-lang)))
- ;; Add the spec for this block to blocks under it's language
- (setq by-lang (cdr (assoc src-lang blocks)))
- (setq blocks (delq (assoc src-lang blocks) blocks))
- (setq blocks (cons
- (cons src-lang
- (cons
- (org-babel-tangle-single-block
- block-counter)
- by-lang)) blocks))))))
- ;; Ensure blocks are in the correct order
- (setq blocks
- (mapcar
- (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
- blocks))
- blocks))
+ (let ((current-heading-pos
+ (org-with-wide-buffer
+ (org-with-limited-levels (outline-previous-heading)))))
+ (cond ((eq last-heading-pos current-heading-pos) (incf counter))
+ ((= counter 1))
+ (t (setq counter 1))))
+ (unless (org-in-commented-heading-p)
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (src-lang (nth 0 info))
+ (src-tfile (cdr (assq :tangle (nth 2 info)))))
+ (unless (or (string= (cdr (assq :tangle (nth 2 info))) "no")
+ (and tangle-file (not (equal tangle-file src-tfile)))
+ (and language (not (string= language src-lang))))
+ ;; Add the spec for this block to blocks under its
+ ;; language.
+ (let ((by-lang (assoc src-lang blocks))
+ (block (org-babel-tangle-single-block counter)))
+ (if by-lang (setcdr by-lang (cons block (cdr by-lang)))
+ (push (cons src-lang (list block)) blocks)))))))
+ ;; Ensure blocks are in the correct order.
+ (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks)))
(defun org-babel-tangle-single-block
(block-counter &optional only-this-block)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index c11c1c8..c5cd21d 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -1,6 +1,6 @@
;;; org-agenda.el --- Dynamic task and appointment lists for Org
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -52,7 +52,7 @@
(declare-function diary-add-to-list "diary-lib"
(date string specifier &optional marker globcolor literal))
-(declare-function calendar-absolute-from-iso "cal-iso" (date))
+(declare-function calendar-iso-to-absolute "cal-iso" (date))
(declare-function calendar-astro-date-string "cal-julian" (&optional date))
(declare-function calendar-bahai-date-string "cal-bahai" (&optional date))
(declare-function calendar-chinese-date-string "cal-china" (&optional date))
@@ -69,6 +69,7 @@
(declare-function calendar-persian-date-string "cal-persia" (&optional date))
(declare-function calendar-check-holidays "holidays" (date))
+(declare-function org-columns-remove-overlays "org-colview" ())
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
(declare-function org-columns-quit "org-colview" ())
@@ -360,6 +361,12 @@ the daily/weekly agenda, see `org-agenda-skip-function'.")
(const :format "" quote)
(repeat
(string :tag "+tag or -tag"))))
+ (list :tag "Effort filter preset"
+ (const org-agenda-effort-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+=10 or -=10 or +<10 or ->10"))))
(list :tag "Regexp filter preset"
(const org-agenda-regexp-filter-preset)
(list
@@ -610,15 +617,6 @@ or `C-c a #' to produce the list."
(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")))
-(defcustom org-agenda-filter-effort-default-operator "<"
- "The default operator for effort estimate filtering.
-If you select an effort estimate limit without first pressing an operator,
-this one will be used."
- :group 'org-agenda-custom-commands
- :type '(choice (const :tag "less or equal" "<")
- (const :tag "greater or equal"">")
- (const :tag "equal" "=")))
-
(defgroup org-agenda-skip nil
"Options concerning skipping parts of agenda files."
:tag "Org Agenda Skip"
@@ -1097,6 +1095,7 @@ Possible values for this option are:
current-window Show agenda in the current window, keeping all other windows.
other-window Use `switch-to-buffer-other-window' to display agenda.
+only-window Show agenda, deleting all other windows.
reorganize-frame Show only two windows on the current frame, the current
window and the agenda.
other-frame Use `switch-to-buffer-other-frame' to display agenda.
@@ -1107,6 +1106,7 @@ See also the variable `org-agenda-restore-windows-after-quit'."
(const current-window)
(const other-frame)
(const other-window)
+ (const only-window)
(const reorganize-frame)))
(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
@@ -2070,7 +2070,7 @@ When nil, `q' will kill the single agenda buffer."
(setq org-agenda-sticky new-value)
(org-agenda-kill-all-agenda-buffers)
(and (org-called-interactively-p 'interactive)
- (message "Sticky agenda was %s"
+ (message "Sticky agenda %s"
(if org-agenda-sticky "enabled" "disabled"))))))
(defvar org-agenda-buffer nil
@@ -2080,6 +2080,8 @@ When nil, `q' will kill the single agenda buffer."
(defvar org-agenda-this-buffer-name nil)
(defvar org-agenda-doing-sticky-redo nil)
(defvar org-agenda-this-buffer-is-sticky nil)
+(defvar org-agenda-last-indirect-buffer nil
+ "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.")
(defconst org-agenda-local-vars
'(org-agenda-this-buffer-name
@@ -2101,8 +2103,10 @@ When nil, `q' will kill the single agenda buffer."
org-agenda-category-filter
org-agenda-top-headline-filter
org-agenda-regexp-filter
+ org-agenda-effort-filter
org-agenda-markers
org-agenda-last-search-view-search-was-boolean
+ org-agenda-last-indirect-buffer
org-agenda-filtered-by-category
org-agenda-filter-form
org-agenda-cycle-counter
@@ -2309,6 +2313,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
+(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)
@@ -2322,6 +2327,10 @@ The following commands are available:
(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse)
(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse)
+
+(define-key org-agenda-mode-map [remap forward-paragraph] 'org-agenda-forward-block)
+(define-key org-agenda-mode-map [remap backward-paragraph] 'org-agenda-backward-block)
+
(when org-agenda-mouse-1-follows-link
(org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
@@ -2538,7 +2547,7 @@ For example, if you have a custom agenda command \"p\" and you
want this command to be accessible only from plain text files,
use this:
- '((\"p\" ((in-file . \"\\.txt\"))))
+ '((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))
Here are the available contexts definitions:
@@ -2556,7 +2565,7 @@ accessible if there is at least one valid check.
You can also bind a key to another agenda custom command
depending on contextual rules.
- '((\"p\" \"q\" ((in-file . \"\\.txt\"))))
+ '((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))
Here it means: in .txt files, use \"p\" as the key for the
agenda command otherwise associated with \"q\". (The command
@@ -3067,10 +3076,13 @@ L Timeline for current buffer # List stuck projects (!=configure)
"Fit the window to the buffer size."
(and (memq org-agenda-window-setup '(reorganize-frame))
(fboundp 'fit-window-to-buffer)
- (org-fit-window-to-buffer
- nil
- (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
- (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
+ (if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
+ (= (car org-agenda-window-frame-fractions) 1.0))
+ (delete-other-windows)
+ (org-fit-window-to-buffer
+ nil
+ (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
+ (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))))
(defvar org-cmd nil)
(defvar org-agenda-overriding-cmd nil)
@@ -3306,19 +3318,20 @@ This ensures the export commands can easily use it."
(defvar org-agenda-write-buffer-name "Agenda View")
(defun org-agenda-write (file &optional open nosettings agenda-bufname)
"Write the current buffer (an agenda view) as a file.
+
Depending on the extension of the file name, plain text (.txt),
HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
-If the extension is .ics, run icalendar export over all files used
-to construct the agenda and limit the export to entries listed in the
-agenda now.
-If the extension is .org, collect all subtrees corresponding to the
-agenda entries and add them in an .org file.
-With prefix argument OPEN, open the new file immediately.
-If NOSETTINGS is given, do not scope the settings of
-`org-agenda-exporter-settings' into the export commands. This is used when
-the settings have already been scoped and we do not wish to overrule other,
-higher priority settings.
-If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
+If the extension is .ics, translate visible agenda into iCalendar
+format. If the extension is .org, collect all subtrees
+corresponding to the agenda entries and add them in an .org file.
+
+With prefix argument OPEN, open the new file immediately. If
+NOSETTINGS is given, do not scope the settings of
+`org-agenda-exporter-settings' into the export commands. This is
+used when the settings have already been scoped and we do not
+wish to overrule other, higher priority settings. If
+AGENDA-BUFFER-NAME is provided, use this as the buffer name for
+the agenda to write."
(interactive "FWrite agenda to file: \nP")
(if (or (not (file-writable-p file))
(and (file-exists-p file)
@@ -3531,6 +3544,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(defvar org-agenda-tag-filter nil)
(defvar org-agenda-category-filter nil)
(defvar org-agenda-regexp-filter nil)
+(defvar org-agenda-effort-filter nil)
(defvar org-agenda-top-headline-filter nil)
(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
@@ -3562,6 +3576,16 @@ the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
+(defvar org-agenda-effort-filter-preset nil
+ "A preset of the effort condition used for secondary agenda filtering.
+This must be a list of strings, each string must be a single regexp
+preceded by \"+\" or \"-\".
+This variable should not be set directly, but agenda custom commands can
+bind it in the options section. The preset filter is a global property of
+the entire agenda view. In a block agenda, it will not work reliably to
+define a filter for one of the individual blocks. You need to set it in
+the global options and expect it to be applied to the entire view.")
+
(defun org-agenda-use-sticky-p ()
"Return non-nil if an agenda buffer named
`org-agenda-buffer-name' exists and should be shown instead of
@@ -3599,24 +3623,31 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-switch-to-buffer-other-window abuf))
((equal 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)
(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)))
;; 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))
(setq org-agenda-pre-window-conf
- (or org-agenda-pre-window-conf wconf))))
+ (or wconf org-agenda-pre-window-conf))))
(defun org-agenda-prepare (&optional name)
(let ((filter-alist (if org-agenda-persistent-filter
- (list `(tag . ,org-agenda-tag-filter)
- `(re . ,org-agenda-regexp-filter)
- `(car . ,org-agenda-category-filter)))))
+ (with-current-buffer
+ (get-buffer-create org-agenda-buffer-name)
+ (list `(tag . ,org-agenda-tag-filter)
+ `(re . ,org-agenda-regexp-filter)
+ `(effort . ,org-agenda-effort-filter)
+ `(cat . ,org-agenda-category-filter))))))
(if (org-agenda-use-sticky-p)
(progn
(put 'org-agenda-tag-filter :preset-filter nil)
@@ -3629,13 +3660,14 @@ FILTER-ALIST is an alist of filters we need to apply when
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
(setq org-todo-keywords-for-agenda nil)
- (setq org-drawers-for-agenda nil)
(put 'org-agenda-tag-filter :preset-filter
org-agenda-tag-filter-preset)
(put 'org-agenda-category-filter :preset-filter
org-agenda-category-filter-preset)
(put 'org-agenda-regexp-filter :preset-filter
org-agenda-regexp-filter-preset)
+ (put 'org-agenda-effort-filter :preset-filter
+ org-agenda-effort-filter-preset)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
@@ -3649,7 +3681,6 @@ FILTER-ALIST is an alist of filters we need to apply when
"\n"))
(narrow-to-region (point) (point-max)))
(setq org-done-keywords-for-agenda nil)
-
;; Setting any org variables that are in org-agenda-local-vars
;; list need to be done after the prepare call
(org-agenda-prepare-window
@@ -3666,7 +3697,6 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-uniquify org-todo-keywords-for-agenda))
(setq org-done-keywords-for-agenda
(org-uniquify org-done-keywords-for-agenda))
- (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
(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)
@@ -3733,10 +3763,10 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-agenda-filter-top-headline-apply
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
(when (get 'org-agenda-tag-filter :preset-filter)
(org-agenda-filter-apply
- (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (get 'org-agenda-tag-filter :preset-filter) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
(when (get 'org-agenda-category-filter :preset-filter)
@@ -3747,6 +3777,11 @@ FILTER-ALIST is an alist of filters we need to apply when
(when (get 'org-agenda-regexp-filter :preset-filter)
(org-agenda-filter-apply
(get 'org-agenda-regexp-filter :preset-filter) 'regexp))
+ (when org-agenda-effort-filter
+ (org-agenda-filter-apply org-agenda-effort-filter 'effort))
+ (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)))))
(defun org-agenda-mark-clocking-task ()
@@ -3782,7 +3817,7 @@ FILTER-ALIST is an alist of filters we need to apply when
"Make highest priority lines bold, and lowest italic."
(interactive)
(mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority)
- (delete-overlay o)))
+ (delete-overlay o)))
(overlays-in (point-min) (point-max)))
(save-excursion
(let (b e p ov h l)
@@ -3800,16 +3835,17 @@ FILTER-ALIST is an alist of filters we need to apply when
ov (make-overlay b e))
(overlay-put
ov 'face
- (cons (cond ((org-face-from-face-or-color
- 'priority nil
- (cdr (assoc p org-priority-faces))))
- ((and (listp org-agenda-fontify-priorities)
- (org-face-from-face-or-color
- 'priority nil
- (cdr (assoc p org-agenda-fontify-priorities)))))
- ((equal p l) 'italic)
- ((equal p h) 'bold))
- 'org-priority))
+ (let ((special-face
+ (cond ((org-face-from-face-or-color
+ 'priority nil
+ (cdr (assoc p org-priority-faces))))
+ ((and (listp org-agenda-fontify-priorities)
+ (org-face-from-face-or-color
+ 'priority nil
+ (cdr (assoc p org-agenda-fontify-priorities)))))
+ ((equal p l) 'italic)
+ ((equal p h) 'bold))))
+ (if special-face (list special-face 'org-priority) 'org-priority)))
(overlay-put ov 'org-type 'org-priority)))))
(defvar org-depend-tag-blocked)
@@ -3847,8 +3883,7 @@ dimming them."
e (point-at-eol)
ov (make-overlay b e))
(if invis1
- (progn (overlay-put ov 'invisible t)
- (overlay-put ov 'intangible t))
+ (overlay-put ov 'invisible t)
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
(overlay-put ov 'org-type 'org-blocked-todo))))))
(when (org-called-interactively-p 'interactive)
@@ -3908,9 +3943,9 @@ functions do."
(defun org-agenda-new-marker (&optional pos)
"Return a new agenda marker.
-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)))))
+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))
(if org-agenda-buffer
(with-current-buffer org-agenda-buffer
@@ -4444,7 +4479,7 @@ in `org-agenda-text-search-extra-files'."
(full-words org-agenda-search-view-force-full-words)
(org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
regexp rtn rtnall files file pos inherited-tags
- marker category category-pos level tags c neg re boolean
+ marker category level tags c neg re boolean
ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at)
(stringp string)
@@ -4610,7 +4645,6 @@ in `org-agenda-text-search-extra-files'."
(setq marker (org-agenda-new-marker (point))
category (org-get-category)
level (make-string (org-reduced-level (org-outline-level)) ? )
- category-pos (get-text-property (point) 'org-category-position)
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -4629,8 +4663,7 @@ in `org-agenda-text-search-extra-files'."
'org-todo-regexp org-todo-regexp
'level level
'org-complex-heading-regexp org-complex-heading-regexp
- 'priority 1000 'org-category category
- 'org-category-position category-pos
+ 'priority 1000
'type "search")
(push txt ee)
(goto-char (1- end))))))))))
@@ -5331,6 +5364,40 @@ the documentation of `org-diary'."
(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defvar org-agenda-sorting-strategy-selected nil)
+(defun org-agenda-entry-get-agenda-timestamp (pom)
+ "Retrieve timestamp information for sorting agenda views.
+Given a point or marker POM, returns a cons cell of the timestamp
+and the timestamp type relevant for the sorting strategy in
+`org-agenda-sorting-strategy-selected'."
+ (let (ts ts-date-type)
+ (save-match-data
+ (cond ((org-em 'scheduled-up 'scheduled-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get pom "SCHEDULED")
+ ts-date-type " scheduled"))
+ ((org-em 'deadline-up 'deadline-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get pom "DEADLINE")
+ ts-date-type " deadline"))
+ ((org-em 'ts-up 'ts-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get pom "TIMESTAMP")
+ ts-date-type " timestamp"))
+ ((org-em 'tsia-up 'tsia-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get pom "TIMESTAMP_IA")
+ ts-date-type " timestamp_ia"))
+ ((org-em 'timestamp-up 'timestamp-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (or (org-entry-get pom "SCHEDULED")
+ (org-entry-get pom "DEADLINE")
+ (org-entry-get pom "TIMESTAMP")
+ (org-entry-get pom "TIMESTAMP_IA"))
+ ts-date-type ""))
+ (t (setq ts-date-type "")))
+ (cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
+ ts-date-type))))
+
(defun org-agenda-get-todos ()
"Return the TODO information for agenda display."
(let* ((props (list 'face nil
@@ -5355,7 +5422,8 @@ the documentation of `org-diary'."
"|")
"\\|") "\\)"))
(t org-not-done-regexp))))
- marker priority category category-pos level tags todo-state ts-date ts-date-type
+ marker priority category level tags todo-state
+ ts-date ts-date-type ts-date-pair
ee txt beg end inherited-tags todo-state-end-pos)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5375,36 +5443,10 @@ the documentation of `org-diary'."
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
- ts-date (let (ts)
- (save-match-data
- (cond ((org-em 'scheduled-up 'scheduled-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "SCHEDULED")
- ts-date-type " scheduled"))
- ((org-em 'deadline-up 'deadline-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "DEADLINE")
- ts-date-type " deadline"))
- ((org-em 'ts-up 'ts-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "TIMESTAMP")
- ts-date-type " timestamp"))
- ((org-em 'tsia-up 'tsia-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "TIMESTAMP_IA")
- ts-date-type " timestamp_ia"))
- ((org-em 'timestamp-up 'timestamp-down
- org-agenda-sorting-strategy-selected)
- (setq ts (or (org-entry-get (point) "SCHEDULED")
- (org-entry-get (point) "DEADLINE")
- (org-entry-get (point) "TIMESTAMP")
- (org-entry-get (point) "TIMESTAMP_IA"))
- ts-date-type ""))
- (t (setq ts-date-type "")))
- (when ts (ignore-errors (org-time-string-to-absolute ts)))))
- category-pos (get-text-property (point) 'org-category-position)
- txt (org-trim
- (buffer-substring (match-beginning 2) (match-end 0)))
+ ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
+ ts-date (car ts-date-pair)
+ ts-date-type (cdr ts-date-pair)
+ txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -5418,10 +5460,9 @@ the documentation of `org-diary'."
priority (1+ (org-get-priority txt)))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
- 'priority priority 'org-category category
+ 'priority priority
'level level
'ts-date ts-date
- 'org-category-position category-pos
'type (concat "todo" ts-date-type) 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
@@ -5540,7 +5581,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
"\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
marker hdmarker deadlinep scheduledp clockp closedp inactivep
- donep tmp priority category category-pos level ee txt timestr tags
+ donep tmp priority category level ee txt timestr tags
b0 b3 e3 head todo-state end-of-match show-all warntime habitp
inherited-tags ts-date)
(goto-char (point-min))
@@ -5584,8 +5625,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
;; substring should only run to end of time stamp
(setq timestr (substring timestr 0 (match-end 0))))
(setq marker (org-agenda-new-marker b0)
- category (org-get-category b0)
- category-pos (get-text-property b0 'org-category-position))
+ category (org-get-category b0))
(save-excursion
(if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil)
@@ -5612,11 +5652,10 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq priority (org-get-priority txt))
(org-add-props txt props 'priority priority
'org-marker marker 'org-hd-marker hdmarker
- 'org-category category 'date date
+ 'date date
'level level
'ts-date
(ignore-errors (org-time-string-to-absolute timestr))
- 'org-category-position category-pos
'todo-state todo-state
'warntime warntime
'type "timestamp")
@@ -5635,7 +5674,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
- marker category extra category-pos level ee txt tags entry
+ marker category extra level ee txt tags entry
result beg b sexp sexp-entry todo-state warntime inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5654,7 +5693,6 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq marker (org-agenda-new-marker beg)
level (make-string (org-reduced-level (org-outline-level)) ? )
category (org-get-category beg)
- category-pos (get-text-property beg 'org-category-position)
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -5679,10 +5717,8 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq txt "SEXP entry returned empty string"))
(setq txt (org-agenda-format-item extra txt level category tags 'time))
(org-add-props txt props 'org-marker marker
- 'org-category category 'date date 'todo-state todo-state
- 'org-category-position category-pos
- 'level level
- 'type "sexp" 'warntime warntime)
+ 'date date 'todo-state todo-state
+ 'level level 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
@@ -5712,7 +5748,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(let ((calendar-date-style 'european) (european-calendar-style t))
(diary-date day month year mark))))
-;; Define the` org-class' function
+;; Define the `org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
"Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
@@ -5791,7 +5827,7 @@ please use `org-class' instead."
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))))
(org-agenda-search-headline-for-time nil)
- marker hdmarker priority category category-pos level tags closedp
+ marker hdmarker priority category level tags closedp
statep clockp state ee txt extra timestr rest clocked inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5803,7 +5839,6 @@ please use `org-class' instead."
clockp (not (or closedp statep))
state (and statep (match-string 2))
category (org-get-category (match-beginning 0))
- category-pos (get-text-property (match-beginning 0) 'org-category-position)
timestr (buffer-substring (match-beginning 0) (point-at-eol)))
(when (string-match "\\]" timestr)
;; substring should only run to end of time stamp
@@ -5855,9 +5890,7 @@ please use `org-class' instead."
(setq priority 100000)
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
- 'priority priority 'org-category category
- 'org-category-position category-pos
- 'level level
+ 'priority priority 'level level
'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
@@ -6003,7 +6036,7 @@ specification like [h]h:mm."
(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 category-pos level
+ 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)
(goto-char (point-min))
@@ -6063,8 +6096,7 @@ specification like [h]h:mm."
(not (= diff 0))))
(setq txt nil)
(setq category (org-get-category)
- warntime (get-text-property (point) 'org-appt-warntime)
- category-pos (get-text-property (point) 'org-category-position))
+ warntime (get-text-property (point) 'org-appt-warntime))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(throw :skip nil)
(goto-char (match-end 0))
@@ -6109,8 +6141,6 @@ specification like [h]h:mm."
'org-hd-marker (org-agenda-new-marker pos1)
'priority (+ (- diff)
(org-get-priority txt))
- 'org-category category
- 'org-category-position category-pos
'todo-state todo-state
'type (if upcomingp "upcoming-deadline" "deadline")
'date (if upcomingp date d2)
@@ -6150,7 +6180,7 @@ an hour specification like [h]h:mm."
0 'org-hd-marker a))
(cons (marker-position mm) a)))
deadline-results))
- d2 diff pos pos1 category category-pos level tags donep
+ 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)
@@ -6229,8 +6259,7 @@ an hour specification like [h]h:mm."
(setq habitp (if did-habit-check-p habitp
(and (functionp 'org-is-habit-p)
(org-is-habit-p))))
- (setq category (org-get-category)
- category-pos (get-text-property (point) 'org-category-position))
+ (setq category (org-get-category))
(if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
'repeated-after-deadline)
(org-get-deadline-time (point))
@@ -6298,8 +6327,6 @@ an hour specification like [h]h:mm."
'priority (if habitp
(org-habit-get-priority habitp)
(+ 94 (- 5 diff) (org-get-priority txt)))
- 'org-category category
- 'category-position category-pos
'org-habit-p habitp
'todo-state todo-state)
(push txt ee))))))
@@ -6317,7 +6344,7 @@ an hour specification like [h]h:mm."
(abbreviate-file-name buffer-file-name))))
(regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date))
- marker hdmarker ee txt d1 d2 s1 s2 category category-pos
+ marker hdmarker ee txt d1 d2 s1 s2 category
level todo-state tags pos head donep inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -6338,9 +6365,8 @@ an hour specification like [h]h:mm."
(setq donep (member todo-state org-done-keywords))
(if (and donep org-agenda-skip-timestamp-if-done)
(throw :skip t))
- (setq marker (org-agenda-new-marker (point)))
- (setq category (org-get-category)
- category-pos (get-text-property (point) 'org-category-position))
+ (setq marker (org-agenda-new-marker (point))
+ category (org-get-category))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil)
(goto-char (match-beginning 0))
@@ -6382,8 +6408,7 @@ an hour specification like [h]h:mm."
'type "block" 'date date
'level level
'todo-state todo-state
- 'priority (org-get-priority txt) 'org-category category
- 'org-category-position category-pos)
+ 'priority (org-get-priority txt))
(push txt ee))))
(goto-char pos)))
;; Sort the entries by expiration date.
@@ -6454,9 +6479,6 @@ Any match of REMOVE-RE will be removed from TXT."
org-agenda-hide-tags-regexp))
(let* ((category (or category
- (if (stringp org-category)
- org-category
- (and org-category (symbol-name org-category)))
(if buffer-file-name
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))
@@ -6465,15 +6487,17 @@ Any match of REMOVE-RE will be removed from TXT."
(category-icon (if category-icon
(propertize " " 'display category-icon)
""))
+ (effort (and (not (string= txt ""))
+ (get-text-property 1 'effort txt)))
;; time, tag, effort are needed for the eval of the prefix format
(tag (if tags (nth (1- (length tags)) tags) ""))
- time effort neffort
+ time
(ts (if dotime (concat
(if (stringp dotime) dotime "")
(and org-agenda-search-headline-for-time txt))))
(time-of-day (and dotime (org-get-time-of-day ts)))
stamp plain s0 s1 s2 rtn srp l
- duration thecategory breadcrumbs)
+ duration breadcrumbs)
(and (derived-mode-p 'org-mode) buffer-file-name
(add-to-list 'org-agenda-contributing-files buffer-file-name))
(when (and dotime time-of-day)
@@ -6524,16 +6548,6 @@ Any match of REMOVE-RE will be removed from TXT."
(concat (make-string (max (- 50 (length txt)) 1) ?\ )
(match-string 2 txt))
t t txt))))
- (when (derived-mode-p 'org-mode)
- (setq effort (ignore-errors (get-text-property 0 'org-effort txt))))
-
- ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as
- ;; current buffer, so move this check outside of above
- (if effort
- (setq neffort (org-duration-string-to-minutes effort)
- effort (setq effort (concat "[" effort "]")))
- ;; prevent erroring out with %e format when there is no effort
- (setq effort ""))
(when remove-re
(while (string-match remove-re txt)
@@ -6560,7 +6574,6 @@ Any match of REMOVE-RE will be removed from TXT."
(t ""))
extra (or (and (not habitp) extra) "")
category (if (symbolp category) (symbol-name category) category)
- thecategory (copy-sequence category)
level (or level ""))
(if (string-match org-bracket-link-regexp category)
(progn
@@ -6581,14 +6594,12 @@ Any match of REMOVE-RE will be removed from TXT."
;; And finally add the text properties
(remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
(org-add-props rtn nil
- 'org-category (if thecategory (downcase thecategory) category)
+ 'org-category category
'tags (mapcar 'org-downcase-keep-props tags)
'org-highest-priority org-highest-priority
'org-lowest-priority org-lowest-priority
'time-of-day time-of-day
'duration duration
- 'effort effort
- 'effort-minutes neffort
'breadcrumbs breadcrumbs
'txt txt
'level level
@@ -6642,7 +6653,7 @@ The modified list may contain inherited tags, and tags matched by
LIST is the list of agenda items formatted by `org-agenda-list'.
NDAYS is the span of the current agenda view.
-TODAYP is `t' when the current agenda view is on today."
+TODAYP is t when the current agenda view is on today."
(catch 'exit
(cond ((not org-agenda-use-time-grid) (throw 'exit list))
((and todayp (member 'today (car org-agenda-time-grid))))
@@ -6724,10 +6735,13 @@ and stored in the variable `org-prefix-format-compiled'."
(setq varform `(format ,f (org-eval ,(read (match-string 4 s)))))
(if opt
(setq varform
- `(if (equal "" ,var)
+ `(if (or (equal "" ,var) (equal nil ,var))
""
- (format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
- (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
+ (format ,f (concat ,var ,c))))
+ (setq varform
+ `(format ,f (if (or (equal ,var "")
+ (equal ,var nil)) ""
+ (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
(setq s (replace-match "%s" t nil s))
(push varform vars))
(setq vars (nreverse vars))
@@ -6814,7 +6828,7 @@ The optional argument TYPE tells the agenda type."
(t org-agenda-max-tags)))
(max-entries (cond ((listp org-agenda-max-entries)
(cdr (assoc type org-agenda-max-entries)))
- (t org-agenda-max-entries))) l)
+ (t org-agenda-max-entries))))
(when org-agenda-before-sorting-filter-function
(setq list
(delq nil
@@ -6824,7 +6838,9 @@ The optional argument TYPE tells the agenda type."
list (mapcar 'identity (sort list 'org-entries-lessp)))
(when max-effort
(setq list (org-agenda-limit-entries
- list 'effort-minutes max-effort 'identity)))
+ list 'effort-minutes max-effort
+ (lambda (e) (or e (if org-sort-agenda-noeffort-is-high
+ 32767 -1))))))
(when max-todo
(setq list (org-agenda-limit-entries list 'todo-state max-todo)))
(when max-tags
@@ -6842,26 +6858,39 @@ The optional argument TYPE tells the agenda type."
(delq nil
(mapcar
(lambda (e)
- (let ((pval (funcall fun (get-text-property 1 prop e))))
+ (let ((pval (funcall
+ fun (get-text-property (1- (length e))
+ prop e))))
(if pval (setq lim (+ lim pval)))
(cond ((and pval (<= lim (abs limit))) e)
((and include (not pval)) e))))
list)))
list)))
-(defun org-agenda-limit-interactively ()
+(defun org-agenda-limit-interactively (remove)
"In agenda, interactively limit entries to various maximums."
- (interactive)
- (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
- (num (string-to-number (read-from-minibuffer "How many? "))))
- (cond ((equal max ?e)
- (let ((org-agenda-max-entries num)) (org-agenda-redo)))
- ((equal max ?t)
- (let ((org-agenda-max-todos num)) (org-agenda-redo)))
- ((equal max ?T)
- (let ((org-agenda-max-tags num)) (org-agenda-redo)))
- ((equal max ?E)
- (let ((org-agenda-max-effort num)) (org-agenda-redo)))))
+ (interactive "P")
+ (if remove
+ (progn (setq org-agenda-max-entries nil
+ org-agenda-max-todos nil
+ org-agenda-max-tags nil
+ org-agenda-max-effort nil)
+ (org-agenda-redo))
+ (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
+ (msg (cond ((= max ?E) "How many minutes? ")
+ ((= max ?e) "How many entries? ")
+ ((= max ?t) "How many TODO entries? ")
+ ((= max ?T) "How many tagged entries? ")
+ (t (user-error "Wrong input"))))
+ (num (string-to-number (read-from-minibuffer msg))))
+ (cond ((equal max ?e)
+ (let ((org-agenda-max-entries num)) (org-agenda-redo)))
+ ((equal max ?t)
+ (let ((org-agenda-max-todos num)) (org-agenda-redo)))
+ ((equal max ?T)
+ (let ((org-agenda-max-tags num)) (org-agenda-redo)))
+ ((equal max ?E)
+ (let ((org-agenda-max-effort num)) (org-agenda-redo))))))
(org-agenda-fit-window-to-buffer))
(defun org-agenda-highlight-todo (x)
@@ -6907,25 +6936,25 @@ The optional argument TYPE tells the agenda type."
(substring x (match-end 3)))))))
x)))
-(defsubst org-cmp-priority (a b)
- "Compare the priorities of string A and B."
- (let ((pa (or (get-text-property 1 'priority a) 0))
- (pb (or (get-text-property 1 'priority b) 0)))
+(defsubst org-cmp-values (a b property)
+ "Compare the numeric value of text PROPERTY for string A and B."
+ (let ((pa (or (get-text-property (1- (length a)) property a) 0))
+ (pb (or (get-text-property (1- (length b)) property b) 0)))
(cond ((> pa pb) +1)
((< pa pb) -1))))
(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 'effort-minutes a) def))
- (eb (or (get-text-property 1 'effort-minutes b) def)))
+ (ea (or (get-text-property (1- (length a)) 'effort-minutes a) def))
+ (eb (or (get-text-property (1- (length b)) 'effort-minutes b) def)))
(cond ((> ea eb) +1)
((< ea eb) -1))))
(defsubst org-cmp-category (a b)
"Compare the string values of categories of strings A and B."
- (let ((ca (or (get-text-property 1 'org-category a) ""))
- (cb (or (get-text-property 1 'org-category b) "")))
+ (let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
+ (cb (or (get-text-property (1- (length b)) 'org-category b) "")))
(cond ((string-lessp ca cb) -1)
((string-lessp cb ca) +1))))
@@ -7035,8 +7064,11 @@ their type."
(time-up (and (org-em 'time-up 'time-down ss)
(org-cmp-time a b)))
(time-down (if time-up (- time-up) nil))
+ (stats-up (and (org-em 'stats-up 'stats-down ss)
+ (org-cmp-values a b 'org-stats)))
+ (stats-down (if stats-up (- stats-up) nil))
(priority-up (and (org-em 'priority-up 'priority-down ss)
- (org-cmp-priority a b)))
+ (org-cmp-values a b 'priority)))
(priority-down (if priority-up (- priority-up) nil))
(effort-up (and (org-em 'effort-up 'effort-down ss)
(org-cmp-effort a b)))
@@ -7086,6 +7118,7 @@ Restriction will be the file if TYPE is `file', or if type is the
universal prefix '(4), or if the cursor is before the first headline
in the file. Otherwise, restriction will be to the current subtree."
(interactive "P")
+ (org-agenda-remove-restriction-lock 'noupdate)
(and (equal type '(4)) (setq type 'file))
(setq type (cond
(type type)
@@ -7161,69 +7194,65 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
nil))))
(defun org-agenda-Quit ()
- "Exit the agenda and kill buffers loaded by `org-agenda'.
-Also restore the window configuration."
+ "Exit the agenda, killing the agenda buffer.
+Like `org-agenda-quit', but kill the buffer even when
+`org-agenda-sticky' is non-nil."
(interactive)
- (if org-agenda-columns-active
- (org-columns-quit)
- (let ((buf (current-buffer)))
- (if (eq org-agenda-window-setup 'other-frame)
- (progn
- (org-agenda-reset-markers)
- (kill-buffer buf)
- (org-columns-remove-overlays)
- (setq org-agenda-archives-mode nil)
- (delete-frame))
- (and (not (eq org-agenda-window-setup 'current-window))
- (not (one-window-p))
- (delete-window))
- (org-agenda-reset-markers)
- (kill-buffer buf)
- (org-columns-remove-overlays)
- (setq org-agenda-archives-mode nil)))
- (setq org-agenda-buffer nil)
- ;; Maybe restore the pre-agenda window configuration.
- (and org-agenda-restore-windows-after-quit
- (not (eq org-agenda-window-setup 'other-frame))
- org-agenda-pre-window-conf
- (set-window-configuration org-agenda-pre-window-conf)
- (setq org-agenda-pre-window-conf nil))))
+ (org-agenda--quit))
(defun org-agenda-quit ()
- "Exit the agenda and restore the window configuration.
-When `org-agenda-sticky' is non-nil, only bury the agenda."
+ "Exit the agenda.
+
+When `org-agenda-sticky' is non-nil, bury the agenda buffer
+instead of killing it.
+
+When `org-agenda-restore-windows-after-quit' is non-nil, restore
+the pre-agenda window configuration.
+
+When column view is active, exit column view instead of the
+agenda."
(interactive)
- (if (and (eq org-indirect-buffer-display 'other-window)
- org-last-indirect-buffer)
- (let ((org-last-indirect-window
- (get-buffer-window org-last-indirect-buffer)))
- (if org-last-indirect-window
- (delete-window org-last-indirect-window))))
+ (org-agenda--quit org-agenda-sticky))
+
+(defun org-agenda--quit (&optional bury)
(if org-agenda-columns-active
(org-columns-quit)
- (if org-agenda-sticky
- (let ((buf (current-buffer)))
- (if (eq org-agenda-window-setup 'other-frame)
- (progn
- (delete-frame))
- (and (not (eq org-agenda-window-setup 'current-window))
- (not (one-window-p))
- (delete-window)))
- (with-current-buffer buf
- (bury-buffer)
- ;; Maybe restore the pre-agenda window configuration.
- (and org-agenda-restore-windows-after-quit
- (not (eq org-agenda-window-setup 'other-frame))
- org-agenda-pre-window-conf
- (set-window-configuration org-agenda-pre-window-conf)
- (setq org-agenda-pre-window-conf nil))))
- (org-agenda-Quit))))
+ (let ((buf (current-buffer))
+ (wconf org-agenda-pre-window-conf)
+ (org-agenda-last-indirect-window
+ (and (eq org-indirect-buffer-display 'other-window)
+ org-agenda-last-indirect-buffer
+ (get-buffer-window org-agenda-last-indirect-buffer))))
+ (cond
+ ((eq org-agenda-window-setup 'other-frame)
+ (delete-frame))
+ ((and org-agenda-restore-windows-after-quit
+ wconf)
+ ;; Maybe restore the pre-agenda window configuration. Reset
+ ;; `org-agenda-pre-window-conf' before running
+ ;; `set-window-configuration', which loses the current buffer.
+ (setq org-agenda-pre-window-conf nil)
+ (set-window-configuration wconf))
+ (t
+ (when org-agenda-last-indirect-window
+ (delete-window org-agenda-last-indirect-window))
+ (and (not (eq org-agenda-window-setup 'current-window))
+ (not (one-window-p))
+ (delete-window))))
+ (if bury
+ (bury-buffer buf)
+ (kill-buffer buf)
+ (setq org-agenda-archives-mode nil
+ org-agenda-buffer nil)))))
(defun org-agenda-exit ()
- "Exit the agenda and restore the window configuration.
-Also kill Org-mode buffers loaded by `org-agenda'. Org-mode
-buffers visited directly by the user will not be touched."
+ "Exit the agenda, killing Org buffers loaded by the agenda.
+Like `org-agenda-Quit', but kill any buffers that were created by
+the agenda. Org buffers visited directly by the user will not be
+touched. Also, exit the agenda even if it is in column view."
(interactive)
+ (when org-agenda-columns-active
+ (org-columns-quit))
(org-release-buffers org-agenda-new-buffers)
(setq org-agenda-new-buffers nil)
(org-agenda-Quit))
@@ -7264,6 +7293,9 @@ in the agenda."
(cat-preset (get 'org-agenda-category-filter :preset-filter))
(re-filter org-agenda-regexp-filter)
(re-preset (get 'org-agenda-regexp-filter :preset-filter))
+ (effort-filter org-agenda-effort-filter)
+ (effort-preset (get 'org-agenda-effort-filter :preset-filter))
+ (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
@@ -7281,6 +7313,7 @@ in the agenda."
(put 'org-agenda-tag-filter :preset-filter nil)
(put 'org-agenda-category-filter :preset-filter nil)
(put 'org-agenda-regexp-filter :preset-filter nil)
+ (put 'org-agenda-effort-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(if series-redo-cmd
@@ -7291,16 +7324,20 @@ in the agenda."
org-agenda-tag-filter tag-filter
org-agenda-category-filter cat-filter
org-agenda-regexp-filter re-filter
+ org-agenda-effort-filter effort-filter
org-agenda-top-headline-filter top-hl-filter)
(message "Rebuilding agenda buffer...done")
(put 'org-agenda-tag-filter :preset-filter tag-preset)
(put 'org-agenda-category-filter :preset-filter cat-preset)
(put 'org-agenda-regexp-filter :preset-filter re-preset)
+ (put 'org-agenda-effort-filter :preset-filter effort-preset)
(let ((tag (or tag-filter tag-preset))
(cat (or cat-filter cat-preset))
- (re (or re-filter re-preset)))
- (when tag (org-agenda-filter-apply tag 'tag))
+ (effort (or effort-filter effort-preset))
+ (re (or re-filter re-preset)))
+ (when tag (org-agenda-filter-apply tag 'tag t))
(when cat (org-agenda-filter-apply cat 'category))
+ (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))
@@ -7318,7 +7355,7 @@ The category is that of the current line."
(if (and org-agenda-filtered-by-category
org-agenda-category-filter)
(org-agenda-filter-show-all-cat)
- (let ((cat (org-no-properties (get-text-property (point) 'org-category))))
+ (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
(cond
((and cat strip)
(org-agenda-filter-apply
@@ -7372,6 +7409,39 @@ With two prefix arguments, remove the regexp filters."
(org-agenda-filter-show-all-re)
(message "Regexp filter removed")))
+(defvar org-agenda-effort-filter nil)
+(defun org-agenda-filter-by-effort (strip)
+ "Filter agenda entries by effort.
+With no prefix argument, keep entries matching the effort condition.
+With one prefix argument, filter out entries matching the condition.
+With two prefix arguments, remove the effort filters."
+ (interactive "P")
+ (cond ((member strip '(nil 4))
+ (let ((efforts (org-split-string
+ (or (cdr (assoc (concat org-effort-property "_ALL")
+ org-global-properties))
+ "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00"
+ "")))
+ (eff -1)
+ 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)))
+ (t (org-agenda-filter-show-all-effort)
+ (message "Effort filter removed"))))
+
(defun org-agenda-filter-remove-all ()
"Remove all filters from the current agenda buffer."
(interactive)
@@ -7383,15 +7453,21 @@ With two prefix arguments, remove the regexp filters."
(org-agenda-filter-show-all-re))
(when org-agenda-top-headline-filter
(org-agenda-filter-show-all-top-filter))
+ (when org-agenda-effort-filter
+ (org-agenda-filter-show-all-effort))
(org-agenda-finalize))
-(defun org-agenda-filter-by-tag (strip &optional char narrow)
+(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 prefix argument STRIP, remove all lines that do have the tag.
-A lisp caller can specify CHAR. NARROW means that the new tag should be
-used to narrow the search - the interactive user can also press `-' or `+'
-to switch to narrowing."
+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."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(tag-chars (mapconcat
@@ -7399,46 +7475,26 @@ to switch to narrowing."
(cdr x))
(char-to-string (cdr x))
""))
- alist ""))
- (efforts (org-split-string
- (or (cdr (assoc (concat org-effort-property "_ALL")
- org-global-properties))
- "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00"
- "")))
- (effort-op org-agenda-filter-effort-default-operator)
- (effort-prompt "")
+ org-tag-alist-for-agenda ""))
+ (valid-char-list (append '(?\t ?\r ?/ ?. ?\s ?q)
+ (string-to-list tag-chars)))
+ (exclude (or exclude (equal arg '(4))))
+ (expand (not (equal arg '(16))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
- maybe-refresh a n tag)
+ a n tag)
(unless char
- (message
- "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
- (if narrow "Narrow" "Filter") tag-chars
- (if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char-exclusive)))
- (when (member char '(?+ ?-))
- ;; Narrowing down
- (cond ((equal char ?-) (setq strip t narrow t))
- ((equal char ?+) (setq strip nil narrow t)))
- (message
- "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
- (setq char (read-char-exclusive)))
- (when (member char '(?< ?> ?= ??))
- ;; An effort operator
- (setq effort-op (char-to-string char))
- (setq alist nil) ; to make sure it will be interpreted as effort.
- (unless (equal char ??)
- (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 " effort-op effort-prompt)
+ (while (not (memq char valid-char-list))
+ (message
+ "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
+ (if exclude "Exclude" "Filter") tag-chars
+ (if org-agenda-auto-exclude-function "[RET], " "")
+ (if expand "" ", no grouptag expand"))
(setq char (read-char-exclusive))
- (when (or (< char ?0) (> char ?9))
- (error "Need 1-9,0 to select effort"))))
- (when (equal char ?\t)
+ ;; Excluding or filtering down
+ (cond ((eq char ?-) (setq exclude t))
+ ((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)))
@@ -7446,7 +7502,7 @@ to switch to narrowing."
(setq tag (org-icompleting-read
"Tag: " org-global-tags-completion-table))))
(cond
- ((equal char ?\r)
+ ((eq char ?\r)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
(setq org-agenda-tag-filter nil)
@@ -7455,39 +7511,27 @@ to switch to narrowing."
(if modifier
(push modifier org-agenda-tag-filter))))
(if (not (null org-agenda-tag-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
- (setq maybe-refresh t))
- ((equal char ?/)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
+ ((eq char ?/)
(org-agenda-filter-show-all-tag)
(when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
- (setq maybe-refresh t))
- ((equal char ?. )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
+ ((eq char ?.)
(setq org-agenda-tag-filter
(mapcar (lambda(tag) (concat "+" tag))
(org-get-at-bol 'tags)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)
- (setq maybe-refresh t))
- ((or (equal char ?\ )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
+ ((or (eq char ?\s)
(setq a (rassoc char alist))
- (and (>= char ?0) (<= char ?9)
- (setq n (if (= char ?0) 9 (- char ?0 1))
- tag (concat effort-op (nth n efforts))
- a (cons tag nil)))
- (and (= char ??)
- (setq tag "?eff")
- a (cons tag nil))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-tag-filter
- (cons (concat (if strip "-" "+") tag)
- (if narrow current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)
- (setq maybe-refresh t))
- (t (error "Invalid tag selection character %c" char)))
- (when maybe-refresh
- (org-agenda-redo))))
+ (cons (concat (if exclude "-" "+") tag)
+ current))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ (t (error "Invalid tag selection character %c" char)))))
(defun org-agenda-get-represented-tags ()
"Get a list of all tags currently represented in the agenda."
@@ -7500,13 +7544,15 @@ to switch to narrowing."
(get-text-property (point) 'tags))))
tags))
-(defun org-agenda-filter-by-tag-refine (strip &optional char)
+(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 strip char 'refine))
+ (org-agenda-filter-by-tag arg char 'refine))
-(defun org-agenda-filter-make-matcher (filter type)
- "Create the form that tests a line for agenda filter."
+(defun org-agenda-filter-make-matcher (filter type &optional expand)
+ "Create the form that tests a line for agenda filter. Optional
+argument EXPAND can be used for the TYPE tag and will expand the
+tags in the FILTER if any of the tags in FILTER are grouptags."
(let (f f1)
(cond
;; Tag filter
@@ -7516,28 +7562,11 @@ to switch to narrowing."
(append (get 'org-agenda-tag-filter :preset-filter)
filter)))
(dolist (x filter)
- (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
- (ffunc
- (lambda (nf0 nf01 fltr notgroup op)
- (dolist (x fltr)
- (if (member x '("-" "+"))
- (setq nf01 (if (equal x "-") 'tags '(not tags)))
- (if (string-match "[<=>?]" x)
- (setq nf01 (org-agenda-filter-effort-form x))
- (setq nf01 (list 'member (downcase (substring x 1))
- 'tags)))
- (when (equal (string-to-char x) ?-)
- (setq nf01 (list 'not nf01))
- (when (not notgroup) (setq op 'and))))
- (push nf01 nf0))
- (if notgroup
- (push (cons 'and nf0) f)
- (push (cons (or op 'or) nf0) f)))))
- (cond ((equal filter '("+"))
- (setq f (list (list 'not 'tags))))
- ((equal nfilter filter)
- (funcall ffunc f1 f filter t nil))
- (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ (let ((op (string-to-char x)))
+ (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
+ (setq x (list x)))
+ (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
+ (push f1 f))))
;; Category filter
((eq type 'category)
(setq filter
@@ -7559,9 +7588,43 @@ to switch to narrowing."
(if (equal "-" (substring x 0 1))
(setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
(setq f1 (list 'string-match (substring x 1) 'txt)))
- (push f1 f))))
+ (push f1 f)))
+ ;; Effort filter
+ ((eq type 'effort)
+ (setq filter
+ (delete-dups
+ (append (get 'org-agenda-effort-filter :preset-filter)
+ filter)))
+ (dolist (x filter)
+ (push (org-agenda-filter-effort-form x) f))))
(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)
+ (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))))
+
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
E looks like \"+<2:25\"."
@@ -7578,11 +7641,9 @@ E looks like \"+<2:25\"."
(defun org-agenda-compare-effort (op value)
"Compare the effort of the current line with VALUE, using OP.
If the line does not have an effort defined, return nil."
- (let ((eff (org-get-at-bol 'effort-minutes)))
- (if (equal op ??)
- (not eff)
- (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
- value))))
+ (let ((eff (org-get-at-eol 'effort-minutes 1)))
+ (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 -1))
+ value)))
(defun org-agenda-filter-expand-tags (filter &optional no-operator)
"Expand group tags in FILTER for the agenda.
@@ -7602,12 +7663,14 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(reverse rtn))
filter))
-(defun org-agenda-filter-apply (filter type)
- "Set FILTER as the new agenda filter and apply it."
+(defun org-agenda-filter-apply (filter type &optional expand)
+ "Set FILTER as the new agenda filter and apply it. Optional
+argument EXPAND can be used for the TYPE tag and will expand the
+tags in the FILTER if any of the tags in FILTER are grouptags."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
(let (tags cat txt)
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand))
;; Only set `org-agenda-filtered-by-category' to t when a unique
;; category is used as the filter:
(setq org-agenda-filtered-by-category
@@ -7619,13 +7682,9 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags ; used in eval
- (apply 'append
- (mapcar (lambda (f)
- (org-agenda-filter-expand-tags (list f) t))
- (org-get-at-bol 'tags)))
- cat (get-text-property (point) 'org-category)
- txt (get-text-property (point) 'txt))
+ (setq tags (org-get-at-bol 'tags)
+ cat (org-get-at-eol 'org-category 1)
+ txt (org-get-at-eol 'txt 1))
(if (not (eval org-agenda-filter-form))
(org-agenda-filter-hide-line type))
(beginning-of-line 2))
@@ -7678,6 +7737,8 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(org-agenda-remove-filter 'tag))
(defun org-agenda-filter-show-all-re nil
(org-agenda-remove-filter 'regexp))
+(defun org-agenda-filter-show-all-effort nil
+ (org-agenda-remove-filter 'effort))
(defun org-agenda-filter-show-all-cat nil
(org-agenda-remove-filter 'category))
(defun org-agenda-filter-show-all-top-filter nil
@@ -7789,27 +7850,40 @@ Negative selection means regexp must not match for selection of an entry."
(text-property-any (point-min) (point-max) 'org-today t)
(text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
(and (get-text-property (min (1- (point-max)) (point)) 'org-series)
- (org-agenda-goto-block-beginning))
+ (org-agenda-backward-block))
(point-min))))
-(defun org-agenda-goto-block-beginning ()
- "Go the agenda block beginning."
+(defun org-agenda-backward-block ()
+ "Move backward by one agenda block."
(interactive)
- (if (not (derived-mode-p 'org-agenda-mode))
- (error "Cannot execute this command outside of org-agenda-mode buffers")
- (let (dest)
- (save-excursion
- (unless (looking-at "\\'")
- (forward-char))
- (let* ((prop 'org-agenda-structural-header)
- (p (previous-single-property-change (point) prop))
- (n (next-single-property-change (or (and (looking-at "\\`") 1)
- (1- (point))) prop)))
- (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p))))))
- (if (not dest)
- (error "Cannot find the beginning of the blog")
- (goto-char dest)
- (move-beginning-of-line 1)))))
+ (org-agenda-forward-block 'backward))
+
+(defun org-agenda-forward-block (&optional backward)
+ "Move forward by one agenda block.
+When optional argument BACKWARD is set, go backward"
+ (interactive)
+ (cond ((not (derived-mode-p 'org-agenda-mode))
+ (user-error
+ "Cannot execute this command outside of org-agenda-mode buffers"))
+ ((looking-at (if backward "\\`" "\\'"))
+ (message "Already at the %s block" (if backward "first" "last")))
+ (t (let ((pos (prog1 (point)
+ (ignore-errors (if backward (backward-char 1)
+ (move-end-of-line 1)))))
+ (f (if backward
+ 'previous-single-property-change
+ 'next-single-property-change))
+ moved dest)
+ (while (and (setq dest (funcall
+ f (point) 'org-agenda-structural-header))
+ (not (get-text-property
+ (point) 'org-agenda-structural-header)))
+ (setq moved t)
+ (goto-char dest))
+ (if moved (move-beginning-of-line 1)
+ (goto-char (if backward (point-min) (point-max)))
+ (move-beginning-of-line 1)
+ (message "No %s block" (if backward "previous" "further")))))))
(defun org-agenda-later (arg)
"Go forward in time by the current span.
@@ -7985,7 +8059,7 @@ so that the date SD will be in that range."
(setq y1 (org-small-year-to-year (/ n 100))
n (mod n 100)))
(setq sd
- (calendar-absolute-from-iso
+ (calendar-iso-to-absolute
(list n 1
(or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
((eq span 'month)
@@ -8201,6 +8275,19 @@ When called with a prefix argument, include all archive files as well."
"}")
'face 'org-agenda-filter-tags
'help-echo "Tags used in filtering")) "")
+ (if (or org-agenda-effort-filter
+ (get 'org-agenda-effort-filter :preset-filter))
+ '(:eval (org-propertize
+ (concat " {"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-effort-filter :preset-filter)
+ org-agenda-effort-filter)
+ "")
+ "}")
+ 'face 'org-agenda-filter-effort
+ 'help-echo "Effort conditions used in filtering")) "")
(if (or org-agenda-regexp-filter
(get 'org-agenda-regexp-filter :preset-filter))
'(:eval (org-propertize
@@ -8287,7 +8374,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 Org-mode file which contains the item at point."
+ "Go to the entry at point in the corresponding Org-mode file."
(interactive)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
@@ -8305,6 +8392,9 @@ When called with a prefix argument, include all archive files as well."
(when (outline-invisible-p)
(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)))
(run-hooks 'org-agenda-after-show-hook)
(and highlight (org-highlight (point-at-bol) (point-at-eol)))))
@@ -8421,8 +8511,8 @@ 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), clear the refile cache.
-When GOTO is '(16), go to the location of the last refiled item.
+When GOTO is 0 or '(64) or \\[universal-argument] \\[universal-argument] \\[universal-argument], clear the refile cache.
+When GOTO is '(16) or \\[universal-argument] \\[universal-argument], go to the location of the last refiled item.
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")
@@ -8513,10 +8603,12 @@ It also looks at the text of the entry itself."
(org-agenda-error)))
(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)
(and delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
+ (org-back-to-heading t)
(when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
(save-excursion
@@ -8538,10 +8630,8 @@ With prefix argument FULL-ENTRY, make the entire entry visible
if it was hidden in the outline."
(interactive "P")
(let ((win (selected-window)))
- (if full-entry
- (let ((org-show-entry-below t))
- (org-agenda-goto t))
- (org-agenda-goto t))
+ (org-agenda-goto t)
+ (when full-entry (org-show-entry))
(select-window win)))
(defvar org-agenda-show-window nil)
@@ -8612,15 +8702,10 @@ if it was hidden in the outline."
(run-hook-with-args 'org-cycle-hook 'subtree))
(message "Remote: SUBTREE"))
((= more 4)
- (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers)))
- (org-drawer-regexp
- (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$")))
- (show-subtree)
- (save-excursion
- (org-back-to-heading)
- (org-cycle-hide-drawers 'subtree)))
+ (show-subtree)
+ (save-excursion
+ (org-back-to-heading)
+ (org-cycle-hide-drawers 'subtree '("LOGBOOK")))
(message "Remote: SUBTREE AND LOGBOOK"))
((> more 4)
(show-subtree)
@@ -8630,11 +8715,12 @@ if it was hidden in the outline."
(defvar org-agenda-cycle-counter nil)
(defun org-agenda-cycle-show (&optional n)
"Show the current entry in another window, with default settings.
-Default settings are taken from `org-show-hierarchy-above' and siblings.
-When use repeatedly in immediate succession, the remote entry will cycle
-through visibility
-children -> subtree -> folded
+Default settings are taken from `org-show-context-detail'. When
+use repeatedly in immediate succession, the remote entry will
+cycle through visibility
+
+ children -> subtree -> folded
When called with a numeric prefix arg, that arg will be passed through to
`org-agenda-show-1'. For the interpretation of that argument, see the
@@ -8671,7 +8757,8 @@ docstring of `org-agenda-show-1'."
(org-agenda-error)))
(defun org-agenda-error ()
- (error "Command not allowed in this line"))
+ "Throw an error when a command is not allowed in the agenda."
+ (user-error "Command not allowed in this line"))
(defun org-agenda-tree-to-indirect-buffer (arg)
"Show the subtree corresponding to the current entry in an indirect buffer.
@@ -8698,7 +8785,8 @@ use the dedicated frame)."
(and indirect-window (select-window indirect-window))
(switch-to-buffer org-last-indirect-buffer :norecord)
(fit-window-to-buffer indirect-window)))
- (select-window (get-buffer-window agenda-buffer)))))
+ (select-window (get-buffer-window agenda-buffer))
+ (setq org-agenda-last-indirect-buffer org-last-indirect-buffer))))
(defun org-agenda-do-tree-to-indirect-buffer (arg)
"Same as `org-agenda-tree-to-indirect-buffer' without saving window."
@@ -8770,7 +8858,8 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
newhead)
(org-agenda-unmark-clocking-task))
- (org-move-to-column col))))
+ (org-move-to-column col)
+ (org-agenda-mark-clocking-task))))
(defun org-agenda-add-note (&optional arg)
"Add a time-stamped note to the entry at point."
@@ -8819,7 +8908,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(equal m hdmarker))
(setq props (text-properties-at (point))
dotime (org-get-at-bol 'dotime)
- cat (org-get-at-bol 'org-category)
+ cat (org-get-at-eol 'org-category 1)
level (org-get-at-bol 'level)
tags thetags
new
@@ -9184,7 +9273,6 @@ ARG is passed through to `org-schedule'."
(type (marker-insertion-type marker))
(buffer (marker-buffer marker))
(pos (marker-position marker))
- (org-insert-labeled-timestamps-at-point nil)
ts)
(set-marker-insertion-type marker t)
(org-with-remote-undo buffer
@@ -9205,7 +9293,6 @@ ARG is passed through to `org-deadline'."
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
- (org-insert-labeled-timestamps-at-point nil)
ts)
(org-with-remote-undo buffer
(with-current-buffer buffer
@@ -9431,33 +9518,30 @@ Add TEXT as headline, and position the cursor in the second line so that
a timestamp can be added there."
(widen)
(goto-char (point-max))
- (or (bolp) (insert "\n"))
- (insert "* " text "\n")
- (if org-adapt-indentation (org-indent-to-column 2)))
+ (unless (bolp) (insert "\n"))
+ (org-insert-heading nil t t)
+ (insert text)
+ (org-end-of-meta-data)
+ (unless (bolp) (insert "\n"))
+ (when org-adapt-indentation (org-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.
-Position the point in the line right after the new heading so
-that a timestamp can be added there."
- (let ((org-show-following-heading t)
- (org-show-siblings t)
- (org-show-hierarchy-above t)
- (org-show-entry-below t)
- col)
- (outline-next-heading)
- (org-back-over-empty-lines)
- (or (looking-at "[ \t]*$")
- (progn (insert "\n") (backward-char 1)))
- (org-insert-heading nil t)
- (org-do-demote)
- (setq col (current-column))
- (insert text "\n")
- (if org-adapt-indentation (org-indent-to-column col))
- (let ((org-show-following-heading t)
- (org-show-siblings t)
- (org-show-hierarchy-above t)
- (org-show-entry-below t))
- (org-show-context))))
+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)
+ (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)))
+ (org-show-set-visibility 'lineage))
(defun org-agenda-diary-entry ()
"Make a diary entry, like the `i' command from the calendar.
@@ -9473,13 +9557,13 @@ entries in that Org-mode file."
(message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
(read-char-exclusive)))
(cmd (cdr (assoc char
- '((?d . insert-diary-entry)
- (?w . insert-weekly-diary-entry)
- (?m . insert-monthly-diary-entry)
- (?y . insert-yearly-diary-entry)
- (?a . insert-anniversary-diary-entry)
- (?b . insert-block-diary-entry)
- (?c . insert-cyclic-diary-entry)))))
+ '((?d . diary-insert-entry)
+ (?w . diary-insert-weekly-entry)
+ (?m . diary-insert-monthly-entry)
+ (?y . diary-insert-yearly-entry)
+ (?a . diary-insert-anniversary-entry)
+ (?b . diary-insert-block-entry)
+ (?c . diary-insert-cyclic-entry)))))
(oldf (symbol-function 'calendar-cursor-to-date))
;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
(point (point))
@@ -9530,12 +9614,12 @@ entries in that Org-mode file."
(defun org-agenda-phases-of-moon ()
"Display the phases of the moon for the 3 months around the cursor date."
(interactive)
- (org-agenda-execute-calendar-command 'calendar-phases-of-moon))
+ (org-agenda-execute-calendar-command 'calendar-lunar-phases))
(defun org-agenda-holidays ()
"Display the holidays for the 3 months around the cursor date."
(interactive)
- (org-agenda-execute-calendar-command 'list-calendar-holidays))
+ (org-agenda-execute-calendar-command 'calendar-list-holidays))
(defvar calendar-longitude) ; defined in calendar.el
(defvar calendar-latitude) ; defined in calendar.el
@@ -9572,9 +9656,13 @@ argument, latitude and longitude will be prompted for."
"Compute the Org-mode agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'."
(interactive)
- (org-agenda-list nil (calendar-absolute-from-gregorian
- (calendar-cursor-to-date))
- nil))
+ ;; Temporarily disable sticky agenda since user clearly wants to
+ ;; refresh view anyway.
+ (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*")
+ (org-agenda-sticky nil))
+ (org-agenda-list nil (calendar-absolute-from-gregorian
+ (calendar-cursor-to-date))
+ nil)))
(defun org-agenda-convert-date ()
(interactive)
@@ -9871,6 +9959,11 @@ The prefix arg is passed through to the command if possible."
(goto-char pos)
(let (org-loop-over-headlines-in-active-region)
(eval cmd))
+ ;; `post-command-hook' is not run yet. We make sure any
+ ;; pending log note is processed.
+ (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
+ (memq 'org-add-log-note post-command-hook))
+ (org-add-log-note))
(setq cnt (1+ cnt))))
(when redo-at-end (org-agenda-redo))
(unless org-agenda-persistent-marks
@@ -9900,12 +9993,14 @@ current HH:MM time."
(defun org-agenda-reapply-filters ()
"Re-apply all agenda filters."
(mapcar
- (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
`((,org-agenda-tag-filter tag)
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
+ (,org-agenda-effort-filter effort)
(,(get 'org-agenda-tag-filter :preset-filter) tag)
(,(get 'org-agenda-category-filter :preset-filter) category)
+ (,(get 'org-agenda-effort-filter :preset-filter) effort)
(,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
(defun org-agenda-drag-line-forward (arg &optional backward)
@@ -10050,7 +10145,7 @@ to override `appt-message-warning-time'."
(replace-regexp-in-string
org-bracket-link-regexp "\\3"
(or (get-text-property 1 'txt x) ""))))
- (cat (get-text-property 1 'org-category 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))
@@ -10090,7 +10185,8 @@ to override `appt-message-warning-time'."
(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* ((hour (third (decode-time
+ (let* ((org-use-effective-time t)
+ (hour (third (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 6deac47..bbe95ed 100644
--- a/lisp/org-archive.el
+++ b/lisp/org-archive.el
@@ -119,9 +119,15 @@ information."
(const :tag "Outline path" olpath)
(const :tag "Local tags" ltags)))
+(defvar org-archive-hook nil
+ "Hook run after successfully archiving a subtree.
+Hook functions are called with point on the subtree in the
+original file. At this stage, the subtree has been added to the
+archive location, but not yet deleted from the original file.")
+
(defun org-get-local-archive-location ()
"Get the archive location applicable at point."
- (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
+ (let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
prop)
(save-excursion
(save-restriction
@@ -158,7 +164,7 @@ archive file is."
(save-restriction
(goto-char (point-min))
(while (re-search-forward
- "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)"
+ "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)"
nil t)
(setq file (org-extract-archive-file
(org-match-string-no-properties 2)))
@@ -198,9 +204,11 @@ The archive can be a certain top-level heading in the current file, or in
a different file. The tree will be moved to that location, the subtree
heading be marked DONE, and the current time will be added.
-When called with prefix argument FIND-DONE, find whole trees without any
+When called with a single prefix argument FIND-DONE, find whole trees without any
open TODO items and archive them (after getting confirmation from the user).
-If the cursor is not at a headline when this command is called, try all level
+When called with a double prefix argument, find whole trees with timestamps before
+today and archive them (after getting confirmation from the user).
+If the cursor is not at a headline when these commands are called, try all level
1 trees. If the cursor is on a headline, only try the direct children of
this heading."
(interactive "P")
@@ -213,8 +221,10 @@ this heading."
(org-archive-subtree ,find-done))
org-loop-over-headlines-in-active-region
cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
- (if find-done
- (org-archive-all-done)
+ (cond
+ ((equal find-done '(4)) (org-archive-all-done))
+ ((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)
@@ -231,8 +241,7 @@ this heading."
(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)
- (current-time)))
+ (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
@@ -366,8 +375,10 @@ this heading."
;; Save and kill the buffer, if it is not the same buffer.
(when (not (eq this-buffer buffer))
(save-buffer))))
- ;; Here we are back in the original buffer. Everything seems to have
- ;; worked. So now cut the tree and finish up.
+ ;; Here we are back in the original buffer. Everything seems
+ ;; to have worked. So now run hooks, cut the tree and finish
+ ;; up.
+ (run-hooks 'org-archive-hook)
(let (this-command) (org-cut-subtree))
(when (featurep 'org-inlinetask)
(org-inlinetask-remove-END-maybe))
@@ -375,7 +386,7 @@ this heading."
(message "Subtree archived %s"
(if (eq this-buffer buffer)
(concat "under heading: " heading)
- (concat "in file: " (abbreviate-file-name afile))))))
+ (concat "in file: " (abbreviate-file-name afile)))))))
(org-reveal)
(if (looking-at "^[ \t]*$")
(outline-next-visible-heading 1))))
@@ -441,8 +452,7 @@ sibling does not exist, it will be created at the end of the subtree."
(org-set-property
"ARCHIVE_TIME"
(format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)
- (current-time)))
+ (substring (cdr org-time-stamp-formats) 1 -1)))
(outline-up-heading 1 t)
(hide-subtree)
(org-cycle-show-empty-lines 'folded)
@@ -456,13 +466,50 @@ sibling does not exist, it will be created at the end of the subtree."
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."
- (let ((re org-not-done-heading-regexp) re1
- (rea (concat ".*:" org-archive-tag ":"))
+ (org-archive-all-matches
+ (lambda (beg end)
+ (unless (re-search-forward org-not-done-heading-regexp end t)
+ "no open TODO items"))
+ tag))
+
+(defun org-archive-all-old (&optional tag)
+ "Archive sublevels of the current tree with timestamps prior to today.
+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)
+ (let (ts)
+ (and (re-search-forward org-ts-regexp end t)
+ (setq ts (match-string 0))
+ (< (org-time-stamp-to-now ts) 0)
+ (if (not (looking-at
+ (concat "--\\(" org-ts-regexp "\\)")))
+ (concat "old timestamp " ts)
+ (setq ts (concat "old timestamp " ts (match-string 0)))
+ (and (< (org-time-stamp-to-now (match-string 1)) 0)
+ ts)))))
+ tag))
+
+(defun org-archive-all-matches (predicate &optional tag)
+ "Archive sublevels of the current tree that match PREDICATE.
+
+PREDICATE is a function of two arguments, BEG and END, which
+specify the beginning and end of the headline being considered.
+It is called with point positioned at BEG. The headline will be
+archived if PREDICATE returns non-nil. If the return value of
+PREDICATE is a string, it should describe the reason for
+archiving the heading.
+
+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."
+ (let ((rea (concat ".*:" org-archive-tag ":")) re1
(begm (make-marker))
(endm (make-marker))
- (question (if tag "Set ARCHIVE tag (no open TODO items)? "
- "Move subtree to archive (no open TODO items)? "))
- beg end (cntarch 0))
+ (question (if tag "Set ARCHIVE tag? "
+ "Move subtree to archive? "))
+ reason beg end (cntarch 0))
(if (org-at-heading-p)
(progn
(setq re1 (concat "^" (regexp-quote
@@ -482,11 +529,14 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(setq beg (match-beginning 0)
end (save-excursion (org-end-of-subtree t) (point)))
(goto-char beg)
- (if (re-search-forward re end t)
+ (if (not (setq reason (funcall predicate beg end)))
(goto-char end)
(goto-char beg)
(if (and (or (not tag) (not (looking-at rea)))
- (y-or-n-p question))
+ (y-or-n-p
+ (if (stringp reason)
+ (concat question "(" reason ")")
+ question)))
(progn
(if tag
(org-toggle-tag org-archive-tag 'on)
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index bcf7ba7..7f61910 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -120,6 +120,17 @@ lns create a symbol link. Note that this is not supported
(const :tag "Link to origin location" t)
(const :tag "Link to the attach-dir location" attached)))
+(defcustom org-attach-archive-delete nil
+ "Non-nil means attachments are deleted upon archiving a subtree.
+When set to `query', ask the user instead."
+ :group 'org-attach
+ :version "25.1"
+ :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)))
+
;;;###autoload
(defun org-attach ()
"The dispatcher for attachment commands.
@@ -272,7 +283,8 @@ This checks for the existence of a \".git\" directory in that directory."
(cd dir)
(let ((have-annex
(and org-attach-git-annex-cutoff
- (file-exists-p (expand-file-name "annex" git-dir)))))
+ (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
@@ -419,15 +431,15 @@ This can be used after files have been added externally."
(and files (org-attach-tag))
(when org-attach-file-list-property
(dolist (file files)
- (unless (string-match "^\\." file)
+ (unless (string-match "^\\.\\.?\\'" file)
(org-entry-add-to-multivalued-property
(point) org-attach-file-list-property file))))))))
(defun org-attach-file-list (dir)
"Return a list of files in the attachment directory.
-This ignores files starting with a \".\", and files ending in \"~\"."
+This ignores files ending in \"~\"."
(delq nil
- (mapcar (lambda (x) (if (string-match "^\\." x) nil x))
+ (mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x))
(directory-files dir nil "[^~]\\'"))))
(defun org-attach-reveal (&optional if-exists)
@@ -475,6 +487,17 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
prefix."
(concat "file:" (org-attach-expand file)))
+(defun org-attach-archive-delete-maybe ()
+ "Maybe delete subtree attachments when archiving.
+This function is called by `org-archive-hook'. The option
+`org-attach-archive-delete' controls its behavior."
+ (when (if (eq org-attach-archive-delete 'query)
+ (yes-or-no-p "Delete all attachments? ")
+ org-attach-archive-delete)
+ (org-attach-delete-all t)))
+
+(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)
+
(provide 'org-attach)
;; Local variables:
diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el
index cfd5b3b..78f9b71 100644
--- a/lisp/org-bbdb.el
+++ b/lisp/org-bbdb.el
@@ -37,7 +37,7 @@
;; the diary using bbdb-anniv.el.
;;
;; Put the following in /somewhere/at/home/diary.org and make sure
-;; that this file is in `org-agenda-files`
+;; that this file is in `org-agenda-files'.
;;
;; %%(org-bbdb-anniversaries)
;;
diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el
index 75ac69b..7b2ed48 100644
--- a/lisp/org-bibtex.el
+++ b/lisp/org-bibtex.el
@@ -264,26 +264,39 @@ IDs must be unique."
(defcustom org-bibtex-tags-are-keywords nil
"Convert the value of the keywords field to tags and vice versa.
-If set to t, comma-separated entries in a bibtex entry's keywords
-field will be converted to org tags. Note: spaces will be escaped
-with underscores, and characters that are not permitted in org
+
+When non-nil, comma-separated entries in a bibtex entry's keywords
+field will be converted to Org tags. Note: spaces will be escaped
+with underscores, and characters that are not permitted in Org
tags will be removed.
-If t, local tags in an org entry will be exported as a
-comma-separated string of keywords when exported to bibtex. Tags
-defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will
-not be exported."
+When non-nil, local tags in an Org entry will be exported as
+a comma-separated string of keywords when exported to bibtex.
+If `org-bibtex-inherit-tags' is non-nil, inherited tags will also
+be exported as keywords. Tags defined in `org-bibtex-tags' or
+`org-bibtex-no-export-tags' will not be exported."
:group 'org-bibtex
:version "24.1"
:type 'boolean)
(defcustom org-bibtex-no-export-tags nil
"List of tag(s) that should not be converted to keywords.
-This variable is relevant only if `org-bibtex-tags-are-keywords' is t."
+This variable is relevant only if `org-bibtex-tags-are-keywords'
+is non-nil."
:group 'org-bibtex
:version "24.1"
:type '(repeat :tag "Tag" (string)))
+(defcustom org-bibtex-inherit-tags nil
+ "Controls whether inherited tags are converted to bibtex keywords.
+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"
+ :package-version '(Org . "8.3")
+ :type 'boolean)
+
(defcustom org-bibtex-type-property-name "btype"
"Property in which to store bibtex entry type (e.g., article)."
:group 'org-bibtex
@@ -332,7 +345,9 @@ This variable is relevant only if `org-bibtex-tags-are-keywords' is t."
(append org-bibtex-tags
org-bibtex-no-export-tags))
tag))
- (org-get-local-tags-at))))))
+ (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
@@ -633,7 +648,7 @@ This uses `bibtex-parse-entry'."
(defun org-bibtex-read-buffer (buffer)
"Read all bibtex entries in BUFFER and save to `org-bibtex-entries'.
Return the number of saved entries."
- (interactive "bbuffer: ")
+ (interactive "bBuffer: ")
(let ((start-length (length org-bibtex-entries)))
(with-current-buffer buffer
(save-excursion
@@ -643,12 +658,12 @@ Return the number of saved entries."
(org-bibtex-read)
(bibtex-beginning-of-entry))))
(let ((added (- (length org-bibtex-entries) start-length)))
- (message "parsed %d entries" added)
+ (message "Parsed %d entries" added)
added)))
(defun org-bibtex-read-file (file)
"Read FILE with `org-bibtex-read-buffer'."
- (interactive "ffile: ")
+ (interactive "fFile: ")
(org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile)))
(defun org-bibtex-write ()
@@ -694,7 +709,7 @@ Return the number of saved entries."
(defun org-bibtex-import-from-file (file)
"Read bibtex entries from FILE and insert as Org-mode headlines after point."
- (interactive "ffile: ")
+ (interactive "fFile: ")
(dotimes (_ (org-bibtex-read-file file))
(save-excursion (org-bibtex-write))
(re-search-forward org-property-end-re)
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index c708683..bfdb475 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1,6 +1,6 @@
;;; org-capture.el --- Fast note taking in Org-mode
-;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -53,7 +53,7 @@
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
-(declare-function org-table-get-specials "org-table" ())
+(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))
@@ -64,6 +64,7 @@
(defvar org-remember-default-headline)
(defvar org-remember-templates)
(defvar org-table-hlines)
+(defvar org-table-current-begin-pos)
(defvar dired-buffers)
(defvar org-capture-clock-was-started nil
@@ -201,7 +202,7 @@ properties are:
:clock-resume Start the interrupted clock when finishing the capture.
Note that :clock-keep has precedence over :clock-resume.
- When setting both to `t', the current clock will run and
+ When setting both to t, the current clock will run and
the previous one will not be resumed.
:unnarrowed Do not narrow the target buffer, simply show the
@@ -812,7 +813,8 @@ already gone. Any prefix argument will be passed to the refile command."
"Go to the location where the last capture note was stored."
(interactive)
(org-goto-marker-or-bmk org-capture-last-stored-marker
- "org-capture-last-stored")
+ (plist-get org-bookmark-names-plist
+ :last-capture))
(message "This is the last note stored by a capture process"))
;;; Supporting functions for handling the process
@@ -822,7 +824,7 @@ already gone. Any prefix argument will be passed to the refile command."
(org-capture-put
:initial-target-region
;; Check if the buffer is currently narrowed
- (when (/= (buffer-size) (- (point-max) (point-min)))
+ (when (org-buffer-narrowed-p)
(cons (point-min) (point-max))))
;; store the current point
(org-capture-put :initial-target-position (point)))
@@ -965,12 +967,15 @@ 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. Return whatever we get."
+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."
(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))
- ((and file (consp file)) (eval file))
+ ((consp file) (eval file))
(t file)))
(defun org-capture-target-buffer (file)
@@ -1022,9 +1027,9 @@ may have been stored before."
(target-entry-p (org-capture-get :target-entry-p))
level beg end file)
+ (and (org-capture-get :exact-position)
+ (goto-char (org-capture-get :exact-position)))
(cond
- ((org-capture-get :exact-position)
- (goto-char (org-capture-get :exact-position)))
((not target-entry-p)
;; Insert as top-level entry, either at beginning or at end of file
(setq level 1)
@@ -1074,21 +1079,18 @@ may have been stored before."
(t
(setq beg (1+ (point-at-eol))
end (save-excursion (outline-next-heading) (point)))))
+ (setq ind nil)
(if (org-capture-get :prepend)
(progn
(goto-char beg)
- (if (org-list-search-forward (org-item-beginning-re) end t)
- (progn
- (goto-char (match-beginning 0))
- (setq ind (org-get-indentation)))
- (goto-char end)
- (setq ind 0)))
+ (when (org-list-search-forward (org-item-beginning-re) end t)
+ (goto-char (match-beginning 0))
+ (setq ind (org-get-indentation))))
(goto-char end)
- (if (org-list-search-backward (org-item-beginning-re) beg t)
- (progn
- (setq ind (org-get-indentation))
- (org-end-of-item))
- (setq ind 0))))
+ (when (org-list-search-backward (org-item-beginning-re) beg t)
+ (setq ind (org-get-indentation))
+ (org-end-of-item)))
+ (unless ind (goto-char end)))
;; Remove common indentation
(setq txt (org-remove-indentation txt))
;; Make sure this is indeed an item
@@ -1096,17 +1098,22 @@ may have been stored before."
(setq txt (concat "- "
(mapconcat 'identity (split-string txt "\n")
"\n "))))
+ ;; Prepare surrounding empty lines.
+ (org-capture-empty-lines-before)
+ (setq beg (point))
+ (unless (eolp) (save-excursion (insert "\n")))
+ (unless ind
+ (org-indent-line)
+ (setq ind (org-get-indentation))
+ (delete-region beg (point)))
;; Set the correct indentation, depending on context
(setq ind (make-string ind ?\ ))
(setq txt (concat ind
(mapconcat 'identity (split-string txt "\n")
(concat "\n" ind))
"\n"))
- ;; Insert, with surrounding empty lines
- (org-capture-empty-lines-before)
- (setq beg (point))
+ ;; Insert item.
(insert txt)
- (or (bolp) (insert "\n"))
(org-capture-empty-lines-after 1)
(org-capture-position-for-last-stored beg)
(forward-char 1)
@@ -1148,21 +1155,23 @@ may have been stored before."
;; Check if the template is good
(if (not (string-match org-table-dataline-regexp txt))
(setq txt "| %?Bad template |\n"))
+ (if (functionp table-line-pos)
+ (setq table-line-pos (funcall table-line-pos))
+ (setq table-line-pos (eval table-line-pos)))
(cond
((and table-line-pos
(string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos))
;; we have a complex line specification
- (goto-char (point-min))
- (let ((nh (- (match-end 1) (match-beginning 1)))
- (delta (string-to-number (match-string 2 table-line-pos)))
- ll)
+ (let ((ll (ignore-errors
+ (save-match-data (org-table-analyze))
+ (aref org-table-hlines
+ (- (match-end 1) (match-beginning 1)))))
+ (delta (string-to-number (match-string 2 table-line-pos))))
;; The user wants a special position in the table
- (org-table-get-specials)
- (setq ll (ignore-errors (aref org-table-hlines nh)))
- (unless ll (error "Invalid table line specification \"%s\""
- table-line-pos))
- (setq ll (+ ll delta (if (< delta 0) 0 -1)))
- (org-goto-line ll)
+ (unless ll
+ (error "Invalid table line specification \"%s\"" table-line-pos))
+ (goto-char org-table-current-begin-pos)
+ (forward-line (+ ll delta (if (< delta 0) 0 -1)))
(org-table-insert-row 'below)
(beginning-of-line 1)
(delete-region (point) (1+ (point-at-eol)))
@@ -1215,7 +1224,7 @@ Of course, if exact position has been required, just put it there."
;; we should place the text into this entry
(if (org-capture-get :prepend)
;; Skip meta data and drawers
- (org-end-of-meta-data-and-drawers)
+ (org-end-of-meta-data t)
;; go to ent of the entry text, before the next headline
(outline-next-heading)))
(t
@@ -1581,8 +1590,7 @@ The template may still contain \"%?\" for cursor positioning."
(unless template (setq template "") (message "No template") (ding)
(sit-for 1))
(save-window-excursion
- (delete-other-windows)
- (org-pop-to-buffer-same-window (get-buffer-create "*Capture*"))
+ (org-switch-to-buffer-other-window (get-buffer-create "*Capture*"))
(erase-buffer)
(insert template)
(goto-char (point-min))
@@ -1602,8 +1610,6 @@ The template may still contain \"%?\" for cursor positioning."
(insert-file-contents filename)
(error (insert (format "%%![Couldn't insert %s: %s]"
filename error)))))))
- ;; %() embedded elisp
- (org-capture-expand-embedded-elisp)
;; The current time
(goto-char (point-min))
@@ -1633,6 +1639,10 @@ The template may still contain \"%?\" for cursor positioning."
(intern (match-string 1))) ""))
(replace-match x t t)))))
+ ;; %() embedded elisp
+ (goto-char (point-min))
+ (org-capture-expand-embedded-elisp)
+
;; Turn on org-mode in temp buffer, set local variables
;; This is to support completion in interactive prompts
(let ((org-inhibit-startup t)) (org-mode))
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 892ae18..6e34483 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -32,10 +32,12 @@
(require 'cl))
(require 'org)
-(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
+(declare-function calendar-iso-to-absolute "cal-iso" (&optional 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-refresh-properties "org" (dprop tprop))
+(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-time-stamp-formats)
(defvar org-ts-what)
(defvar org-frame-title-format-backup frame-title-format)
@@ -45,19 +47,26 @@
:tag "Org Clock"
:group 'org-progress)
-(defcustom org-clock-into-drawer org-log-into-drawer
- "Should clocking info be wrapped into a drawer?
-When t, clocking info will always be inserted into a :LOGBOOK: drawer.
-If necessary, the drawer will be created.
-When nil, the drawer will not be created, but used when present.
-When an integer and the number of clocking entries in an item
-reaches or exceeds this number, a drawer will be created.
-When a string, it names the drawer to be used.
-
-The default for this variable is the value of `org-log-into-drawer',
-which see."
+(defcustom org-clock-into-drawer t
+ "Non-nil when clocking info should be wrapped into a drawer.
+
+When non-nil, clocking info will be inserted into the same drawer
+as log notes (see variable `org-log-into-drawer'), if it exists,
+or \"LOGBOOK\" otherwise. If necessary, the drawer will be
+created.
+
+When an integer, the drawer is created only when the number of
+clocking entries in an item reaches or exceeds this value.
+
+When a string, it becomes the name of the drawer, ignoring the
+log notes drawer altogether.
+
+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"
+ :package-version '(Org . "8.3")
:type '(choice
(const :tag "Always" t)
(const :tag "Only when drawer exists" nil)
@@ -66,20 +75,22 @@ which see."
(string :tag "Into Drawer named...")))
(defun org-clock-into-drawer ()
- "Return the value of `org-clock-into-drawer', but let properties overrule.
+ "Value of `org-clock-into-drawer'. but let properties overrule.
+
If the current entry has or inherits a CLOCK_INTO_DRAWER
-property, it will be used instead of the default value; otherwise
-if the current entry has or inherits a LOG_INTO_DRAWER property,
-it will be used instead of the default value.
-The default is the value of the customizable variable `org-clock-into-drawer',
-which see."
- (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit))
- (q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))
- (cond
- ((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer)
- ((or (equal p "t") (equal q "t")) "LOGBOOK")
- ((not p) q)
- (t p))))
+property, it will be used instead of the default value.
+
+Return value is either a string, an integer, or nil."
+ (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit t)))
+ (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))
+ ((org-string-nw-p org-clock-into-drawer))
+ ((integerp org-clock-into-drawer) org-clock-into-drawer)
+ ((not org-clock-into-drawer) nil)
+ ((org-log-into-drawer))
+ (t "LOGBOOK"))))
(defcustom org-clock-out-when-done t
"When non-nil, clock will be stopped when the clocked entry is marked DONE.
@@ -413,6 +424,26 @@ if you are using Debian."
:package-version '(Org . "8.0")
:type 'string)
+(defcustom org-clock-goto-before-context 2
+ "Number of lines of context to display before currently clocked-in entry.
+This applies when using `org-clock-goto'."
+ :group 'org-clock
+ :type 'integer)
+
+(defcustom org-clock-display-default-range 'thisyear
+ "Default range when displaying clocks with `org-clock-display'."
+ :group 'org-clock
+ :type '(choice (const today)
+ (const yesterday)
+ (const thisweek)
+ (const lastweek)
+ (const thismonth)
+ (const lastmonth)
+ (const thisyear)
+ (const lastyear)
+ (const untilnow)
+ (const :tag "Select range interactively" interactive)))
+
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
@@ -430,6 +461,28 @@ to add an effort property.")
(defvar org-clock-has-been-used nil
"Has the clock been used during the current Emacs session?")
+(defconst org-clock--oldest-date
+ (let* ((dichotomy
+ (lambda (min max pred)
+ (if (funcall pred min) min
+ (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)))))
+ max))
+ (high
+ (funcall dichotomy
+ most-negative-fixnum
+ 0
+ (lambda (m) (ignore-errors (decode-time (list m 0))))))
+ (low
+ (funcall dichotomy
+ most-negative-fixnum
+ 0
+ (lambda (m) (ignore-errors (decode-time (list high m)))))))
+ (list high low))
+ "Internal time for oldest date representable on the system.")
+
;;; The clock for measuring work time.
(defvar org-mode-line-string "")
@@ -559,6 +612,7 @@ of a different task.")
(fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl)))
(message (or prompt "Select task for clocking:"))
(setq cursor-type nil rpl (read-char-exclusive))
+ (kill-buffer)
(cond
((eq rpl ?q) nil)
((eq rpl ?x) nil)
@@ -775,11 +829,12 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
"Search through the given file and find all open clocks."
(let ((buf (or (get-file-buffer file)
(find-file-noselect file)))
+ (org-clock-re (concat org-clock-string " \\(\\[.*?\\]\\)$"))
clocks)
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t)
+ (while (re-search-forward org-clock-re nil t)
(push (cons (copy-marker (match-end 1) t)
(org-time-string-to-time (match-string 1))) clocks))))
clocks))
@@ -884,7 +939,7 @@ If necessary, clock-out of the currently active clock."
(defun org-clock-jump-to-current-clock (&optional effective-clock)
(interactive)
- (let ((org-clock-into-drawer (org-clock-into-drawer))
+ (let ((drawer (org-clock-into-drawer))
(clock (or effective-clock (cons org-clock-marker
org-clock-start-time))))
(unless (marker-buffer (car clock))
@@ -892,23 +947,18 @@ If necessary, clock-out of the currently active clock."
(org-with-clock clock (org-clock-goto))
(with-current-buffer (marker-buffer (car clock))
(goto-char (car clock))
- (if org-clock-into-drawer
- (let ((logbook
- (if (stringp org-clock-into-drawer)
- (concat ":" org-clock-into-drawer ":")
- ":LOGBOOK:")))
- (ignore-errors
- (outline-flag-region
- (save-excursion
- (outline-back-to-heading t)
- (search-forward logbook)
- (goto-char (match-beginning 0)))
- (save-excursion
- (outline-back-to-heading t)
- (search-forward logbook)
- (search-forward ":END:")
- (goto-char (match-end 0)))
- nil)))))))
+ (when drawer
+ (org-with-wide-buffer
+ (let ((drawer-re (format "^[ \t]*:%s:[ \t]*$"
+ (regexp-quote (or drawer "LOGBOOK"))))
+ (beg (save-excursion (outline-back-to-heading t) (point))))
+ (catch 'exit
+ (while (re-search-backward drawer-re beg t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'drawer)
+ (when (> (org-element-property :end element) (car clock))
+ (org-flag-drawer nil element))
+ (throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
"Resolve an open org-mode clock.
@@ -1046,9 +1096,9 @@ 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 (current-time))
- (org-float-time (cdr clock))) 60))))))
+ (floor (- (org-float-time)
+ (org-float-time (cdr clock)))
+ 60)))))
(or last-valid
(cdr clock)))))))))))
@@ -1066,9 +1116,11 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(defvar org-x11idle-exists-p
;; Check that x11idle exists
(and (eq window-system 'x)
- (eq (call-process-shell-command "command" nil nil nil "-v" org-clock-x11idle-program-name) 0)
+ (eq 0 (call-process-shell-command
+ (format "command -v %s" org-clock-x11idle-program-name)))
;; Check that x11idle can retrieve the idle time
- (eq (call-process-shell-command org-clock-x11idle-program-name nil nil nil) 0)))
+ ;; FIXME: Why "..-shell-command" rather than just `call-process'?
+ (eq 0 (call-process-shell-command org-clock-x11idle-program-name))))
(defun org-x11-idle-seconds ()
"Return the current X11 idle time in seconds."
@@ -1130,7 +1182,9 @@ time as the start time \(see `org-clock-continuously' to
make this the default behavior.)"
(interactive "P")
(setq org-clock-notification-was-shown nil)
- (org-refresh-properties org-effort-property 'org-effort)
+ (org-refresh-properties
+ org-effort-property '((effort . identity)
+ (effort-minutes . org-duration-string-to-minutes)))
(catch 'abort
(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
(org-clocking-p)))
@@ -1321,8 +1375,7 @@ With three universal prefix arguments, interactively prompt
for a todo state to switch to, overriding the existing value
`org-clock-in-switch-to-state'."
(interactive "P")
- (if (equal arg '(4))
- (org-clock-in (org-clock-select-task))
+ (if (equal arg '(4)) (org-clock-in arg)
(let ((start-time (if (or org-clock-continuously (equal arg '(16)))
(or org-clock-out-time
(org-current-time org-clock-rounding-minutes t))
@@ -1368,10 +1421,12 @@ decides which time to use."
(current-time))
((equal cmt "today")
(setq org--msg-extra "showing today's task time.")
- (let* ((dt (decode-time (current-time))))
- (setq dt (append (list 0 0 0) (nthcdr 3 dt)))
- (if org-extend-today-until
- (setf (nth 2 dt) org-extend-today-until))
+ (let* ((dt (decode-time))
+ (hour (nth 2 dt))
+ (day (nth 3 dt)))
+ (if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
+ (setf (nth 2 dt) org-extend-today-until)
+ (setq dt (append (list 0 0) (nthcdr 2 dt)))
(apply 'encode-time dt)))
((or (equal cmt "all")
(and (or (not cmt) (equal cmt "auto"))
@@ -1393,87 +1448,100 @@ When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock
line and position cursor in that line."
(org-back-to-heading t)
(catch 'exit
- (let* ((org-clock-into-drawer (org-clock-into-drawer))
- (beg (save-excursion
- (beginning-of-line 2)
- (or (bolp) (newline))
- (point)))
- (end (progn (outline-next-heading) (point)))
- (re (concat "^[ \t]*" org-clock-string))
- (cnt 0)
- (drawer (if (stringp org-clock-into-drawer)
- org-clock-into-drawer "LOGBOOK"))
- first last ind-last)
- (goto-char beg)
- (when (and find-unclosed
- (re-search-forward
- (concat "^[ \t]*" org-clock-string
- " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
- " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")
- end t))
- (beginning-of-line 1)
- (throw 'exit t))
- (when (eobp) (newline) (setq end (max (point) end)))
- (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t)
- ;; we seem to have a CLOCK drawer, so go there.
- (beginning-of-line 2)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))
- (throw 'exit t))
- ;; Lets count the CLOCK lines
+ (let* ((beg (line-beginning-position 2))
+ (end (save-excursion (outline-next-heading) (point)))
+ (org-clock-into-drawer (org-clock-into-drawer))
+ (drawer (cond
+ ((not org-clock-into-drawer) nil)
+ ((stringp org-clock-into-drawer) org-clock-into-drawer)
+ (t "LOGBOOK"))))
+ ;; Look for a running clock if FIND-UNCLOSED in non-nil.
+ (when find-unclosed
+ (let ((open-clock-re
+ (concat "^[ \t]*"
+ org-clock-string
+ " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
+ " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
+ (while (re-search-forward open-clock-re end t)
+ (let ((element (org-element-at-point)))
+ (when (and (eq (org-element-type element) 'clock)
+ (eq (org-element-property :status element) 'running))
+ (beginning-of-line)
+ (throw 'exit t))))))
+ ;; Look for an existing clock drawer.
+ (when drawer
+ (goto-char beg)
+ (let ((drawer-re (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")))
+ (while (re-search-forward drawer-re end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'drawer)
+ (let ((cend (org-element-property :contents-end element)))
+ (if (and (not org-log-states-order-reversed) cend)
+ (goto-char cend)
+ (forward-line))
+ (throw 'exit t)))))))
(goto-char beg)
- (while (re-search-forward re end t)
- (setq first (or first (match-beginning 0))
- last (match-beginning 0)
- cnt (1+ cnt)))
- (when (and (integerp org-clock-into-drawer)
- last
- (>= (1+ cnt) org-clock-into-drawer))
- ;; Wrap current entries into a new drawer
- (goto-char last)
- (setq ind-last (org-get-indentation))
- (beginning-of-line 2)
- (if (and (>= (org-get-indentation) ind-last)
- (org-at-item-p))
- (when (and (>= (org-get-indentation) ind-last)
- (org-at-item-p))
- (let ((struct (org-list-struct)))
- (goto-char (org-list-get-bottom-point struct)))))
- (insert ":END:\n")
- (beginning-of-line 0)
- (org-indent-line-to ind-last)
- (goto-char first)
- (insert ":" drawer ":\n")
- (beginning-of-line 0)
- (org-indent-line)
- (org-flag-drawer t)
- (beginning-of-line 2)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))
- (throw 'exit nil))
-
- (goto-char beg)
- (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
- (not (equal (match-string 1) org-clock-string)))
- ;; Planning info, skip to after it
- (beginning-of-line 2)
- (or (bolp) (newline)))
- (when (or (eq org-clock-into-drawer t)
- (stringp org-clock-into-drawer)
- (and (integerp org-clock-into-drawer)
- (< org-clock-into-drawer 2)))
- (insert ":" drawer ":\n:END:\n")
- (beginning-of-line -1)
- (org-indent-line)
- (org-flag-drawer t)
- (beginning-of-line 2)
- (org-indent-line)
- (beginning-of-line)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))))))
+ (let ((clock-re (concat "^[ \t]*" org-clock-string))
+ (count 0) positions first)
+ ;; Count the CLOCK lines and store their positions.
+ (save-excursion
+ (while (re-search-forward clock-re end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'clock)
+ (setq positions (cons (line-beginning-position) positions)
+ count (1+ count))))))
+ (cond
+ ((null positions)
+ ;; Skip planning line and property drawer, if any.
+ (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (forward-line))
+ (unless (bolp) (insert "\n"))
+ ;; Create a new drawer if necessary.
+ (when (and org-clock-into-drawer
+ (or (not (wholenump org-clock-into-drawer))
+ (< org-clock-into-drawer 2)))
+ (let ((beg (point)))
+ (insert ":" drawer ":\n:END:\n")
+ (org-indent-region beg (point))
+ (goto-char beg)
+ (org-flag-drawer t)
+ (forward-line))))
+ ;; When a clock drawer needs to be created because of the
+ ;; number of clock items, collect all clocks in the section
+ ;; and wrap them within the drawer.
+ ((and (wholenump org-clock-into-drawer)
+ (>= (1+ count) org-clock-into-drawer))
+ ;; Skip planning line and property drawer, if any.
+ (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (forward-line))
+ (let ((beg (point)))
+ (insert
+ (mapconcat
+ (lambda (p)
+ (save-excursion
+ (goto-char p)
+ (org-trim (delete-and-extract-region
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ (line-beginning-position 2)))))
+ positions "\n")
+ "\n:END:\n")
+ (let ((end (point-marker)))
+ (goto-char beg)
+ (save-excursion (insert ":" drawer ":\n"))
+ (org-flag-drawer t)
+ (org-indent-region (point) end)
+ (forward-line)
+ (unless org-log-states-order-reversed
+ (goto-char end)
+ (beginning-of-line -1))
+ (set-marker end nil))))
+ (org-log-states-order-reversed (goto-char (car (last positions))))
+ (t (goto-char (car positions))))))))
;;;###autoload
(defun org-clock-out (&optional switch-to-state fail-quietly at-time)
@@ -1561,11 +1629,14 @@ 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))
+ (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 (equal org-clock-into-drawer org-log-into-drawer)
+ ;; `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)))
@@ -1577,17 +1648,15 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(defun org-clock-remove-empty-clock-drawer nil
"Remove empty clock drawer in the current subtree."
- (let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER")
- org-log-into-drawer))
- (clock-drawer (if (eq t olid) "LOGBOOK" olid))
- (end (save-excursion (org-end-of-subtree t t))))
+ (let ((clock-drawer (org-log-into-drawer))
+ (end (save-excursion (org-end-of-subtree t t))))
(when clock-drawer
(save-excursion
(org-back-to-heading t)
(while (and (< (point) end)
(search-forward clock-drawer end t))
(goto-char (match-beginning 0))
- (org-remove-empty-drawer-at clock-drawer (point))
+ (org-remove-empty-drawer-at (point))
(forward-line 1))))))
(defun org-clock-timestamps-up (&optional n)
@@ -1651,12 +1720,13 @@ Optional argument N tells to change by that many units."
(setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(error "No active clock"))
- (save-excursion ; Do not replace this with `with-current-buffer'.
+ (save-excursion ; Do not replace this with `with-current-buffer'.
(org-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
- (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*"))
+ (if (org-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 "LOGBOOK" (point)))
+ (org-remove-empty-drawer-at (point)))
(message "Clock gone, cancel the timer anyway")
(sit-for 2)))
(move-marker org-clock-marker nil)
@@ -1668,12 +1738,6 @@ Optional argument N tells to change by that many units."
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
-(defcustom org-clock-goto-before-context 2
- "Number of lines of context to display before currently clocked-in entry.
-This applies when using `org-clock-goto'."
- :group 'org-clock
- :type 'integer)
-
;;;###autoload
(defun org-clock-goto (&optional select)
"Go to the currently clocked-in entry, or to the most recently clocked one.
@@ -1709,9 +1773,22 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(defun org-clock-sum-today (&optional headline-filter)
"Sum the times for each subtree for today."
- (interactive)
(let ((range (org-clock-special-range 'today)))
- (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today)))
+ (org-clock-sum (car range) (cadr range)
+ headline-filter :org-clock-minutes-today)))
+
+(defun org-clock-sum-custom (&optional headline-filter range propname)
+ "Sum the times for each subtree for today."
+ (let ((r (or (and (symbolp range) (org-clock-special-range range))
+ (org-clock-special-range
+ (intern (completing-read
+ "Range: "
+ '("today" "yesterday" "thisweek" "lastweek"
+ "thismonth" "lastmonth" "thisyear" "lastyear"
+ "interactive")
+ nil t))))))
+ (org-clock-sum (car r) (cadr r)
+ headline-filter (or propname :org-clock-minutes-custom))))
;;;###autoload
(defun org-clock-sum (&optional tstart tend headline-filter propname)
@@ -1722,7 +1799,6 @@ HEADLINE-FILTER is a zero-arg function that, if specified, is called for
each headline in the time range with point at the headline. Headlines for
which HEADLINE-FILTER returns nil are excluded from the clock summation.
PROPNAME lets you set a custom text property instead of :org-clock-minutes."
- (interactive)
(org-with-silent-modifications
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
org-clock-string
@@ -1780,6 +1856,8 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(save-excursion
(save-match-data (funcall headline-filter))))))
(setq level (- (match-end 1) (match-beginning 1)))
+ (when (>= level lmax)
+ (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
(when (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
@@ -1812,59 +1890,79 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
org-clock-file-total-minutes)))
;;;###autoload
-(defun org-clock-display (&optional total-only)
+(defun org-clock-display (&optional arg)
"Show subtree times in the entire buffer.
-If TOTAL-ONLY is non-nil, only show the total time for the entire file
-in the echo area.
+
+With one universal prefix argument, show the total time for
+today. With two universal prefix arguments, show the total time
+for a custom range, entered at the prompt. With three universal
+prefix arguments, show the total time in the echo area.
Use \\[org-clock-remove-overlays] to remove the subtree times."
- (interactive)
+ (interactive "P")
(org-clock-remove-overlays)
- (let (time h m p)
- (org-clock-sum)
- (unless total-only
+ (let* ((todayp (equal arg '(4)))
+ (customp (member arg '((16) today yesterday
+ thisweek lastweek thismonth
+ lastmonth thisyear lastyear
+ untilnow interactive)))
+ (prop (cond ((not arg) :org-clock-minutes-default)
+ (todayp :org-clock-minutes-today)
+ (customp :org-clock-minutes-custom)
+ (t :org-clock-minutes)))
+ time h m p)
+ (cond ((not arg) (org-clock-sum-custom
+ nil org-clock-display-default-range prop))
+ (todayp (org-clock-sum-today))
+ (customp (org-clock-sum-custom nil arg))
+ (t (org-clock-sum)))
+ (unless (eq arg '(64))
(save-excursion
(goto-char (point-min))
(while (or (and (equal (setq p (point)) (point-min))
- (get-text-property p :org-clock-minutes))
+ (get-text-property p prop))
(setq p (next-single-property-change
- (point) :org-clock-minutes)))
+ (point) prop)))
(goto-char p)
- (when (setq time (get-text-property p :org-clock-minutes))
- (org-clock-put-overlay time (funcall outline-level))))
+ (when (setq time (get-text-property p prop))
+ (org-clock-put-overlay time)))
(setq h (/ org-clock-file-total-minutes 60)
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
nil 'local))))
- (message (concat "Total file time: "
- (org-minutes-to-clocksum-string org-clock-file-total-minutes)
- " (%d hours and %d minutes)") h m)))
+ (message (concat (format "Total file time%s: "
+ (cond (todayp " for today")
+ (customp " (custom)")
+ (t "")))
+ (org-minutes-to-clocksum-string
+ org-clock-file-total-minutes)
+ " (%d hours and %d minutes)")
+ h m)))
(defvar org-clock-overlays nil)
(make-variable-buffer-local 'org-clock-overlays)
-(defun org-clock-put-overlay (time &optional level)
+(defun org-clock-put-overlay (time)
"Put an overlays on the current line, displaying TIME.
-If LEVEL is given, prefix time with a corresponding number of stars.
This creates a new overlay and stores it in `org-clock-overlays', so that it
will be easy to remove."
- (let* ((l (if level (org-get-valid-level level 0) 0))
- ov tx)
+ (let (ov tx)
(beginning-of-line)
(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))
- (make-string
- (max 0 (- (- 60 (current-column))
- (- (match-end 4) (match-beginning 4))
- (length (org-get-at-bol 'line-prefix)))) ?.)
- (org-add-props (concat (make-string l ?*) " "
- (org-minutes-to-clocksum-string time)
- (make-string (- 16 l) ?\ ))
- (list 'face 'org-clock-overlay))
+ (org-add-props
+ (make-string
+ (max 0 (- (- 60 (current-column))
+ (- (match-end 4) (match-beginning 4))
+ (length (org-get-at-bol 'line-prefix)))) ?·)
+ '(face shadow))
+ (org-add-props
+ (format " %9s " (org-minutes-to-clocksum-string time))
+ '(face org-clock-overlay))
""))
(if (not (featurep 'xemacs))
(overlay-put ov 'display tx)
@@ -1927,7 +2025,7 @@ fontified, and then returned."
(org-mode)
(org-create-dblock props)
(org-update-dblock)
- (font-lock-fontify-buffer)
+ (font-lock-ensure)
(forward-line 2)
(buffer-substring (point) (progn
(re-search-forward "^[ \t]*#\\+END" nil t)
@@ -2016,127 +2114,159 @@ buffer and update it."
(defun org-clock-special-range (key &optional time as-strings wstart mstart)
"Return two times bordering a special time range.
-Key is a symbol specifying the range and can be one of `today', `yesterday',
-`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
-By default, a week starts Monday 0:00 and ends Sunday 24:00.
-The range is determined relative to TIME, which defaults to current time.
-The return value is a cons cell with two internal times like the ones
-returned by `current time' or `encode-time'.
-If AS-STRINGS is non-nil, the returned times will be formatted strings.
-If WSTART is non-nil, use this number to specify the starting day of a
-week (monday is 1).
-If MSTART is non-nil, use this number to specify the starting day of a
-month (1 is the first day of the month).
-If you can combine both, the month starting day will have priority."
- (if (integerp key) (setq key (intern (number-to-string key))))
- (let* ((tm (decode-time (or time (current-time))))
- (s 0) (m (nth 1 tm)) (h (nth 2 tm))
- (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm))
+
+KEY is a symbol specifying the range and can be one of `today',
+`yesterday', `thisweek', `lastweek', `thismonth', `lastmonth',
+`thisyear', `lastyear' or `untilnow'. If set to `interactive',
+user is prompted for range boundaries. It can be a string or an
+integer.
+
+By default, a week starts Monday 0:00 and ends Sunday 24:00. The
+range is determined relative to TIME, which defaults to current
+time.
+
+The return value is a list containing two internal times, one for
+the beginning of the range and one for its end, like the ones
+returned by `current time' or `encode-time' and a string used to
+display information. If AS-STRINGS is non-nil, the returned
+times will be formatted strings.
+
+If WSTART is non-nil, use this number to specify the starting day
+of a week (monday is 1). If MSTART is non-nil, use this number
+to specify the starting day of a month (1 is the first day of the
+month). If you can combine both, the month starting day will
+have priority."
+ (let* ((tm (decode-time time))
+ (m (nth 1 tm))
+ (h (nth 2 tm))
+ (d (nth 3 tm))
+ (month (nth 4 tm))
+ (y (nth 5 tm))
(dow (nth 6 tm))
- (ws (or wstart 1))
- (ms (or mstart 1))
- (skey (symbol-name key))
+ (skey (format "%s" key))
(shift 0)
- (q (cond ((>= (nth 4 tm) 10) 4)
- ((>= (nth 4 tm) 7) 3)
- ((>= (nth 4 tm) 4) 2)
- ((>= (nth 4 tm) 1) 1)))
- s1 m1 h1 d1 month1 y1 diff ts te fm txt w date
- interval tmp shiftedy shiftedm shiftedq)
+ (q (cond ((>= month 10) 4)
+ ((>= month 7) 3)
+ ((>= month 4) 2)
+ (t 1)))
+ m1 h1 d1 month1 y1 shiftedy shiftedm shiftedq)
(cond
- ((string-match "^[0-9]+$" skey)
- (setq y (string-to-number skey) m 1 d 1 key 'year))
- ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey)
+ ((string-match "\\`[0-9]+\\'" skey)
+ (setq y (string-to-number skey) month 1 d 1 key 'year))
+ ((string-match "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)\\'" skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
- d 1 key 'month))
- ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey)
+ d 1
+ key 'month))
+ ((string-match "\\`\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)\\'" skey)
(require 'cal-iso)
- (setq y (string-to-number (match-string 1 skey))
- w (string-to-number (match-string 2 skey)))
- (setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (list w 1 y))))
- (setq d (nth 1 date) month (car date) y (nth 2 date)
- dow 1
- key 'week))
- ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
+ (let ((date (calendar-gregorian-from-absolute
+ (calendar-iso-to-absolute
+ (list (string-to-number (match-string 2 skey))
+ 1
+ (string-to-number (match-string 1 skey)))))))
+ (setq d (nth 1 date)
+ month (car date)
+ y (nth 2 date)
+ dow 1
+ key 'week)))
+ ((string-match "\\`\\([0-9]+\\)-[qQ]\\([1-4]\\)\\'" skey)
(require 'cal-iso)
- (setq y (string-to-number (match-string 1 skey)))
- (setq q (string-to-number (match-string 2 skey)))
- (setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (org-quarter-to-date q y))))
- (setq d (nth 1 date) month (car date) y (nth 2 date)
- dow 1
- key 'quarter))
- ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)
+ (let ((date (calendar-gregorian-from-absolute
+ (calendar-iso-to-absolute
+ (org-quarter-to-date
+ (string-to-number (match-string 2 skey))
+ (string-to-number (match-string 1 skey)))))))
+ (setq d (nth 1 date)
+ month (car date)
+ y (nth 2 date)
+ dow 1
+ key 'quarter)))
+ ((string-match
+ "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)\\'"
+ skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
d (string-to-number (match-string 3 skey))
key 'day))
- ((string-match "\\([-+][0-9]+\\)$" skey)
+ ((string-match "\\([-+][0-9]+\\)\\'" skey)
(setq shift (string-to-number (match-string 1 skey))
- key (intern (substring skey 0 (match-beginning 1))))
- (if (and (memq key '(quarter thisq)) (> shift 0))
- (error "Looking forward with quarters isn't implemented"))))
-
+ key (intern (substring skey 0 (match-beginning 1))))
+ (when (and (memq key '(quarter thisq)) (> shift 0))
+ (error "Looking forward with quarters isn't implemented"))))
(when (= shift 0)
- (cond ((eq key 'yesterday) (setq key 'today shift -1))
- ((eq key 'lastweek) (setq key 'week shift -1))
- ((eq key 'lastmonth) (setq key 'month shift -1))
- ((eq key 'lastyear) (setq key 'year shift -1))
- ((eq key 'lastq) (setq key 'quarter shift -1))))
- (cond
- ((memq key '(day today))
- (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
- ((memq key '(week thisweek))
- (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))
- m 0 h 0 d (- d diff) d1 (+ 7 d)))
- ((memq key '(month thismonth))
- (setq d (or ms 1) h 0 m 0 d1 (or ms 1)
- month (+ month shift) month1 (1+ month) h1 0 m1 0))
- ((memq key '(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.
- (cond
- ((< (+ (- q 1) shift) 0) ; shift not in this year
- (setq interval (* -1 (+ (- q 1) shift)))
- ;; Set tmp to ((years to shift) (quarters to shift)).
- (setq tmp (org-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))
- shiftedm 1
- shiftedq 1)
- (setq shiftedy (- y (+ 1 (nth 0 tmp)))
- shiftedm (- 13 (* 3 (nth 1 tmp)))
- shiftedq (- 5 (nth 1 tmp))))
- (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy))
- ((> (+ q shift) 0) ; shift is within this year
- (setq shiftedq (+ q shift))
- (setq shiftedy y)
- (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
- ((memq key '(year thisyear))
- (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
- (t (error "No such time block %s" key)))
- (setq ts (encode-time s m h d month y)
- te (encode-time (or s1 s) (or m1 m) (or h1 h)
- (or d1 d) (or month1 month) (or y1 y)))
- (setq fm (cdr org-time-stamp-formats))
- (cond
- ((memq key '(day today))
- (setq txt (format-time-string "%A, %B %d, %Y" ts)))
- ((memq key '(week thisweek))
- (setq txt (format-time-string "week %G-W%V" ts)))
- ((memq key '(month thismonth))
- (setq txt (format-time-string "%B %Y" ts)))
- ((memq key '(year thisyear))
- (setq txt (format-time-string "the year %Y" ts)))
- ((memq key '(quarter thisq))
- (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))))
- (if as-strings
- (list (format-time-string fm ts) (format-time-string fm te) txt)
- (list ts te txt))))
+ (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))))
+ ;; 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)
+ (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)
+ (setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month)))
+ ((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.
+ (cond
+ ((< (+ (- 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)))
+ ;; Due to the use of floor, 0 quarters actually means 4.
+ (if (= 0 (nth 1 tmp))
+ (setq shiftedy (- y (nth 0 tmp))
+ shiftedm 1
+ shiftedq 1)
+ (setq shiftedy (- y (+ 1 (nth 0 tmp)))
+ shiftedm (- 13 (* 3 (nth 1 tmp)))
+ shiftedq (- 5 (nth 1 tmp)))))
+ (setq m 0 h 0 d 1 month shiftedm month1 (+ 3 shiftedm) y shiftedy))
+ ((> (+ q shift) 0) ; Shift is within this year.
+ (setq shiftedq (+ q shift))
+ (setq shiftedy y)
+ (let ((qshift (* 3 (1- (+ q shift)))))
+ (setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift))))))
+ ((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)))
+ ;; 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
+ (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)
+ (concat (org-count-quarter shiftedq)
+ " quarter of " (number-to-string shiftedy)))
+ (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)
+ (format-time-string f end)
+ text))))))
(defun org-count-quarter (n)
(cond
@@ -2192,7 +2322,7 @@ the currently selected interval size."
((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (list (+ mw n) 1 y))))
+ (calendar-iso-to-absolute (list (+ mw n) 1 y))))
(setq ins (format-time-string
"%G-W%V"
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
@@ -2209,7 +2339,7 @@ the currently selected interval size."
y (- y 1))
())
(setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
+ (calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y))))
(setq ins (format-time-string
(concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
@@ -2336,6 +2466,7 @@ from the dynamic block definition."
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))
@@ -2542,6 +2673,11 @@ from the dynamic block definition."
(when org-hide-emphasis-markers
;; we need to align a second time
(org-table-align))
+ (when sort
+ (save-excursion
+ (org-table-goto-line 3)
+ (org-table-goto-column (car sort))
+ (org-table-sort-lines nil (cdr sort))))
(when recalc
(if (eq formula '%)
(save-excursion
@@ -2556,10 +2692,10 @@ from the dynamic block definition."
total-time))
(defun org-clocktable-indent-string (level)
+ "Return indentation string according to LEVEL.
+LEVEL is an integer. Indent by two spaces per level above 1."
(if (= level 1) ""
- (let ((str " "))
- (dotimes (k (1- level) str)
- (setq str (concat "\\emsp" str))))))
+ (concat "\\_" (make-string (* 2 (1- level)) ?\s))))
(defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables."
@@ -2670,10 +2806,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(when (and te (listp te))
(setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
;; Now the times are strings we can parse.
- (if ts (setq ts (org-float-time
- (seconds-to-time (org-matcher-time ts)))))
- (if te (setq te (org-float-time
- (seconds-to-time (org-matcher-time te)))))
+ (if ts (setq ts (org-matcher-time ts)))
+ (if te (setq te (org-matcher-time te)))
(save-excursion
(org-clock-sum ts te
(unless (null matcher)
@@ -2813,8 +2947,8 @@ The details of what will be saved are regulated by the variable
(delete-region (point-min) (point-max))
;;Store clock
(insert (format ";; org-persist.el - %s at %s\n"
- system-name (format-time-string
- (cdr org-time-stamp-formats))))
+ (system-name) (format-time-string
+ (cdr org-time-stamp-formats))))
(if (and (memq org-clock-persist '(t clock))
(setq b (org-clocking-buffer))
(setq b (or (buffer-base-buffer b) b))
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 07ee69f..251f425 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -158,109 +158,99 @@ This is the compiled version of the format.")
(defun org-columns-display-here (&optional props dateline)
"Overlay the current line with column display."
(interactive)
- (let* ((fmt org-columns-current-fmt-compiled)
- (beg (point-at-bol))
- (level-face (save-excursion
- (beginning-of-line 1)
- (and (looking-at "\\(\\**\\)\\(\\* \\)")
- (org-get-level-face 2))))
- (ref-face (or level-face
- (and (eq major-mode 'org-agenda-mode)
- (get-text-property (point-at-bol) 'face))
- 'default))
- (color (list :foreground (face-attribute ref-face :foreground)))
- (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))
- (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
- pom property ass width f fc string fm ov column val modval s2 title calc)
- ;; Check if the entry is in another buffer.
- (unless props
- (if (eq major-mode 'org-agenda-mode)
- (setq pom (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker))
- props (if pom (org-entry-properties pom) nil))
- (setq props (org-entry-properties nil))))
- ;; Walk the format
- (while (setq column (pop fmt))
- (setq property (car column)
- title (nth 1 column)
- ass (if (equal property "ITEM")
- (cons "ITEM"
- ;; When in a buffer, get the whole line,
- ;; we'll clean it later…
- (if (derived-mode-p 'org-mode)
- (save-match-data
- (org-remove-tabs
- (buffer-substring-no-properties
- (point-at-bol) (point-at-eol))))
- ;; In agenda, just get the `txt' property
- (or (org-get-at-bol 'txt)
- (buffer-substring-no-properties
- (point) (progn (end-of-line) (point))))))
- (assoc property props))
- width (or (cdr (assoc property org-columns-current-maxwidths))
- (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 ((and org-columns-modify-value-for-display-function
- (functionp
- org-columns-modify-value-for-display-function))
- (funcall org-columns-modify-value-for-display-function
- title val))
- ((equal property "ITEM")
- (org-columns-cleanup-item
- val org-columns-current-fmt-compiled
- (or org-complex-heading-regexp cphr)))
- (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))))
- (setq s2 (org-columns-add-ellipses (or modval val) width))
- (setq string (format f s2))
- ;; Create the overlay
+ (save-excursion
+ (beginning-of-line)
+ (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)")
+ (org-get-level-face 2)))
+ (ref-face (or level-face
+ (and (eq major-mode 'org-agenda-mode)
+ (org-get-at-bol 'face))
+ 'default))
+ (color (list :foreground (face-attribute ref-face :foreground)))
+ (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)))))
+ ;; 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.
+ (let ((columns (length org-columns-current-fmt-compiled))
+ (chars (- (line-end-position) (line-beginning-position))))
+ (when (> columns chars)
+ (save-excursion
+ (end-of-line)
+ (let ((inhibit-read-only t))
+ (insert (make-string (- columns chars) ?\s))))))
+ ;; Walk the format. 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
+ ((and org-columns-modify-value-for-display-function
+ (functionp
+ org-columns-modify-value-for-display-function))
+ (funcall org-columns-modify-value-for-display-function
+ title val))
+ ((equal property "ITEM") (org-columns-compact-links val))
+ (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 (org-columns-add-ellipses (or modval val) width)))
+ (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)))
+ ;; Make the rest of the line disappear.
+ (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 "")
+ (overlay-put ov 'wrap-prefix ""))
+ (let ((ov (make-overlay (1- (line-end-position))
+ (line-beginning-position 2))))
+ (overlay-put ov 'keymap org-columns-map)
+ (push ov org-columns-overlays))
(org-with-silent-modifications
- (setq ov (org-columns-new-overlay
- beg (setq beg (1+ beg)) 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 ""))
- (if (or (not (char-after beg))
- (equal (char-after beg) ?\n))
- (let ((inhibit-read-only t))
- (save-excursion
- (goto-char beg)
- (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later?
- ;; Make the rest of the line disappear.
- (org-unmodified
- (setq ov (org-columns-new-overlay beg (point-at-eol)))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'keymap org-columns-map)
- (overlay-put ov 'intangible t)
- (overlay-put ov 'line-prefix "")
- (overlay-put ov 'wrap-prefix "")
- (push ov org-columns-overlays)
- (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
- (overlay-put ov 'keymap org-columns-map)
- (push ov org-columns-overlays)
- (let ((inhibit-read-only t))
- (put-text-property (max (point-min) (1- (point-at-bol)))
- (min (point-max) (1+ (point-at-eol)))
- 'read-only "Type `e' to edit property")))))
+ (let ((inhibit-read-only t))
+ (put-text-property
+ (line-end-position 0)
+ (line-beginning-position 2)
+ 'read-only
+ (substitute-command-keys
+ "Type \\<org-columns-map>\\[org-columns-edit-value] \
+to edit property")))))))
(defun org-columns-add-ellipses (string width)
"Truncate STRING with WIDTH characters, with ellipses."
@@ -294,7 +284,9 @@ for the duration of the command.")
(while (setq column (pop fmt))
(setq property (car column)
str (or (nth 1 column) property)
- width (or (cdr (assoc property org-columns-current-maxwidths))
+ width (or (cdr (assoc-string property
+ org-columns-current-maxwidths
+ t))
(nth 2 column)
(length str))
widths (push width widths)
@@ -348,29 +340,6 @@ for the duration of the command.")
(when (local-variable-p 'org-colview-initial-truncate-line-value)
(setq truncate-lines org-colview-initial-truncate-line-value)))))
-(defun org-columns-cleanup-item (item fmt cphr)
- "Remove from ITEM what is a column in the format FMT.
-CPHR is the complex heading regexp to use for parsing ITEM."
- (let (fixitem)
- (if (not cphr)
- item
- (unless (string-match "^\*+ " item)
- (setq item (concat "* " item) fixitem t))
- (if (string-match cphr item)
- (setq item
- (concat
- (org-add-props (match-string 1 item) nil
- 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
- (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
- " " (save-match-data (org-columns-compact-links (or (match-string 4 item) "")))
- (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
- (add-text-properties
- 0 (1+ (match-end 1))
- (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- item))
- (if fixitem (replace-regexp-in-string "^\*+ " "" item) item))))
-
(defun org-columns-compact-links (s)
"Replace [[link][desc]] with [desc] or [link]."
(while (string-match org-bracket-link-regexp s)
@@ -434,7 +403,7 @@ Where possible, use the standard interface for changing this line."
(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
+ (point))) ; keep despite of compiler waring
(line-overlays
(delq nil (mapcar (lambda (x)
(and (eq (overlay-buffer x) (current-buffer))
@@ -510,7 +479,7 @@ Where possible, use the standard interface for changing this line."
(org-columns-display-here)))
(org-move-to-column col)
(if (and (derived-mode-p 'org-mode)
- (nth 3 (assoc key org-columns-current-fmt-compiled)))
+ (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????
@@ -579,7 +548,7 @@ an integer, select that value."
(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
+ (point))) ; keep despite of compiler waring
(line-overlays
(delq nil (mapcar (lambda (x)
(and (eq (overlay-buffer x) (current-buffer))
@@ -589,7 +558,9 @@ an integer, select that value."
org-columns-overlays)))
(allowed (or (org-property-get-allowed-values pom key)
(and (memq
- (nth 4 (assoc key org-columns-current-fmt-compiled))
+ (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)))
@@ -638,7 +609,7 @@ an integer, select that value."
(org-columns-eval '(org-entry-put pom key nval)))
(org-columns-display-here)))
(org-move-to-column col)
- (and (nth 3 (assoc key org-columns-current-fmt-compiled))
+ (and (nth 3 (assoc-string key org-columns-current-fmt-compiled t))
(org-columns-update key))))))
(defun org-colview-construct-allowed-dates (s)
@@ -705,49 +676,48 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(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)))
- beg end fmt cache maxwidths)
- (org-columns-goto-top-level)
- (setq fmt (org-columns-get-format columns-fmt-string))
- (save-excursion
- (goto-char org-columns-top-level-marker)
- (setq beg (point))
- (unless org-columns-inhibit-recalculation
- (org-columns-compute-all))
- (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
- (point-max)))
- ;; Get and cache the properties
- (goto-char beg)
+ (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
+ org-columns-top-level-marker
+ (or (ignore-errors (org-end-of-subtree t t)) (point-max)))
+ (goto-char (point-min))
(when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (org-clock-sum))))
+ (org-clock-sum))
(when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (org-clock-sum-today))))
- (while (re-search-forward org-outline-regexp-bol end t)
- (if (and org-columns-skip-archived-trees
- (looking-at (concat ".*:" org-archive-tag ":")))
- (org-end-of-subtree t)
- (push (cons (org-current-line) (org-entry-properties)) cache)))
- (when cache
- (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
- (org-set-local 'org-columns-current-maxwidths maxwidths)
- (org-columns-display-here-title)
- (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)
- (mapc (lambda (x)
- (org-goto-line (car x))
- (org-columns-display-here (cdr x)))
- cache)))))
+ (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-entry-get nil p 'selective t)))
+ 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))
@@ -791,7 +761,8 @@ calc function called on every element before summarizing. This is
(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
"Insert a new column, to the left of the current column."
(interactive)
- (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
+ (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))
@@ -849,7 +820,9 @@ calc function called on every element before summarizing. This is
(let* ((n (current-column))
(entry (nth n org-columns-current-fmt-compiled))
(width (or (nth 2 entry)
- (cdr (assoc (car entry) org-columns-current-maxwidths)))))
+ (cdr (assoc-string (car entry)
+ org-columns-current-maxwidths
+ t)))))
(setq width (max 1 (+ width arg)))
(setcar (nthcdr 2 entry) width)
(org-columns-store-format)
@@ -900,7 +873,7 @@ display, or in the #+COLUMNS line of the current buffer."
(org-entry-put nil "COLUMNS" fmt)
(goto-char (point-min))
;; Overwrite all #+COLUMNS lines....
- (while (re-search-forward "^#\\+COLUMNS:.*" nil t)
+ (while (re-search-forward "^[ \t]*#\\+COLUMNS:.*" nil t)
(setq cnt (1+ cnt))
(replace-match (concat "#+COLUMNS: " fmt) t t))
(unless (> cnt 0)
@@ -917,11 +890,14 @@ display, or in the #+COLUMNS line of the current buffer."
(push (cons (match-string 1 s) 1) rtn)
(setq start (match-end 0)))
(mapc (lambda (x)
- (setcdr x (apply 'max
+ (setcdr x
+ (apply #'max
+ (let ((prop (car x)))
(mapcar
(lambda (y)
- (length (or (cdr (assoc (car x) (cdr y))) " ")))
- cache))))
+ (length (or (cdr (assoc-string prop (cdr y) t))
+ " ")))
+ cache)))))
rtn)
rtn))
@@ -946,9 +922,11 @@ display, or in the #+COLUMNS line of the current buffer."
(when (equal (overlay-get ov 'org-columns-key) property)
(setq pos (overlay-start ov))
(goto-char pos)
- (when (setq val (cdr (assoc property
- (get-text-property
- (point-at-bol) 'org-summaries))))
+ (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)))))
@@ -962,11 +940,11 @@ display, or in the #+COLUMNS line of the current buffer."
"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???
+ (lmax 30) ; Does anyone use deeper levels???
(lvals (make-vector lmax nil))
(lflag (make-vector lmax nil))
(level 0)
- (ass (assoc property org-columns-current-fmt-compiled))
+ (ass (assoc-string property org-columns-current-fmt-compiled t))
(format (nth 4 ass))
(printf (nth 5 ass))
(fun (nth 6 ass))
@@ -990,24 +968,28 @@ display, or in the #+COLUMNS line of the current buffer."
valflag (and val (string-match "\\S-" val)))
(cond
((< level last-level)
- ;; put the sum of lower levels here as a property
- (setq sum (+ (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))
+ ;; 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))
- (if (assoc property sum-alist)
- (setcdr (assoc property sum-alist) useval)
- (push (cons property useval) sum-alist)
- (org-with-silent-modifications
- (add-text-properties sumpos (1+ sumpos)
- (list 'org-summaries sum-alist))))
+ (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
@@ -1086,7 +1068,7 @@ display, or in the #+COLUMNS line of the current buffer."
(defun org-nofm-to-completion (n m &optional percent)
(if (not percent)
(format "[%d/%d]" n m)
- (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m)))))))
+ (format "[%d%%]" (round (* 100.0 n) m))))
(defun org-columns-string-to-number (s fmt)
@@ -1109,6 +1091,9 @@ display, or in the #+COLUMNS line of the current buffer."
(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)
@@ -1117,14 +1102,11 @@ display, or in the #+COLUMNS line of the current buffer."
(while l
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum))
- ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
- (if (equal s "[X]") 1. 0.000001))
- ((memq fmt '(estimate)) (org-string-to-estimate s))
(t (string-to-number s)))))
(defun org-columns-uncompile-format (cfmt)
"Turn the compiled columns format back into a string representation."
- (let ((rtn "") e s prop title op op-match width fmt printf fun calc)
+ (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)
@@ -1134,8 +1116,10 @@ display, or in the #+COLUMNS line of the current buffer."
printf (nth 5 e)
fun (nth 6 e)
calc (nth 7 e))
- (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map))
- (setq op (car op-match)))
+ (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))
@@ -1146,7 +1130,8 @@ display, or in the #+COLUMNS line of the current buffer."
(org-trim rtn)))
(defun org-columns-compile-format (fmt)
- "Turn a column format string into an alist of specifications.
+ "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
@@ -1156,7 +1141,9 @@ 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"
+calc function to get values from base elements
+
+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)
(while (string-match
@@ -1199,8 +1186,6 @@ 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))
- (re-comment (format org-heading-keyword-regexp-format
- org-comment-string))
(re-archive (concat ".*:" org-archive-tag ":"))
(n (length title)) row tbl)
(goto-char (point-min))
@@ -1212,9 +1197,9 @@ of fields."
(/ (1+ (length (match-string 1))) 2)
(length (match-string 1)))))
(get-char-property (match-beginning 0) 'org-columns-key))
- (when (save-excursion
- (goto-char (point-at-bol))
- (or (looking-at re-comment)
+ (when (or (org-in-commented-heading-p t)
+ (save-excursion
+ (beginning-of-line)
(looking-at re-archive)))
(org-end-of-subtree t)
(throw 'next t))
@@ -1377,60 +1362,73 @@ and tailing newline characters."
(org-columns-remove-overlays)
(move-marker org-columns-begin-marker (point))
(let ((org-columns-time (time-to-number-of-days (current-time)))
- cache maxwidths m p a d fmt)
- (cond
- ((and (boundp 'org-agenda-overriding-columns-format)
- org-agenda-overriding-columns-format)
- (setq fmt org-agenda-overriding-columns-format))
- ((setq m (org-get-at-bol 'org-hd-marker))
- (setq fmt (or (org-entry-get m "COLUMNS" t)
- (with-current-buffer (marker-buffer m)
- org-columns-default-format))))
- ((and (boundp 'org-columns-current-fmt)
- (local-variable-p 'org-columns-current-fmt)
- org-columns-current-fmt)
- (setq fmt org-columns-current-fmt))
- ((setq m (next-single-property-change (point-min) 'org-hd-marker))
- (setq m (get-text-property m 'org-hd-marker))
- (setq fmt (or (org-entry-get m "COLUMNS" t)
- (with-current-buffer (marker-buffer m)
- org-columns-default-format)))))
- (setq fmt (or fmt org-columns-default-format))
+ (fmt
+ (cond
+ ((org-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)
+ (with-current-buffer (marker-buffer m)
+ org-columns-default-format)))))
+ ((and (local-variable-p 'org-columns-current-fmt)
+ org-columns-current-fmt))
+ ((let ((m (next-single-property-change (point-min) 'org-hd-marker)))
+ (and m
+ (let ((m (get-text-property m 'org-hd-marker)))
+ (or (org-entry-get m "COLUMNS" t)
+ (with-current-buffer (marker-buffer m)
+ org-columns-default-format))))))
+ (t org-columns-default-format))))
(org-set-local 'org-columns-current-fmt fmt)
(org-columns-compile-format fmt)
(when org-agenda-columns-compute-summary-properties
(org-agenda-colview-compute org-columns-current-fmt-compiled))
(save-excursion
- ;; Get and cache the properties
+ ;; Collect properties for each headline in current view.
(goto-char (point-min))
- (while (not (eobp))
- (when (setq m (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker)))
- (setq p (org-entry-properties m))
-
- (when (or (not (setq a (assoc org-effort-property p)))
- (not (string-match "\\S-" (or (cdr a) ""))))
- ;; OK, the property is not defined. Use appointment duration?
- (when (and org-agenda-columns-add-appointments-to-effort-sum
- (setq d (get-text-property (point) 'duration)))
- (setq d (org-minutes-to-clocksum-string d))
- (put-text-property 0 (length d) 'face 'org-warning d)
- (push (cons org-effort-property d) p)))
- (push (cons (org-current-line) p) cache))
- (beginning-of-line 2))
- (when cache
- (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
- (org-set-local 'org-columns-current-maxwidths maxwidths)
- (org-columns-display-here-title)
- (when (org-set-local 'org-columns-flyspell-was-active
- (org-bound-and-true-p flyspell-mode))
- (flyspell-mode 0))
- (mapc (lambda (x)
- (org-goto-line (car x))
- (org-columns-display-here (cdr x)))
- cache)
- (when org-agenda-columns-show-summaries
- (org-agenda-colview-summarize cache))))))
+ (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-entry-get (point) name 'selective t)))
+ (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)))
+ (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))
+ (flyspell-mode 0))
+ (dolist (x cache)
+ (goto-char (car x))
+ (org-columns-display-here (cdr x)))
+ (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.
@@ -1478,7 +1476,7 @@ This will add overlays to the date lines, to show the summary for each day."
(t ;; do the summary
(setq lsum nil)
(dolist (x entries)
- (setq v (cdr (assoc prop x)))
+ (setq v (cdr (assoc-string prop x t)))
(if v
(push
(funcall
@@ -1529,8 +1527,9 @@ This will add overlays to the date lines, to show the summary for each day."
((equal (car fm) "CLOCKSUM_T")
(org-clock-sum-today))
((and (nth 4 fm)
- (setq a (assoc (car fm)
- org-columns-current-fmt-compiled))
+ (setq a (assoc-string (car fm)
+ org-columns-current-fmt-compiled
+ t))
(equal (nth 4 a) (nth 4 fm)))
(org-columns-compute (car fm)))))))))))
@@ -1547,7 +1546,10 @@ This will add overlays to the date lines, to show the summary for each day."
(defun org-estimate-mean-and-var (v)
"Return the mean and variance of an estimate."
- (let* ((low (float (car v)))
+ (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)))
@@ -1570,8 +1572,11 @@ and variances (respectively) of the individual estimates."
(defun org-estimate-print (e &optional fmt)
"Prepare a string representation of an estimate.
This formats these numbers as two numbers with a \"-\" between them."
- (if (null fmt) (set 'fmt "%.0f"))
- (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-")))
+ (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.
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index 90380a8..a762b8e 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -1,6 +1,6 @@
;;; org-compat.el --- Compatibility code for Org-mode
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -40,11 +40,6 @@
;; 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))
-(defconst org-format-transports-properties-p
- (let ((x "a"))
- (add-text-properties 0 1 '(test t) x)
- (get-text-property 0 'test (format "%s" x)))
- "Does format transport text properties?")
(defun org-compatible-face (inherits specs)
"Make a compatible face specification.
@@ -241,7 +236,7 @@ ignored in this case."
(or window (selected-window)))
(defun org-number-sequence (from &optional to inc)
- "Call `number-sequence or emulate it."
+ "Call `number-sequence' or emulate it."
(if (fboundp 'number-sequence)
(number-sequence from to inc)
(if (or (not to) (= from to))
@@ -287,17 +282,8 @@ Works on both Emacs and XEmacs."
(> (point) (region-beginning)))
(exchange-point-and-mark)))
-;; Emacs 22 misses `activate-mark'
-(if (fboundp 'activate-mark)
- (defalias 'org-activate-mark 'activate-mark)
- (defun org-activate-mark ()
- (when (mark t)
- (setq mark-active t)
- (when (and (boundp 'transient-mark-mode)
- (not transient-mark-mode))
- (setq transient-mark-mode 'lambda))
- (when (boundp 'zmacs-regions)
- (setq zmacs-regions t)))))
+;; Old alias for emacs 22 compatibility, now dropped
+(define-obsolete-function-alias 'org-activate-mark 'activate-mark)
;; Invisibility compatibility
@@ -411,17 +397,17 @@ Pass BUFFER to the XEmacs version of `move-to-column'."
(when focus-follows-mouse
(set-mouse-position frame (1- (frame-width frame)) 0)))))
-(defun org-float-time (&optional time)
- "Convert time value TIME to a floating point number.
-TIME defaults to the current time."
- (if (featurep 'xemacs)
- (time-to-seconds (or time (current-time)))
- (float-time time)))
+(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))
+;; `font-lock-ensure' is only available from 24.4.50 on
+(unless (fboundp 'font-lock-ensure)
+ (defalias 'font-lock-ensure 'font-lock-fontify-buffer))
+
(defmacro org-no-popups (&rest body)
"Suppress popup windows.
Let-bind some variables to nil around BODY to achieve the desired
diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el
index 41775bd..faf543b 100644
--- a/lisp/org-ctags.el
+++ b/lisp/org-ctags.el
@@ -63,19 +63,19 @@
;; with the same name as the link; then, if unsuccessful, ask the user if
;; he/she wants to rebuild the 'TAGS' database and try again; then ask if
;; the user wishes to append 'tag' as a new toplevel heading at the end of
-;; the buffer; and finally, defer to org's default behaviour which is to
+;; the buffer; and finally, defer to org's default behavior which is to
;; search the entire text of the current buffer for 'tag'.
;;
-;; This behaviour can be modified by changing the value of
+;; This behavior can be modified by changing the value of
;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my
-;; .emacs, which describes the same behaviour as the above paragraph with
+;; .emacs, which describes the same behavior as the above paragraph with
;; one difference:
;;
;; (setq org-ctags-open-link-functions
;; '(org-ctags-find-tag
;; org-ctags-ask-rebuild-tags-file-then-find-tag
;; org-ctags-ask-append-topic
-;; org-ctags-fail-silently)) ; <-- prevents org default behaviour
+;; org-ctags-fail-silently)) ; <-- prevents org default behavior
;;
;;
;; Usage
diff --git a/lisp/org-docview.el b/lisp/org-docview.el
index d2db685..479f4ff 100644
--- a/lisp/org-docview.el
+++ b/lisp/org-docview.el
@@ -1,6 +1,6 @@
;;; org-docview.el --- support for links to doc-view-mode buffers
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -54,8 +54,8 @@
(defun org-docview-export (link description format)
"Export a docview link from Org files."
- (let* ((path (when (string-match "\\(.+\\)::.+" link)
- (match-string 1 link)))
+ (let* ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link)
+ link))
(desc (or description link)))
(when (stringp path)
(setq path (org-link-escape (expand-file-name path)))
@@ -66,13 +66,14 @@
(t path)))))
(defun org-docview-open (link)
- (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link)
- (let* ((path (match-string 1 link))
- (page (string-to-number (match-string 2 link))))
- (org-open-file path 1) ;; let org-mode open the file (in-emacs = 1)
- ;; to ensure org-link-frame-setup is respected
- (doc-view-goto-page page)
- )))
+ (string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link)
+ (let ((path (match-string 1 link))
+ (page (and (match-beginning 2)
+ (string-to-number (match-string 2 link)))))
+ ;; Let Org mode open the file (in-emacs = 1) to ensure
+ ;; org-link-frame-setup is respected.
+ (org-open-file path 1)
+ (when page (doc-view-goto-page page))))
(defun org-docview-store-link ()
"Store a link to a docview buffer."
diff --git a/lisp/org-element.el b/lisp/org-element.el
index eb8ff41..c7e76e8 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -1,6 +1,6 @@
;;; org-element.el --- Parser And Applications for Org syntax
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -31,7 +31,7 @@
;;
;; An element always starts and ends at the beginning of a line. With
;; a few exceptions (`clock', `headline', `inlinetask', `item',
-;; `planning', `node-property', `quote-section' `section' and
+;; `planning', `property-drawer', `node-property', `section' and
;; `table-row' types), it can also accept a fixed set of keywords as
;; attributes. Those are called "affiliated keywords" to distinguish
;; them from other keywords, which are full-fledged elements. Almost
@@ -48,10 +48,9 @@
;; Other element types are: `babel-call', `clock', `comment',
;; `comment-block', `diary-sexp', `example-block', `export-block',
;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
-;; `node-property', `paragraph', `planning', `quote-section',
-;; `src-block', `table', `table-row' and `verse-block'. Among them,
-;; `paragraph' and `verse-block' types can contain Org objects and
-;; plain text.
+;; `node-property', `paragraph', `planning', `src-block', `table',
+;; `table-row' and `verse-block'. Among them, `paragraph' and
+;; `verse-block' types can contain Org objects and plain text.
;;
;; Objects are related to document's contents. Some of them are
;; recursive. Associated types are of the following: `bold', `code',
@@ -75,9 +74,9 @@
;; refers to the element or object containing it. Greater elements,
;; elements and objects containing objects will also have
;; `:contents-begin' and `:contents-end' properties to delimit
-;; contents. Eventually, greater elements and elements accepting
-;; affiliated keywords will have a `:post-affiliated' property,
-;; referring to the buffer position after all such keywords.
+;; contents. Eventually, All elements have a `:post-affiliated'
+;; property referring to the buffer position after all affiliated
+;; keywords, if any, or to their beginning position otherwise.
;;
;; At the lowest level, a `:parent' property is also attached to any
;; string, as a text property.
@@ -111,13 +110,15 @@
;;
;; The library ends by furnishing `org-element-at-point' function, and
;; a way to give information about document structure around point
-;; with `org-element-context'.
+;; with `org-element-context'. A cache mechanism is also provided for
+;; these functions.
;;; Code:
(eval-when-compile (require 'cl))
(require 'org)
+(require 'avl-tree)
@@ -127,56 +128,111 @@
;; along with the affiliated keywords recognized. Also set up
;; restrictions on recursive objects combinations.
;;
-;; These variables really act as a control center for the parsing
-;; process.
-
-(defconst org-element-paragraph-separate
- (concat "^\\(?:"
- ;; Headlines, inlinetasks.
- org-outline-regexp "\\|"
- ;; Footnote definitions.
- "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
- ;; Diary sexps.
- "%%(" "\\|"
- "[ \t]*\\(?:"
- ;; Empty lines.
- "$" "\\|"
- ;; Tables (any type).
- "\\(?:|\\|\\+-[-+]\\)" "\\|"
- ;; Blocks (any type), Babel calls and keywords. Note: this
- ;; is only an indication and need some thorough check.
- "#\\(?:[+ ]\\|$\\)" "\\|"
- ;; Drawers (any type) and fixed-width areas. This is also
- ;; only an indication.
- ":" "\\|"
- ;; Horizontal rules.
- "-\\{5,\\}[ \t]*$" "\\|"
- ;; LaTeX environments.
- "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|"
- ;; Planning and Clock lines.
- (regexp-opt (list org-scheduled-string
- org-deadline-string
- org-closed-string
- org-clock-string))
- "\\|"
- ;; Lists.
- (let ((term (case org-plain-list-ordered-item-terminator
- (?\) ")") (?. "\\.") (otherwise "[.)]")))
- (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
- (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
- "\\(?:[ \t]\\|$\\)"))
- "\\)\\)")
+;; `org-element-update-syntax' builds proper syntax regexps according
+;; to current setup.
+
+(defvar org-element-paragraph-separate nil
"Regexp to separate paragraphs in an Org buffer.
In the case of lines starting with \"#\" and \":\", this regexp
is not sufficient to know if point is at a paragraph ending. See
`org-element-paragraph-parser' for more information.")
+(defvar org-element--object-regexp nil
+ "Regexp possibly matching the beginning of an object.
+This regexp allows false positives. Dedicated parser (e.g.,
+`org-export-bold-parser') will take care of further filtering.
+Radio links are not matched by this regexp, as they are treated
+specially in `org-element--object-lex'.")
+
+(defun org-element--set-regexps ()
+ "Build variable syntax regexps."
+ (setq org-element-paragraph-separate
+ (concat "^\\(?:"
+ ;; Headlines, inlinetasks.
+ org-outline-regexp "\\|"
+ ;; Footnote definitions.
+ "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ ;; Diary sexps.
+ "%%(" "\\|"
+ "[ \t]*\\(?:"
+ ;; Empty lines.
+ "$" "\\|"
+ ;; Tables (any type).
+ "|" "\\|"
+ "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|"
+ ;; Comments, keyword-like or block-like constructs.
+ ;; Blocks and keywords with dual values need to be
+ ;; double-checked.
+ "#\\(?: \\|$\\|\\+\\(?:"
+ "BEGIN_\\S-+" "\\|"
+ "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)"
+ "\\|"
+ ;; Drawers (any type) and fixed-width areas. Drawers
+ ;; need to be double-checked.
+ ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|"
+ ;; Horizontal rules.
+ "-\\{5,\\}[ \t]*$" "\\|"
+ ;; LaTeX environments.
+ "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|"
+ ;; Clock lines.
+ (regexp-quote org-clock-string) "\\|"
+ ;; Lists.
+ (let ((term (case org-plain-list-ordered-item-terminator
+ (?\) ")") (?. "\\.") (otherwise "[.)]")))
+ (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)))
+ (list
+ ;; Sub/superscript.
+ "\\(?:[_^][-{(*+.,[:alnum:]]\\)"
+ ;; Bold, code, italic, strike-through, underline
+ ;; and verbatim.
+ (concat "[*~=+_/]"
+ (format "[^%s]"
+ (nth 2 org-emphasis-regexp-components)))
+ ;; Plain links.
+ (concat "\\<" link-types ":")
+ ;; Objects starting with "[": regular link,
+ ;; footnote reference, statistics cookie,
+ ;; timestamp (inactive).
+ "\\[\\(?:fn:\\|\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)\\|\\[\\)"
+ ;; Objects starting with "@": export snippets.
+ "@@"
+ ;; Objects starting with "{": macro.
+ "{{{"
+ ;; Objects starting with "<" : timestamp
+ ;; (active, diary), target, radio target and
+ ;; angular links.
+ (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)")
+ ;; Objects starting with "$": latex fragment.
+ "\\$"
+ ;; Objects starting with "\": line break,
+ ;; entity, latex fragment.
+ "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)"
+ ;; Objects starting with raw text: inline Babel
+ ;; source block, inline Babel call.
+ "\\(?:call\\|src\\)_"))
+ "\\|")))
+
+(org-element--set-regexps)
+
+;;;###autoload
+(defun org-element-update-syntax ()
+ "Update parser internals."
+ (interactive)
+ (org-element--set-regexps)
+ (org-element-cache-reset 'all))
+
(defconst org-element-all-elements
'(babel-call center-block clock comment comment-block diary-sexp drawer
dynamic-block example-block export-block fixed-width
footnote-definition headline horizontal-rule inlinetask item
keyword latex-environment node-property paragraph plain-list
- planning property-drawer quote-block quote-section section
+ planning property-drawer quote-block section
special-block src-block table table-row verse-block)
"Complete list of element types.")
@@ -186,23 +242,6 @@ is not sufficient to know if point is at a paragraph ending. See
special-block table)
"List of recursive element types aka Greater Elements.")
-(defconst org-element-all-successors
- '(link export-snippet footnote-reference inline-babel-call
- inline-src-block latex-or-entity line-break macro plain-link
- radio-target statistics-cookie sub/superscript table-cell target
- text-markup timestamp)
- "Complete list of successors.")
-
-(defconst org-element-object-successor-alist
- '((subscript . sub/superscript) (superscript . sub/superscript)
- (bold . text-markup) (code . text-markup) (italic . text-markup)
- (strike-through . text-markup) (underline . text-markup)
- (verbatim . text-markup) (entity . latex-or-entity)
- (latex-fragment . latex-or-entity))
- "Alist of translations between object type and successor name.
-Sharing the same successor comes handy when, for example, the
-regexp matching one object can also match the other object.")
-
(defconst org-element-all-objects
'(bold code entity export-snippet footnote-reference inline-babel-call
inline-src-block italic line-break latex-fragment link macro
@@ -211,10 +250,14 @@ regexp matching one object can also match the other object.")
"Complete list of object types.")
(defconst org-element-recursive-objects
- '(bold italic link subscript radio-target strike-through superscript
- table-cell underline)
+ '(bold footnote-reference italic link subscript radio-target strike-through
+ superscript table-cell underline)
"List of recursive object types.")
+(defconst org-element-object-containers
+ (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)
@@ -226,12 +269,6 @@ regexp matching one object can also match the other object.")
Names must be uppercase. Any block whose name has no association
is parsed with `org-element-special-block-parser'.")
-(defconst org-element-link-type-is-file
- '("file" "file+emacs" "file+sys" "docview")
- "List of link types equivalent to \"file\".
-Only these types can accept search options and an explicit
-application to open them.")
-
(defconst org-element-affiliated-keywords
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
"RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
@@ -268,6 +305,13 @@ strings and objects.
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
+(defconst org-element--parsed-properties-alist
+ (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k)))))
+ org-element-parsed-keywords)
+ "Alist of parsed keywords and associated properties.
+This is generated from `org-element-parsed-keywords', which
+see.")
+
(defconst org-element-dual-keywords '("CAPTION" "RESULTS")
"List of affiliated keywords which can have a secondary value.
@@ -280,13 +324,8 @@ associated to a hash value with the following:
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
-(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE")
- "List of properties associated to the whole document.
-Any keyword in this list will have its value parsed and stored as
-a secondary string.")
-
(defconst org-element--affiliated-re
- (format "[ \t]*#\\+\\(?:%s\\):\\(?: \\|$\\)"
+ (format "[ \t]*#\\+\\(?:%s\\):[ \t]*"
(concat
;; Dual affiliated keywords.
(format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?"
@@ -296,8 +335,7 @@ a secondary string.")
(format "\\(?1:%s\\)"
(regexp-opt
(org-remove-if
- #'(lambda (keyword)
- (member keyword org-element-dual-keywords))
+ (lambda (k) (member k org-element-dual-keywords))
org-element-affiliated-keywords)))
"\\|"
;; Export attributes.
@@ -311,8 +349,7 @@ match group 2.
Don't modify it, set `org-element-affiliated-keywords' instead.")
(defconst org-element-object-restrictions
- (let* ((standard-set
- (remq 'plain-link (remq 'table-cell org-element-all-successors)))
+ (let* ((standard-set (remq 'table-cell org-element-all-objects))
(standard-set-no-line-break (remq 'line-break standard-set)))
`((bold ,@standard-set)
(footnote-reference ,@standard-set)
@@ -320,30 +357,33 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(inlinetask ,@standard-set-no-line-break)
(italic ,@standard-set)
(item ,@standard-set-no-line-break)
- (keyword ,@standard-set)
+ (keyword ,@(remq 'footnote-reference standard-set))
;; Ignore all links excepted plain links in a link description.
;; Also ignore radio-targets and line breaks.
- (link export-snippet inline-babel-call inline-src-block latex-or-entity
- macro plain-link statistics-cookie sub/superscript text-markup)
+ (link bold code entity export-snippet inline-babel-call inline-src-block
+ italic latex-fragment macro plain-link statistics-cookie
+ strike-through subscript superscript underline verbatim)
(paragraph ,@standard-set)
;; Remove any variable object from radio target as it would
;; prevent it from being properly recognized.
- (radio-target latex-or-entity sub/superscript text-markup)
+ (radio-target bold code entity italic latex-fragment strike-through
+ subscript superscript underline superscript)
(strike-through ,@standard-set)
(subscript ,@standard-set)
(superscript ,@standard-set)
;; Ignore inline babel call and inline src block as formulas are
;; possible. Also ignore line breaks and statistics cookies.
- (table-cell link export-snippet footnote-reference latex-or-entity macro
- radio-target sub/superscript target text-markup timestamp)
+ (table-cell bold code entity export-snippet footnote-reference italic
+ latex-fragment link macro radio-target strike-through
+ subscript superscript target timestamp underline verbatim)
(table-row table-cell)
(underline ,@standard-set)
(verse-block ,@standard-set)))
"Alist of objects restrictions.
-CAR is an element or object type containing objects and CDR is
-a list of successors that will be called within an element or
-object of such type.
+key is an element or object type containing objects and value is
+a list of types that can be contained within an element or object
+of such type.
For example, in a `radio-target' object, one can only find
entities, latex-fragments, subscript, superscript and text
@@ -354,11 +394,19 @@ This alist also applies to secondary string. For example, an
still has an entry since one of its properties (`:title') does.")
(defconst org-element-secondary-value-alist
- '((headline . :title)
- (inlinetask . :title)
- (item . :tag)
- (footnote-reference . :inline-definition))
- "Alist between element types and location of secondary value.")
+ '((headline :title)
+ (inlinetask :title)
+ (item :tag))
+ "Alist between element types and locations of secondary values.")
+
+(defconst org-element--pair-square-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 square brackets.
+Other brackets are treated as spaces.")
@@ -368,10 +416,16 @@ still has an entry since one of its properties (`:title') does.")
;; `org-element-contents' and `org-element-restriction'.
;;
;; Setter functions allow to modify elements by side effect. There is
-;; `org-element-put-property', `org-element-set-contents',
-;; `org-element-set-element' and `org-element-adopt-element'. Note
-;; that `org-element-set-element' and `org-element-adopt-elements' are
-;; higher level functions since also update `:parent' property.
+;; `org-element-put-property', `org-element-set-contents'. These
+;; low-level functions are useful to build a parse tree.
+;;
+;; `org-element-adopt-element', `org-element-set-element',
+;; `org-element-extract-element' and `org-element-insert-before' are
+;; 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.
(defsubst org-element-type (element)
"Return type of ELEMENT.
@@ -411,29 +465,22 @@ Return modified element."
element))
(defsubst org-element-set-contents (element &rest contents)
- "Set ELEMENT contents to CONTENTS.
-Return modified element."
+ "Set ELEMENT contents to CONTENTS."
(cond ((not element) (list contents))
((not (symbolp (car element))) contents)
((cdr element) (setcdr (cdr element) contents))
(t (nconc element contents))))
-(defsubst org-element-set-element (old new)
- "Replace element or object OLD with element or object NEW.
-The function takes care of setting `:parent' property for NEW."
- ;; Since OLD is going to be changed into NEW by side-effect, first
- ;; make sure that every element or object within NEW has OLD as
- ;; parent.
- (mapc (lambda (blob) (org-element-put-property blob :parent old))
- (org-element-contents new))
- ;; Transfer contents.
- (apply 'org-element-set-contents old (org-element-contents new))
- ;; Ensure NEW has same parent as OLD, then overwrite OLD properties
- ;; with NEW's.
- (org-element-put-property new :parent (org-element-property :parent old))
- (setcar (cdr old) (nth 1 new))
- ;; Transfer type.
- (setcar old (car new)))
+(defun org-element-secondary-p (object)
+ "Non-nil when OBJECT directly belongs to a secondary string.
+Return value is the property name, as a keyword, or nil."
+ (let* ((parent (org-element-property :parent object))
+ (properties (cdr (assq (org-element-type parent)
+ org-element-secondary-value-alist))))
+ (catch 'exit
+ (dolist (p properties)
+ (and (memq object (org-element-property p parent))
+ (throw 'exit p))))))
(defsubst org-element-adopt-elements (parent &rest children)
"Append elements to the contents of another element.
@@ -443,18 +490,109 @@ objects, or a strings.
The function takes care of setting `:parent' property for CHILD.
Return parent element."
- ;; Link every child to PARENT. If PARENT is nil, it is a secondary
- ;; string: parent is the list itself.
- (mapc (lambda (child)
- (org-element-put-property child :parent (or parent children)))
- children)
- ;; Add CHILDREN at the end of PARENT contents.
- (when parent
- (apply 'org-element-set-contents
- parent
- (nconc (org-element-contents parent) children)))
- ;; Return modified PARENT element.
- (or parent children))
+ (if (not children) parent
+ ;; Link every child to PARENT. If PARENT is nil, it is a secondary
+ ;; string: parent is the list itself.
+ (dolist (child children)
+ (org-element-put-property child :parent (or parent children)))
+ ;; Add CHILDREN at the end of PARENT contents.
+ (when parent
+ (apply #'org-element-set-contents
+ parent
+ (nconc (org-element-contents parent) children)))
+ ;; Return modified PARENT element.
+ (or parent children)))
+
+(defun org-element-extract-element (element)
+ "Extract ELEMENT from parse tree.
+Remove element from the parse tree by side-effect, and return it
+with its `:parent' property stripped out."
+ (let ((parent (org-element-property :parent element))
+ (secondary (org-element-secondary-p element)))
+ (if secondary
+ (org-element-put-property
+ parent secondary
+ (delq element (org-element-property secondary parent)))
+ (apply #'org-element-set-contents
+ parent
+ (delq element (org-element-contents parent))))
+ ;; Return ELEMENT with its :parent removed.
+ (org-element-put-property element :parent nil)))
+
+(defun org-element-insert-before (element location)
+ "Insert ELEMENT before LOCATION in parse tree.
+LOCATION is an element, object or string within the parse tree.
+Parse tree is modified by side effect."
+ (let* ((parent (org-element-property :parent location))
+ (property (org-element-secondary-p location))
+ (siblings (if property (org-element-property property parent)
+ (org-element-contents parent)))
+ ;; Special case: LOCATION is the first element of an
+ ;; independent secondary string (e.g. :title property). Add
+ ;; ELEMENT in-place.
+ (specialp (and (not property)
+ (eq siblings parent)
+ (eq (car parent) location))))
+ ;; Install ELEMENT at the appropriate POSITION within SIBLINGS.
+ (cond (specialp)
+ ((or (null siblings) (eq (car siblings) location))
+ (push element siblings))
+ ((null location) (nconc siblings (list element)))
+ (t (let ((previous (cadr (memq location (reverse siblings)))))
+ (if (not previous)
+ (error "No location found to insert element")
+ (let ((next (memq previous siblings)))
+ (setcdr next (cons element (cdr next))))))))
+ ;; Store SIBLINGS at appropriate place in parse tree.
+ (cond
+ (specialp (setcdr parent (copy-sequence parent)) (setcar parent element))
+ (property (org-element-put-property parent property siblings))
+ (t (apply #'org-element-set-contents parent siblings)))
+ ;; Set appropriate :parent property.
+ (org-element-put-property element :parent parent)))
+
+(defun org-element-set-element (old new)
+ "Replace element or object OLD with element or object NEW.
+The function takes care of setting `:parent' property for NEW."
+ ;; Ensure OLD and NEW have the same parent.
+ (org-element-put-property new :parent (org-element-property :parent old))
+ (if (or (memq (org-element-type old) '(plain-text nil))
+ (memq (org-element-type new) '(plain-text nil)))
+ ;; We cannot replace OLD with NEW since one of them is not an
+ ;; object or element. We take the long path.
+ (progn (org-element-insert-before new old)
+ (org-element-extract-element old))
+ ;; Since OLD is going to be changed into NEW by side-effect, first
+ ;; make sure that every element or object within NEW has OLD as
+ ;; parent.
+ (dolist (blob (org-element-contents new))
+ (org-element-put-property blob :parent old))
+ ;; Transfer contents.
+ (apply #'org-element-set-contents old (org-element-contents new))
+ ;; Overwrite OLD's properties with NEW's.
+ (setcar (cdr old) (nth 1 new))
+ ;; Transfer type.
+ (setcar old (car new))))
+
+(defun org-element-create (type &optional props &rest children)
+ "Create a new element of type TYPE.
+Optional argument PROPS, when non-nil, is a plist defining the
+properties of the element. CHILDREN can be elements, objects or
+strings."
+ (apply #'org-element-adopt-elements (list type props) children))
+
+(defun org-element-copy (datum)
+ "Return a copy of DATUM.
+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
+ (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil)))))))
@@ -467,7 +605,7 @@ Return parent element."
;; Most of them accepts no argument. Though, exceptions exist. Hence
;; every element containing a secondary string (see
;; `org-element-secondary-value-alist') will accept an optional
-;; argument to toggle parsing of that secondary string. Moreover,
+;; argument to toggle parsing of these secondary strings. Moreover,
;; `item' parser requires current list's structure as its first
;; element.
;;
@@ -503,8 +641,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `center-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -520,7 +658,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -531,7 +668,6 @@ Assume point is at the beginning of the block."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -555,7 +691,7 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `drawer' and CDR is a plist containing
-`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
+`:drawer-name', `:begin', `:end', `:contents-begin',
`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of drawer."
@@ -574,7 +710,6 @@ Assume point is at beginning of drawer."
(and (< (point) drawer-end-line)
(point))))
(contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char drawer-end-line)
(forward-line)
(point)))
@@ -585,7 +720,6 @@ Assume point is at beginning of drawer."
(list :begin begin
:end end
:drawer-name name
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -611,9 +745,9 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `dynamic-block' and CDR is a plist
-containing `:block-name', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:arguments', `:post-blank'
-and `:post-affiliated' keywords.
+containing `:block-name', `:begin', `:end', `:contents-begin',
+`:contents-end', `:arguments', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at beginning of dynamic block."
(let ((case-fold-search t))
@@ -633,7 +767,6 @@ Assume point is at beginning of dynamic block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -645,7 +778,6 @@ Assume point is at beginning of dynamic block."
:end end
:block-name name
:arguments arguments
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -722,16 +854,52 @@ CONTENTS is the contents of the footnote-definition."
;;;; Headline
+(defun org-element--get-node-properties ()
+ "Return node properties associated to headline at point.
+Upcase property names. It avoids confusion between properties
+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 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 (intern (concat ":" (upcase (match-string 2)))) properties)
+ (forward-line))
+ properties))))
+
+(defun org-element--get-time-properties ()
+ "Return time properties associated to headline at point.
+Return value is a plist."
+ (save-excursion
+ (when (progn (forward-line) (looking-at org-planning-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
+
(defun org-element-headline-parser (limit &optional raw-secondary-p)
"Parse a headline.
Return a list whose CAR is `headline' and CDR is a plist
-containing `:raw-value', `:title', `:alt-title', `:begin',
-`:end', `:pre-blank', `:hiddenp', `:contents-begin',
-`:contents-end', `:level', `:priority', `:tags',
-`:todo-keyword',`:todo-type', `:scheduled', `:deadline',
-`:closed', `:quotedp', `:archivedp', `:commentedp',
-`:footnote-section-p' and `:post-blank' keywords.
+containing `:raw-value', `:title', `:begin', `:end',
+`:pre-blank', `:contents-begin' and `:contents-end', `:level',
+`:priority', `:tags', `:todo-keyword',`:todo-type', `:scheduled',
+`:deadline', `:closed', `:archivedp', `:commentedp'
+`:footnote-section-p', `:post-blank' and `:post-affiliated'
+keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
@@ -744,80 +912,47 @@ parsed as a secondary string, but as a plain string instead.
Assume point is at beginning of the headline."
(save-excursion
- (let* ((components (org-heading-components))
- (level (nth 1 components))
- (todo (nth 2 components))
+ (let* ((begin (point))
+ (level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t")))
+ (todo (and org-todo-regexp
+ (let (case-fold-search) (looking-at org-todo-regexp))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 0))))
(todo-type
(and todo (if (member todo org-done-keywords) 'done 'todo)))
- (tags (let ((raw-tags (nth 5 components)))
- (and raw-tags (org-split-string raw-tags ":"))))
- (raw-value (or (nth 4 components) ""))
- (quotedp
- (let ((case-fold-search nil))
- (string-match (format "^%s\\( \\|$\\)" org-quote-string)
- raw-value)))
+ (priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2))))
(commentedp
- (let ((case-fold-search nil))
- (string-match (format "^%s\\( \\|$\\)" org-comment-string)
- raw-value)))
+ (and (let (case-fold-search) (looking-at org-comment-string))
+ (goto-char (match-end 0))))
+ (title-start (point))
+ (tags (when (re-search-forward
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":")))
+ (title-end (point))
+ (raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end)))
(archivedp (member org-archive-tag tags))
(footnote-section-p (and org-footnote-section
(string= org-footnote-section raw-value)))
- ;; Upcase property names. It avoids confusion between
- ;; properties obtained through property drawer and default
- ;; properties from the parser (e.g. `:end' and :END:)
- (standard-props
- (let (plist)
- (mapc
- (lambda (p)
- (setq plist
- (plist-put plist
- (intern (concat ":" (upcase (car p))))
- (cdr p))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props
- ;; Read time properties on the line below the headline.
- (save-excursion
- (when (progn (forward-line)
- (looking-at org-planning-or-clock-line-re))
- (let ((end (line-end-position)) plist)
- (while (re-search-forward
- org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
- (skip-chars-forward " \t")
- (let ((keyword (match-string 1))
- (time (org-element-timestamp-parser)))
- (cond ((equal keyword org-scheduled-string)
- (setq plist (plist-put plist :scheduled time)))
- ((equal keyword org-deadline-string)
- (setq plist (plist-put plist :deadline time)))
- (t (setq plist (plist-put plist :closed time))))))
- plist))))
- (begin (point))
+ (standard-props (org-element--get-node-properties))
+ (time-props (org-element--get-time-properties))
(end (min (save-excursion (org-end-of-subtree t t)) limit))
(pos-after-head (progn (forward-line) (point)))
(contents-begin (save-excursion
(skip-chars-forward " \r\t\n" end)
(and (/= (point) end) (line-beginning-position))))
- (hidden (org-invisible-p2))
(contents-end (and contents-begin
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
(forward-line)
(point)))))
- ;; Clean RAW-VALUE from any quote or comment string.
- (when (or quotedp commentedp)
- (let ((case-fold-search nil))
- (setq raw-value
- (replace-regexp-in-string
- (concat
- (regexp-opt (list org-quote-string org-comment-string))
- "\\(?: \\|$\\)")
- ""
- raw-value))))
- ;; Clean TAGS from archive tag, if any.
- (when archivedp (setq tags (delete org-archive-tag tags)))
(let ((headline
(list 'headline
(nconc
@@ -827,11 +962,10 @@ Assume point is at beginning of the headline."
:pre-blank
(if (not contents-begin) 0
(count-lines pos-after-head contents-begin))
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:level level
- :priority (nth 3 components)
+ :priority priority
:tags tags
:todo-keyword todo
:todo-type todo-type
@@ -841,21 +975,23 @@ Assume point is at beginning of the headline."
:footnote-section-p footnote-section-p
:archivedp archivedp
:commentedp commentedp
- :quotedp quotedp)
+ :post-affiliated begin)
time-props
standard-props))))
- (let ((alt-title (org-element-property :ALT_TITLE headline)))
- (when alt-title
- (org-element-put-property
- headline :alt-title
- (if raw-secondary-p alt-title
- (org-element-parse-secondary-string
- alt-title (org-element-restriction 'headline) headline)))))
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
- (org-element-parse-secondary-string
- raw-value (org-element-restriction 'headline) headline)))))))
+ (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)))))))))
(defun org-element-headline-interpreter (headline contents)
"Interpret HEADLINE element as Org syntax.
@@ -865,22 +1001,17 @@ CONTENTS is the contents of the element."
(priority (org-element-property :priority headline))
(title (org-element-interpret-data
(org-element-property :title headline)))
- (tags (let ((tag-list (if (org-element-property :archivedp headline)
- (cons org-archive-tag
- (org-element-property :tags headline))
- (org-element-property :tags headline))))
+ (tags (let ((tag-list (org-element-property :tags headline)))
(and tag-list
(format ":%s:" (mapconcat #'identity tag-list ":")))))
(commentedp (org-element-property :commentedp headline))
- (quotedp (org-element-property :quotedp headline))
(pre-blank (or (org-element-property :pre-blank headline) 0))
(heading
(concat (make-string (if org-odd-levels-only (1- (* level 2)) level)
?*)
(and todo (concat " " todo))
- (and quotedp (concat " " org-quote-string))
(and commentedp (concat " " org-comment-string))
- (and priority (format " [#%s]" (char-to-string priority)))
+ (and priority (format " [#%c]" priority))
" "
(if (and org-footnote-section
(org-element-property :footnote-section-p headline))
@@ -912,10 +1043,10 @@ CONTENTS is the contents of the element."
"Parse an inline task.
Return a list whose CAR is `inlinetask' and CDR is a plist
-containing `:title', `:begin', `:end', `:hiddenp',
-`:contents-begin' and `:contents-end', `:level', `:priority',
-`:raw-value', `:tags', `:todo-keyword', `:todo-type',
-`:scheduled', `:deadline', `:closed' and `:post-blank' keywords.
+containing `:title', `:begin', `:end', `:contents-begin' and
+`:contents-end', `:level', `:priority', `:raw-value', `:tags',
+`:todo-keyword', `:todo-type', `:scheduled', `:deadline',
+`:closed', `:post-blank' and `:post-affiliated' keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
@@ -928,53 +1059,37 @@ string instead.
Assume point is at beginning of the inline task."
(save-excursion
(let* ((begin (point))
- (components (org-heading-components))
- (todo (nth 2 components))
+ (level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t")))
+ (todo (and org-todo-regexp
+ (let (case-fold-search) (looking-at org-todo-regexp))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 0))))
(todo-type (and todo
(if (member todo org-done-keywords) 'done 'todo)))
- (tags (let ((raw-tags (nth 5 components)))
- (and raw-tags (org-split-string raw-tags ":"))))
- (raw-value (or (nth 4 components) ""))
- ;; Upcase property names. It avoids confusion between
- ;; properties obtained through property drawer and default
- ;; properties from the parser (e.g. `:end' and :END:)
- (standard-props
- (let (plist)
- (mapc
- (lambda (p)
- (setq plist
- (plist-put plist
- (intern (concat ":" (upcase (car p))))
- (cdr p))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props
- ;; Read time properties on the line below the inlinetask
- ;; opening string.
- (save-excursion
- (when (progn (forward-line)
- (looking-at org-planning-or-clock-line-re))
- (let ((end (line-end-position)) plist)
- (while (re-search-forward
- org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
- (skip-chars-forward " \t")
- (let ((keyword (match-string 1))
- (time (org-element-timestamp-parser)))
- (cond ((equal keyword org-scheduled-string)
- (setq plist (plist-put plist :scheduled time)))
- ((equal keyword org-deadline-string)
- (setq plist (plist-put plist :deadline time)))
- (t (setq plist (plist-put plist :closed time))))))
- plist))))
+ (priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2))))
+ (title-start (point))
+ (tags (when (re-search-forward
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":")))
+ (title-end (point))
+ (raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end)))
(task-end (save-excursion
(end-of-line)
(and (re-search-forward org-outline-regexp-bol limit t)
(org-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)))
(contents-begin (progn (forward-line)
(and task-end (< (point) task-end) (point))))
- (hidden (and contents-begin (org-invisible-p2)))
(contents-end (and contents-begin task-end))
(before-blank (if (not task-end) (point)
(goto-char task-end)
@@ -988,24 +1103,31 @@ Assume point is at beginning of the inline task."
(list :raw-value raw-value
:begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :level (nth 1 components)
- :priority (nth 3 components)
+ :level level
+ :priority priority
:tags tags
:todo-keyword todo
:todo-type todo-type
- :post-blank (count-lines before-blank end))
+ :post-blank (count-lines before-blank end)
+ :post-affiliated begin)
time-props
standard-props))))
(org-element-put-property
inlinetask :title
(if raw-secondary-p raw-value
- (org-element-parse-secondary-string
- raw-value
- (org-element-restriction 'inlinetask)
- inlinetask))))))
+ (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))))))))
(defun org-element-inlinetask-interpreter (inlinetask contents)
"Interpret INLINETASK element as Org syntax.
@@ -1020,8 +1142,7 @@ CONTENTS is the contents of inlinetask."
(format ":%s:" (mapconcat 'identity tag-list ":")))))
(task (concat (make-string level ?*)
(and todo (concat " " todo))
- (and priority
- (format " [#%s]" (char-to-string priority)))
+ (and priority (format " [#%c]" priority))
(and title (concat " " title)))))
(concat task
;; Align tags.
@@ -1055,8 +1176,8 @@ STRUCT is the structure of the plain list.
Return a list whose CAR is `item' and CDR is a plist containing
`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
-`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
-`:post-blank' keywords.
+`:checkbox', `:counter', `:tag', `:structure', `:post-blank' and
+`:post-affiliated' keywords.
When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
any, will not be parsed as a secondary string, but as a plain
@@ -1068,11 +1189,11 @@ Assume point is at the beginning of the item."
(looking-at org-list-full-item-re)
(let* ((begin (point))
(bullet (org-match-string-no-properties 1))
- (checkbox (let ((box (org-match-string-no-properties 3)))
+ (checkbox (let ((box (match-string 3)))
(cond ((equal "[ ]" box) 'off)
((equal "[X]" box) 'on)
((equal "[-]" box) 'trans))))
- (counter (let ((c (org-match-string-no-properties 2)))
+ (counter (let ((c (match-string 2)))
(save-match-data
(cond
((not c) nil)
@@ -1081,9 +1202,8 @@ Assume point is at the beginning of the item."
64))
((string-match "[0-9]+" c)
(string-to-number (match-string 0 c)))))))
- (end (save-excursion (goto-char (org-list-get-item-end begin struct))
- (unless (bolp) (forward-line))
- (point)))
+ (end (progn (goto-char (nth 6 (assq (point) struct)))
+ (if (bolp) (point) (line-beginning-position 2))))
(contents-begin
(progn (goto-char
;; Ignore tags in un-ordered lists: they are just
@@ -1092,40 +1212,38 @@ Assume point is at the beginning of the item."
(save-match-data (string-match "[.)]" bullet)))
(match-beginning 4)
(match-end 0)))
- (skip-chars-forward " \r\t\n" limit)
- ;; If first line isn't empty, contents really start
- ;; at the text after item's meta-data.
- (if (= (point-at-bol) begin) (point) (point-at-bol))))
- (hidden (progn (forward-line)
- (and (not (= (point) end)) (org-invisible-p2))))
- (contents-end (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ;; If first line isn't empty, contents really
+ ;; start at the text after item's meta-data.
+ ((= (line-beginning-position) begin) (point))
+ (t (line-beginning-position)))))
+ (contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
(item
(list 'item
(list :bullet bullet
:begin begin
:end end
- ;; CONTENTS-BEGIN and CONTENTS-END may be
- ;; mixed up in the case of an empty item
- ;; separated from the next by a blank line.
- ;; Thus ensure the former is always the
- ;; smallest.
- :contents-begin (min contents-begin contents-end)
- :contents-end (max contents-begin contents-end)
+ :contents-begin contents-begin
+ :contents-end contents-end
:checkbox checkbox
:counter counter
- :hiddenp hidden
:structure struct
- :post-blank (count-lines contents-end end)))))
+ :post-blank (count-lines (or contents-end begin) end)
+ :post-affiliated begin))))
(org-element-put-property
item :tag
- (let ((raw-tag (org-list-get-tag begin struct)))
- (and raw-tag
- (if raw-secondary-p raw-tag
- (org-element-parse-secondary-string
- raw-tag (org-element-restriction 'item) 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))))))))))
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
@@ -1168,9 +1286,6 @@ CONTENTS is the contents of the element."
(let ((case-fold-search t)
(top-ind limit)
(item-re (org-item-re))
- (drawers-re (concat ":\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
items struct)
(save-excursion
@@ -1226,7 +1341,8 @@ CONTENTS is the contents of the element."
(goto-char origin)))))
;; At some text line. Check if it ends any previous item.
(t
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (let ((ind (save-excursion (skip-chars-forward " \t")
+ (current-column))))
(when (<= ind top-ind)
(skip-chars-backward " \r\t\n")
(forward-line))
@@ -1235,15 +1351,14 @@ CONTENTS is the contents of the element."
(setcar (nthcdr 6 item) (line-beginning-position))
(push item struct)
(unless items
- (throw 'exit (sort struct 'car-less-than-car))))))
+ (throw 'exit (sort struct #'car-less-than-car))))))
;; Skip blocks (any type) and drawers contents.
(cond
- ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
+ ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)")
(re-search-forward
- (format "^[ \t]*#\\+END%s[ \t]*$"
- (org-match-string-no-properties 1))
+ (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
limit t)))
- ((and (looking-at drawers-re)
+ ((and (looking-at org-drawer-regexp)
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
(forward-line))))))))
@@ -1264,15 +1379,20 @@ 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)))
- (prevs (org-list-prevs-alist struct))
- (type (org-list-get-list-type (point) struct prevs))
+ (type (cond ((org-looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
+ ((nth 5 (assq (point) struct)) 'descriptive)
+ (t 'unordered)))
(contents-begin (point))
(begin (car affiliated))
- (contents-end
- (progn (goto-char (org-list-get-list-end (point) struct prevs))
- (unless (bolp) (forward-line))
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
+ (contents-end (let* ((item (assq contents-begin struct))
+ (ind (nth 1 item))
+ (pos (nth 6 item)))
+ (while (and (setq item (assq pos struct))
+ (= (nth 1 item) ind))
+ (setq pos (nth 6 item)))
+ pos))
+ (end (progn (goto-char contents-end)
+ (skip-chars-forward " \r\t\n" limit)
(if (= (point) limit) limit (line-beginning-position)))))
;; Return value.
(list 'plain-list
@@ -1299,49 +1419,33 @@ CONTENTS is the contents of the element."
;;;; Property Drawer
-(defun org-element-property-drawer-parser (limit affiliated)
+(defun org-element-property-drawer-parser (limit)
"Parse a property drawer.
-LIMIT bounds the search. AFFILIATED is a list of which CAR is
-the buffer position at the beginning of the first affiliated
-keyword and CDR is a plist of affiliated keywords along with
-their value.
+LIMIT bounds the search.
-Return a list whose CAR is `property-drawer' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+Return a list whose car is `property-drawer' and cdr is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the property drawer."
- (let ((case-fold-search t))
- (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
- ;; Incomplete drawer: parse it as a paragraph.
- (org-element-paragraph-parser limit affiliated)
- (save-excursion
- (let* ((drawer-end-line (match-beginning 0))
- (begin (car affiliated))
- (post-affiliated (point))
- (contents-begin
- (progn
- (forward-line)
- (and (re-search-forward org-property-re drawer-end-line t)
- (line-beginning-position))))
- (contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
- (pos-before-blank (progn (goto-char drawer-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'property-drawer
- (nconc
- (list :begin begin
- :end end
- :hiddenp hidden
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (save-excursion
+ (let ((case-fold-search t)
+ (begin (point))
+ (contents-begin (line-beginning-position 2)))
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)
+ (let ((contents-end (and (> (match-beginning 0) contents-begin)
+ (match-beginning 0)))
+ (before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'property-drawer
+ (list :begin begin
+ :end end
+ :contents-begin (and contents-end contents-begin)
+ :contents-end contents-end
+ :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.
@@ -1360,8 +1464,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `quote-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -1378,7 +1482,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -1388,7 +1491,6 @@ Assume point is at the beginning of the block."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -1409,8 +1511,8 @@ CONTENTS is the contents of the element."
LIMIT bounds the search.
Return a list whose CAR is `section' and CDR is a plist
-containing `:begin', `:end', `:contents-begin', `contents-end'
-and `:post-blank' keywords."
+containing `:begin', `:end', `:contents-begin', `contents-end',
+`:post-blank' and `:post-affiliated' keywords."
(save-excursion
;; Beginning of section is the beginning of the first non-blank
;; line after previous headline.
@@ -1425,7 +1527,8 @@ and `:post-blank' keywords."
:end end
:contents-begin begin
:contents-end pos-before-blank
- :post-blank (count-lines pos-before-blank 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.
@@ -1444,14 +1547,13 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `special-block' and CDR is a plist
-containing `:type', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:post-blank' and
-`:post-affiliated' keywords.
+containing `:type', `:begin', `:end', `:contents-begin',
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
(type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (upcase (match-string-no-properties 1)))))
+ (match-string-no-properties 1))))
(if (not (save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
@@ -1467,7 +1569,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -1478,7 +1579,6 @@ Assume point is at the beginning of the block."
(list :type type
:begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -1512,28 +1612,41 @@ CONTENTS is the contents of the element."
(defun org-element-babel-call-parser (limit affiliated)
"Parse a babel call.
-LIMIT bounds the search. AFFILIATED is a list of which CAR is
+LIMIT bounds the search. AFFILIATED is a list of which car is
the buffer position at the beginning of the first affiliated
-keyword and CDR is a plist of affiliated keywords along with
+keyword and cdr is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `babel-call' and CDR is a plist
-containing `:begin', `:end', `:info', `:post-blank' and
+Return a list whose car is `babel-call' and cdr is a plist
+containing `:call', `:inside-header', `:arguments',
+`:end-header', `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' as keywords."
(save-excursion
- (let ((case-fold-search t)
- (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
- (org-babel-lob-get-info)))
- (begin (car affiliated))
- (post-affiliated (point))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
+ (value (progn (search-forward ":" nil t)
+ (org-trim
+ (buffer-substring-no-properties
+ (point) (line-end-position)))))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position))))
+ (valid-value
+ (string-match
+ "\\([^()\n]+?\\)\\(?:\\[\\(.*?\\)\\]\\)?(\\(.*\\))[ \t]*\\(.*\\)"
+ value)))
(list 'babel-call
(nconc
- (list :begin begin
+ (list :call (and valid-value (match-string 1 value))
+ :inside-header (and valid-value
+ (org-string-nw-p (match-string 2 value)))
+ :arguments (and valid-value
+ (org-string-nw-p (match-string 3 value)))
+ :end-header (and valid-value
+ (org-string-nw-p (match-string 4 value)))
+ :begin begin
:end end
- :info info
+ :value value
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated))))))
@@ -1541,14 +1654,13 @@ containing `:begin', `:end', `:info', `:post-blank' and
(defun org-element-babel-call-interpreter (babel-call contents)
"Interpret BABEL-CALL element as Org syntax.
CONTENTS is nil."
- (let* ((babel-info (org-element-property :info babel-call))
- (main (car babel-info))
- (post-options (nth 1 babel-info)))
- (concat "#+CALL: "
- (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
- ;; Remove redundant square brackets.
- (replace-match (match-string 1 main) nil nil main))
- (and post-options (format "[%s]" post-options)))))
+ (concat "#+CALL: "
+ (org-element-property :call babel-call)
+ (let ((h (org-element-property :inside-header babel-call)))
+ (and h (format "[%s]" h)))
+ (concat "(" (org-element-property :arguments babel-call) ")")
+ (let ((h (org-element-property :end-header babel-call)))
+ (and h (concat " " h)))))
;;;; Clock
@@ -1559,8 +1671,8 @@ CONTENTS is nil."
LIMIT bounds the search.
Return a list whose CAR is `clock' and CDR is a plist containing
-`:status', `:value', `:time', `:begin', `:end' and `:post-blank'
-as keywords."
+`:status', `:value', `:time', `:begin', `:end', `:post-blank' and
+`:post-affiliated' as keywords."
(save-excursion
(let* ((case-fold-search nil)
(begin (point))
@@ -1584,7 +1696,8 @@ as keywords."
:duration duration
:begin begin
:end end
- :post-blank post-blank)))))
+ :post-blank post-blank
+ :post-affiliated begin)))))
(defun org-element-clock-interpreter (clock contents)
"Interpret CLOCK element as Org syntax.
@@ -1664,8 +1777,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `comment-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:value', `:post-blank'
-and `:post-affiliated' keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at comment block beginning."
(let ((case-fold-search t))
@@ -1678,7 +1791,6 @@ Assume point is at comment block beginning."
(let* ((begin (car affiliated))
(post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1691,7 +1803,6 @@ Assume point is at comment block beginning."
(list :begin begin
:end end
:value value
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -1700,7 +1811,9 @@ Assume point is at comment block beginning."
"Interpret COMMENT-BLOCK element as Org syntax.
CONTENTS is nil."
(format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
- (org-remove-indentation (org-element-property :value comment-block))))
+ (org-element-normalize-string
+ (org-remove-indentation
+ (org-element-property :value comment-block)))))
;;;; Diary Sexp
@@ -1741,35 +1854,6 @@ CONTENTS is nil."
;;;; Example Block
-(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)))))
-
(defun org-element-example-block-parser (limit affiliated)
"Parse an example block.
@@ -1780,9 +1864,8 @@ their value.
Return a list whose CAR is `example-block' and CDR is a plist
containing `:begin', `:end', `:number-lines', `:preserve-indent',
-`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
-`:switches', `:value', `:post-blank' and `:post-affiliated'
-keywords."
+`:retain-labels', `:use-labels', `:label-fmt', `:switches',
+`:value', `:post-blank' and `:post-affiliated' keywords."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
@@ -1800,8 +1883,7 @@ keywords."
((string-match "-n\\>" switches) 'new)
((string-match "+n\\>" switches) 'continued)))
(preserve-indent
- (or org-src-preserve-indentation
- (and switches (string-match "-i\\>" switches))))
+ (and switches (string-match "-i\\>" switches)))
;; Should labels be retained in (or stripped from) example
;; blocks?
(retain-labels
@@ -1823,12 +1905,11 @@ keywords."
(post-affiliated (point))
(block-ind (progn (skip-chars-forward " \t") (current-column)))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
- (value (org-element--remove-indentation
+ (value (org-element-remove-indentation
(org-unescape-code-in-string
(buffer-substring-no-properties
contents-begin contents-end))
- (and preserve-indent block-ind)))
+ block-ind))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1845,7 +1926,6 @@ keywords."
:retain-labels retain-labels
:use-labels use-labels
:label-fmt label-fmt
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -1853,10 +1933,15 @@ keywords."
(defun org-element-example-block-interpreter (example-block contents)
"Interpret EXAMPLE-BLOCK element as Org syntax.
CONTENTS is nil."
- (let ((switches (org-element-property :switches example-block)))
+ (let ((switches (org-element-property :switches example-block))
+ (value (org-element-property :value example-block)))
(concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
- (org-escape-code-in-string
- (org-element-property :value example-block))
+ (org-element-normalize-string
+ (org-escape-code-in-string
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent example-block))
+ value
+ (org-element-remove-indentation value))))
"#+END_EXAMPLE")))
@@ -1871,8 +1956,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `export-block' and CDR is a plist
-containing `:begin', `:end', `:type', `:hiddenp', `:value',
-`:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:type', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at export-block beginning."
(let* ((case-fold-search t)
@@ -1888,7 +1973,6 @@ Assume point is at export-block beginning."
(let* ((begin (car affiliated))
(post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1902,7 +1986,6 @@ Assume point is at export-block beginning."
:end end
:type type
:value value
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -2015,7 +2098,10 @@ Return a list whose CAR is `keyword' and CDR is a plist
containing `:key', `:value', `:begin', `:end', `:post-blank' and
`:post-affiliated' keywords."
(save-excursion
- (let ((begin (car affiliated))
+ ;; An orphaned affiliated keyword is considered as a regular
+ ;; keyword. In this case AFFILIATED is nil, so we take care of
+ ;; this corner case.
+ (let ((begin (or (car affiliated) (point)))
(post-affiliated (point))
(key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
(upcase (org-match-string-no-properties 1))))
@@ -2044,6 +2130,18 @@ CONTENTS is nil."
;;;; Latex Environment
+(defconst org-element--latex-begin-environment
+ "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}"
+ "Regexp matching the beginning of a LaTeX environment.
+The environment is captured by the first group.
+
+See also `org-element--latex-end-environment'.")
+
+(defconst org-element--latex-end-environment
+ "\\\\end{%s}[ \t]*$"
+ "Format string matching the ending of a LaTeX environment.
+See also `org-element--latex-begin-environment'.")
+
(defun org-element-latex-environment-parser (limit affiliated)
"Parse a LaTeX environment.
@@ -2060,8 +2158,8 @@ Assume point is at the beginning of the latex environment."
(save-excursion
(let ((case-fold-search t)
(code-begin (point)))
- (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
- (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$"
+ (looking-at org-element--latex-begin-environment)
+ (if (not (re-search-forward (format org-element--latex-end-environment
(regexp-quote (match-string 1)))
limit t))
;; Incomplete latex environment: parse it as a paragraph.
@@ -2094,10 +2192,11 @@ CONTENTS is nil."
LIMIT bounds the search.
Return a list whose CAR is `node-property' and CDR is a plist
-containing `:key', `:value', `:begin', `:end' and `:post-blank'
-keywords."
+containing `:key', `:value', `:begin', `:end', `:post-blank' and
+`:post-affiliated' keywords."
(looking-at org-property-re)
- (let ((begin (point))
+ (let ((case-fold-search t)
+ (begin (point))
(key (org-match-string-no-properties 2))
(value (org-match-string-no-properties 3))
(end (save-excursion
@@ -2110,7 +2209,8 @@ keywords."
:value value
:begin begin
:end end
- :post-blank 0))))
+ :post-blank 0
+ :post-affiliated begin))))
(defun org-element-node-property-interpreter (node-property contents)
"Interpret NODE-PROPERTY element as Org syntax.
@@ -2141,66 +2241,42 @@ Assume point is at the beginning of the paragraph."
(before-blank
(let ((case-fold-search t))
(end-of-line)
- (if (not (re-search-forward
- org-element-paragraph-separate limit 'm))
- limit
- ;; A matching `org-element-paragraph-separate' is not
- ;; necessarily the end of the paragraph. In
- ;; particular, lines starting with # or : as a first
- ;; non-space character are ambiguous. We have to
- ;; check if they are valid Org syntax (e.g., not an
- ;; incomplete keyword).
- (beginning-of-line)
- (while (not
- (or
- ;; There's no ambiguity for other symbols or
- ;; empty lines: stop here.
- (looking-at "[ \t]*\\(?:[^:#]\\|$\\)")
- ;; Stop at valid fixed-width areas.
- (looking-at "[ \t]*:\\(?: \\|$\\)")
- ;; Stop at drawers.
- (and (looking-at org-drawer-regexp)
- (save-excursion
- (re-search-forward
- "^[ \t]*:END:[ \t]*$" limit t)))
- ;; Stop at valid comments.
- (looking-at "[ \t]*#\\(?: \\|$\\)")
- ;; Stop at valid dynamic blocks.
- (and (looking-at org-dblock-start-re)
- (save-excursion
- (re-search-forward
- "^[ \t]*#\\+END:?[ \t]*$" limit t)))
- ;; Stop at valid blocks.
- (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$"
- (regexp-quote
- (org-match-string-no-properties 1)))
- limit t)))
- ;; Stop at valid latex environments.
- (and (looking-at
- "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
- (save-excursion
- (re-search-forward
- (format "^[ \t]*\\\\end{%s}[ \t]*$"
- (regexp-quote
- (org-match-string-no-properties 1)))
- limit t)))
- ;; Stop at valid keywords.
- (looking-at "[ \t]*#\\+\\S-+:")
- ;; Skip everything else.
- (not
- (progn
- (end-of-line)
- (re-search-forward org-element-paragraph-separate
- limit 'm)))))
- (beginning-of-line)))
+ ;; A matching `org-element-paragraph-separate' is not
+ ;; necessarily the end of the paragraph. In particular,
+ ;; drawers, blocks or LaTeX environments opening lines
+ ;; must be closed. Moreover keywords with a secondary
+ ;; value must belong to "dual keywords".
+ (while (not
+ (cond
+ ((not (and (re-search-forward
+ org-element-paragraph-separate limit 'move)
+ (progn (beginning-of-line) t))))
+ ((looking-at org-drawer-regexp)
+ (save-excursion
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
+ ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (save-excursion
+ (re-search-forward
+ (format "^[ \t]*#\\+END_%s[ \t]*$"
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at org-element--latex-begin-environment)
+ (save-excursion
+ (re-search-forward
+ (format org-element--latex-end-environment
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:")
+ (member-ignore-case (match-string 1)
+ org-element-dual-keywords))
+ ;; Everything else is unambiguous.
+ (t)))
+ (end-of-line))
(if (= (point) limit) limit
(goto-char (line-beginning-position)))))
- (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin)
- (forward-line)
- (point)))
+ (contents-end (save-excursion
+ (skip-chars-backward " \r\t\n" contents-begin)
+ (line-beginning-position 2)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
(list 'paragraph
@@ -2227,8 +2303,8 @@ CONTENTS is the contents of the element."
LIMIT bounds the search.
Return a list whose CAR is `planning' and CDR is a plist
-containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
-and `:post-blank' keywords."
+containing `:closed', `:deadline', `:scheduled', `:begin',
+`:end', `:post-blank' and `:post-affiliated' keywords."
(save-excursion
(let* ((case-fold-search nil)
(begin (point))
@@ -2254,7 +2330,8 @@ and `:post-blank' keywords."
:scheduled scheduled
:begin begin
:end end
- :post-blank post-blank)))))
+ :post-blank post-blank
+ :post-affiliated begin)))))
(defun org-element-planning-interpreter (planning contents)
"Interpret PLANNING element as Org syntax.
@@ -2277,37 +2354,6 @@ CONTENTS is nil."
" "))
-;;;; Quote Section
-
-(defun org-element-quote-section-parser (limit)
- "Parse a quote section.
-
-LIMIT bounds the search.
-
-Return a list whose CAR is `quote-section' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank' keywords.
-
-Assume point is at beginning of the section."
- (save-excursion
- (let* ((begin (point))
- (end (progn (org-with-limited-levels (outline-next-heading))
- (point)))
- (pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))
- (value (buffer-substring-no-properties begin pos-before-blank)))
- (list 'quote-section
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end))))))
-
-(defun org-element-quote-section-interpreter (quote-section contents)
- "Interpret QUOTE-SECTION element as Org syntax.
-CONTENTS is nil."
- (org-element-property :value quote-section))
-
-
;;;; Src Block
(defun org-element-src-block-parser (limit affiliated)
@@ -2320,9 +2366,9 @@ their value.
Return a list whose CAR is `src-block' and CDR is a plist
containing `:language', `:switches', `:parameters', `:begin',
-`:end', `:hiddenp', `:number-lines', `:retain-labels',
-`:use-labels', `:label-fmt', `:preserve-indent', `:value',
-`:post-blank' and `:post-affiliated' keywords.
+`:end', `:number-lines', `:retain-labels', `:use-labels',
+`:label-fmt', `:preserve-indent', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -2352,9 +2398,8 @@ Assume point is at the beginning of the block."
(cond ((not switches) nil)
((string-match "-n\\>" switches) 'new)
((string-match "+n\\>" switches) 'continued)))
- (preserve-indent (or org-src-preserve-indentation
- (and switches
- (string-match "-i\\>" switches))))
+ (preserve-indent (and switches
+ (string-match "-i\\>" switches)))
(label-fmt
(and switches
(string-match "-l +\"\\([^\"\n]+\\)\"" switches)
@@ -2373,14 +2418,12 @@ Assume point is at the beginning of the block."
(not (string-match "-k\\>" switches)))))
;; Indentation.
(block-ind (progn (skip-chars-forward " \t") (current-column)))
- ;; Get visibility status.
- (hidden (progn (forward-line) (org-invisible-p2)))
;; Retrieve code.
- (value (org-element--remove-indentation
+ (value (org-element-remove-indentation
(org-unescape-code-in-string
(buffer-substring-no-properties
- (point) contents-end))
- (and preserve-indent block-ind)))
+ (progn (forward-line) (point)) contents-end))
+ block-ind))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -2401,7 +2444,6 @@ Assume point is at the beginning of the block."
:retain-labels retain-labels
:use-labels use-labels
:label-fmt label-fmt
- :hiddenp hidden
:value value
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
@@ -2413,20 +2455,22 @@ CONTENTS is nil."
(let ((lang (org-element-property :language src-block))
(switches (org-element-property :switches src-block))
(params (org-element-property :parameters src-block))
- (value (let ((val (org-element-property :value src-block)))
- (cond
- ((org-element-property :preserve-indent src-block) val)
- ((zerop org-edit-src-content-indentation) val)
- (t
- (let ((ind (make-string
- org-edit-src-content-indentation 32)))
- (replace-regexp-in-string
- "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
+ (value
+ (let ((val (org-element-property :value src-block)))
+ (cond
+ ((or org-src-preserve-indentation
+ (org-element-property :preserve-indent src-block))
+ val)
+ ((zerop org-edit-src-content-indentation) val)
+ (t
+ (let ((ind (make-string org-edit-src-content-indentation ?\s)))
+ (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
(and params (concat " " params))))
- (org-escape-code-in-string value)
+ (org-element-normalize-string (org-escape-code-in-string value))
"#+END_SRC")))
@@ -2449,10 +2493,12 @@ Assume point is at the beginning of the table."
(save-excursion
(let* ((case-fold-search t)
(table-begin (point))
- (type (if (org-at-table.el-p) 'table.el 'org))
+ (type (if (looking-at "[ \t]*|") 'org 'table.el))
+ (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
+ (if (eq type 'org) "" "+")))
(begin (car affiliated))
(table-end
- (if (re-search-forward org-table-any-border-regexp limit 'm)
+ (if (re-search-forward end-re limit 'move)
(goto-char (match-beginning 0))
(point)))
(tblfm (let (acc)
@@ -2503,7 +2549,7 @@ 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' and `:post-blank' keywords."
+`:type', `:post-blank' and `:post-affiliated' keywords."
(save-excursion
(let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
(begin (point))
@@ -2517,14 +2563,15 @@ containing `:begin', `:end', `:contents-begin', `:contents-end',
(end-of-line)
(skip-chars-backward " \t")
(point))))
- (end (progn (forward-line) (point))))
+ (end (line-beginning-position 2)))
(list 'table-row
(list :type type
:begin begin
:end end
:contents-begin contents-begin
:contents-end contents-end
- :post-blank 0)))))
+ :post-blank 0
+ :post-affiliated begin)))))
(defun org-element-table-row-interpreter (table-row contents)
"Interpret TABLE-ROW element as Org syntax.
@@ -2545,7 +2592,7 @@ their value.
Return a list whose CAR is `verse-block' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:hiddenp', `:post-blank' and `:post-affiliated' keywords.
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of the block."
(let ((case-fold-search t))
@@ -2557,8 +2604,7 @@ Assume point is at beginning of the block."
(save-excursion
(let* ((begin (car affiliated))
(post-affiliated (point))
- (hidden (progn (forward-line) (org-invisible-p2)))
- (contents-begin (point))
+ (contents-begin (progn (forward-line) (point)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -2570,7 +2616,6 @@ Assume point is at beginning of the block."
:end end
:contents-begin contents-begin
:contents-end contents-end
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -2584,104 +2629,75 @@ CONTENTS is verse block contents."
;;; Objects
;;
-;; Unlike to elements, interstices can be found between objects.
-;; That's why, along with the parser, successor functions are provided
-;; for each object. Some objects share the same successor (e.g.,
-;; `code' and `verbatim' objects).
-;;
-;; A successor must accept a single argument bounding the search. It
-;; will return either a cons cell whose CAR is the object's type, as
-;; a symbol, and CDR the position of its next occurrence, or nil.
-;;
-;; Successors follow the naming convention:
-;; org-element-NAME-successor, where NAME is the name of the
-;; successor, as defined in `org-element-all-successors'.
+;; Unlike to elements, raw text can be found between objects. Hence,
+;; `org-element--object-lex' is provided to find the next object in
+;; buffer.
;;
;; Some object types (e.g., `italic') are recursive. Restrictions on
;; object types they can contain will be specified in
;; `org-element-object-restrictions'.
;;
-;; Adding a new type of object is simple. Implement a successor,
-;; a parser, and an interpreter for it, all following the naming
-;; convention. Register type in `org-element-all-objects' and
-;; successor in `org-element-all-successors'. Maybe tweak
-;; restrictions about it, and that's it.
-
+;; Creating a new type of object requires to alter
+;; `org-element--object-regexp' and `org-element--object-lex', add the
+;; new type in `org-element-all-objects', and possibly add
+;; restrictions in `org-element-object-restrictions'.
;;;; Bold
(defun org-element-bold-parser ()
- "Parse bold object at point.
+ "Parse bold object at point, if any.
-Return a list whose CAR is `bold' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at a bold object, return a list whose car is `bold' and cdr
+is a plist with `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords. Otherwise, return
+nil.
Assume point is at the first star marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'bold
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'bold
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-bold-interpreter (bold contents)
"Interpret BOLD object as Org syntax.
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor ()
- "Search for the next text-markup object.
-
-Return value is a cons cell whose CAR is a symbol among `bold',
-`italic', `underline', `strike-through', `code' and `verbatim'
-and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (when (re-search-forward org-emph-re nil t)
- (let ((marker (match-string 3)))
- (cons (cond
- ((equal marker "*") 'bold)
- ((equal marker "/") 'italic)
- ((equal marker "_") 'underline)
- ((equal marker "+") 'strike-through)
- ((equal marker "~") 'code)
- ((equal marker "=") 'verbatim)
- (t (error "Unknown marker at %d" (match-beginning 3))))
- (match-beginning 2))))))
-
;;;; Code
(defun org-element-code-parser ()
- "Parse code object at point.
+ "Parse code object at point, if any.
-Return a list whose CAR is `code' and CDR is a plist with
-`:value', `:begin', `:end' and `:post-blank' keywords.
+When at a code object, return a list whose car is `code' and cdr
+is a plist with `:value', `:begin', `:end' and `:post-blank'
+keywords. Otherwise, return nil.
Assume point is at the first tilde marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'code
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'code
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-code-interpreter (code contents)
"Interpret CODE object as Org syntax.
@@ -2692,35 +2708,37 @@ CONTENTS is nil."
;;;; Entity
(defun org-element-entity-parser ()
- "Parse entity at point.
+ "Parse entity at point, if any.
-Return a list whose CAR is `entity' and CDR a plist with
-`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
-`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
-keywords.
+When at an entity, return a list whose car is `entity' and cdr
+a plist with `:begin', `:end', `:latex', `:latex-math-p',
+`:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the entity."
- (save-excursion
- (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
- (let* ((value (org-entity-get (match-string 1)))
- (begin (match-beginning 0))
- (bracketsp (string= (match-string 2) "{}"))
- (post-blank (progn (goto-char (match-end 1))
- (when bracketsp (forward-char 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'entity
- (list :name (car value)
- :latex (nth 1 value)
- :latex-math-p (nth 2 value)
- :html (nth 3 value)
- :ascii (nth 4 value)
- :latin1 (nth 5 value)
- :utf-8 (nth 6 value)
- :begin begin
- :end end
- :use-brackets-p bracketsp
- :post-blank post-blank)))))
+ (catch 'no-object
+ (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)")
+ (save-excursion
+ (let* ((value (or (org-entity-get (match-string 1))
+ (throw 'no-object nil)))
+ (begin (match-beginning 0))
+ (bracketsp (string= (match-string 2) "{}"))
+ (post-blank (progn (goto-char (match-end 1))
+ (when bracketsp (forward-char 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'entity
+ (list :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :post-blank post-blank)))))))
(defun org-element-entity-interpreter (entity contents)
"Interpret ENTITY object as Org syntax.
@@ -2729,59 +2747,37 @@ CONTENTS is nil."
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor ()
- "Search for the next latex-fragment or entity object.
-
-Return value is a cons cell whose CAR is `entity' or
-`latex-fragment' and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (let ((matchers (cdr org-latex-regexps))
- ;; ENTITY-RE matches both LaTeX commands and Org entities.
- (entity-re
- "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
- (when (re-search-forward
- (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t)
- (goto-char (match-beginning 0))
- (if (looking-at entity-re)
- ;; Determine if it's a real entity or a LaTeX command.
- (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
- (match-beginning 0))
- ;; No entity nor command: point is at a LaTeX fragment.
- ;; Determine its type to get the correct beginning position.
- (cons 'latex-fragment
- (catch 'return
- (dolist (e matchers)
- (when (looking-at (nth 1 e))
- (throw 'return (match-beginning (nth 2 e)))))
- (point))))))))
-
;;;; Export Snippet
(defun org-element-export-snippet-parser ()
"Parse export snippet at point.
-Return a list whose CAR is `export-snippet' and CDR a plist with
-`:begin', `:end', `:back-end', `:value' and `:post-blank' as
-keywords.
+When at an export snippet, return a list whose car is
+`export-snippet' and cdr a plist with `:begin', `:end',
+`:back-end', `:value' and `:post-blank' as keywords. Otherwise,
+return nil.
Assume point is at the beginning of the snippet."
(save-excursion
- (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t)
- (let* ((begin (match-beginning 0))
- (back-end (org-match-string-no-properties 1))
- (value (buffer-substring-no-properties
- (point)
- (progn (re-search-forward "@@" nil t) (match-beginning 0))))
- (post-blank (skip-chars-forward " \t"))
- (end (point)))
- (list 'export-snippet
- (list :back-end back-end
- :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (let (contents-end)
+ (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):")
+ (setq contents-end
+ (save-match-data (goto-char (match-end 0))
+ (re-search-forward "@@" nil t)
+ (match-beginning 0))))
+ (let* ((begin (match-beginning 0))
+ (back-end (org-match-string-no-properties 1))
+ (value (buffer-substring-no-properties
+ (match-end 0) contents-end))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (list 'export-snippet
+ (list :back-end back-end
+ :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))))
(defun org-element-export-snippet-interpreter (export-snippet contents)
"Interpret EXPORT-SNIPPET object as Org syntax.
@@ -2790,163 +2786,124 @@ CONTENTS is nil."
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
-(defun org-element-export-snippet-successor ()
- "Search for the next export-snippet object.
-
-Return value is a cons cell whose CAR is `export-snippet' and CDR
-its beginning position."
- (save-excursion
- (let (beg)
- (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t)
- (setq beg (match-beginning 0))
- (search-forward "@@" nil t))
- (cons 'export-snippet beg)))))
-
;;;; Footnote Reference
(defun org-element-footnote-reference-parser ()
- "Parse footnote reference at point.
-
-Return a list whose CAR is `footnote-reference' and CDR a plist
-with `:label', `:type', `:inline-definition', `:begin', `:end'
-and `:post-blank' as keywords."
- (save-excursion
- (looking-at org-footnote-re)
- (let* ((begin (point))
- (label (or (org-match-string-no-properties 2)
+ "Parse footnote reference at point, if any.
+
+When at a footnote reference, return a list whose car is
+`footnote-reference' and cdr a plist with `:label', `:type',
+`:begin', `:end', `:content-begin', `:contents-end' and
+`:post-blank' as keywords. Otherwise, return nil."
+ (when (looking-at org-footnote-re)
+ (let ((closing (with-syntax-table org-element--pair-square-table
+ (ignore-errors (scan-lists (point) 1 0)))))
+ (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))
- (inner-begin (match-end 0))
- (inner-end
- (let ((count 1))
- (forward-char)
- (while (and (> count 0) (re-search-forward "[][]" nil t))
- (if (equal (match-string 0) "[") (incf count) (decf count)))
- (1- (point))))
- (post-blank (progn (goto-char (1+ inner-end))
- (skip-chars-forward " \t")))
- (end (point))
- (footnote-reference
+ (type (if (or (not label) (match-string 1)) 'inline 'standard))
+ (inner-begin (match-end 0))
+ (inner-end (1- closing))
+ (post-blank (progn (goto-char closing)
+ (skip-chars-forward " \t")))
+ (end (point)))
(list 'footnote-reference
(list :label label
:type type
:begin begin
:end end
- :post-blank post-blank))))
- (org-element-put-property
- footnote-reference :inline-definition
- (and (eq type 'inline)
- (org-element-parse-secondary-string
- (buffer-substring inner-begin inner-end)
- (org-element-restriction 'footnote-reference)
- footnote-reference))))))
+ :contents-begin (and (eq type 'inline) inner-begin)
+ :contents-end (and (eq type 'inline) inner-end)
+ :post-blank post-blank))))))))
(defun org-element-footnote-reference-interpreter (footnote-reference contents)
"Interpret FOOTNOTE-REFERENCE object as Org syntax.
-CONTENTS is nil."
- (let ((label (or (org-element-property :label footnote-reference) "fn:"))
- (def
- (let ((inline-def
- (org-element-property :inline-definition footnote-reference)))
- (if (not inline-def) ""
- (concat ":" (org-element-interpret-data inline-def))))))
- (format "[%s]" (concat label def))))
-
-(defun org-element-footnote-reference-successor ()
- "Search for the next footnote-reference object.
-
-Return value is a cons cell whose CAR is `footnote-reference' and
-CDR is beginning position."
- (save-excursion
- (catch 'exit
- (while (re-search-forward org-footnote-re nil t)
- (save-excursion
- (let ((beg (match-beginning 0))
- (count 1))
- (backward-char)
- (while (re-search-forward "[][]" nil t)
- (if (equal (match-string 0) "[") (incf count) (decf count))
- (when (zerop count)
- (throw 'exit (cons 'footnote-reference beg))))))))))
+CONTENTS is its definition, when inline, or nil."
+ (format "[%s]"
+ (concat (or (org-element-property :label footnote-reference) "fn:")
+ (and contents (concat ":" contents)))))
;;;; Inline Babel Call
(defun org-element-inline-babel-call-parser ()
- "Parse inline babel call at point.
+ "Parse inline babel call at point, if any.
-Return a list whose CAR is `inline-babel-call' and CDR a plist
-with `:begin', `:end', `:info' and `:post-blank' as keywords.
+When at an inline babel call, return a list whose car is
+`inline-babel-call' and cdr a plist with `:call',
+`:inside-header', `:arguments', `:end-header', `:begin', `:end',
+`:value' and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the babel call."
(save-excursion
(unless (bolp) (backward-char))
- (looking-at org-babel-inline-lob-one-liner-regexp)
- (let ((info (save-match-data (org-babel-lob-get-info)))
- (begin (match-end 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-babel-call
- (list :begin begin
- :end end
- :info info
- :post-blank post-blank)))))
+ (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))))))
(defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
"Interpret INLINE-BABEL-CALL object as Org syntax.
CONTENTS is nil."
- (let* ((babel-info (org-element-property :info inline-babel-call))
- (main-source (car babel-info))
- (post-options (nth 1 babel-info)))
- (concat "call_"
- (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
- ;; Remove redundant square brackets.
- (replace-match
- (match-string 1 main-source) nil nil main-source)
- main-source)
- (and post-options (format "[%s]" post-options)))))
-
-(defun org-element-inline-babel-call-successor ()
- "Search for the next inline-babel-call object.
-
-Return value is a cons cell whose CAR is `inline-babel-call' and
-CDR is beginning position."
- (save-excursion
- (when (re-search-forward org-babel-inline-lob-one-liner-regexp nil t)
- (cons 'inline-babel-call (match-end 1)))))
+ (concat "call_"
+ (org-element-property :call inline-babel-call)
+ (let ((h (org-element-property :inside-header inline-babel-call)))
+ (and h (format "[%s]" h)))
+ "(" (org-element-property :arguments inline-babel-call) ")"
+ (let ((h (org-element-property :end-header inline-babel-call)))
+ (and h (format "[%s]" h)))))
;;;; Inline Src Block
(defun org-element-inline-src-block-parser ()
- "Parse inline source block at point.
+ "Parse inline source block at point, if any.
-Return a list whose CAR is `inline-src-block' and CDR a plist
-with `:begin', `:end', `:language', `:value', `:parameters' and
-`:post-blank' as keywords.
+When at an inline source block, return a list whose car is
+`inline-src-block' and cdr a plist with `:begin', `:end',
+`:language', `:value', `:parameters' and `:post-blank' as
+keywords. Otherwise, return nil.
Assume point is at the beginning of the inline src block."
(save-excursion
(unless (bolp) (backward-char))
- (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)))))
+ (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))))))
(defun org-element-inline-src-block-interpreter (inline-src-block contents)
"Interpret INLINE-SRC-BLOCK object as Org syntax.
@@ -2959,41 +2916,32 @@ CONTENTS is nil."
(if arguments (format "[%s]" arguments) "")
body)))
-(defun org-element-inline-src-block-successor ()
- "Search for the next inline-babel-call element.
-
-Return value is a cons cell whose CAR is `inline-babel-call' and
-CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (when (re-search-forward org-babel-inline-src-block-regexp nil t)
- (cons 'inline-src-block (match-beginning 1)))))
-
;;;; Italic
(defun org-element-italic-parser ()
- "Parse italic object at point.
+ "Parse italic object at point, if any.
-Return a list whose CAR is `italic' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at an italic object, return a list whose car is `italic' and
+cdr is a plist with `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords. Otherwise, return
+nil.
Assume point is at the first slash marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'italic
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'italic
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-italic-interpreter (italic contents)
"Interpret ITALIC object as Org syntax.
@@ -3004,36 +2952,42 @@ CONTENTS is the contents of the object."
;;;; Latex Fragment
(defun org-element-latex-fragment-parser ()
- "Parse LaTeX fragment at point.
+ "Parse LaTeX fragment at point, if any.
-Return a list whose CAR is `latex-fragment' and CDR a plist with
-`:value', `:begin', `:end', and `:post-blank' as keywords.
+When at a LaTeX fragment, return a list whose car is
+`latex-fragment' and cdr a plist with `:value', `:begin', `:end',
+and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the LaTeX fragment."
- (save-excursion
- (let* ((begin (point))
- (substring-match
- (catch 'exit
- (dolist (e (cdr org-latex-regexps))
- (let ((latex-regexp (nth 1 e)))
- (when (or (looking-at latex-regexp)
- (and (not (bobp))
- (save-excursion
- (backward-char)
- (looking-at latex-regexp))))
- (throw 'exit (nth 2 e)))))
- ;; None found: it's a macro.
- (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
- 0))
- (value (org-match-string-no-properties substring-match))
- (post-blank (progn (goto-char (match-end substring-match))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'latex-fragment
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (catch 'no-object
+ (save-excursion
+ (let* ((begin (point))
+ (after-fragment
+ (if (eq (char-after) ?$)
+ (if (eq (char-after (1+ (point))) ?$)
+ (search-forward "$$" nil t 2)
+ (and (not (eq (char-before) ?$))
+ (search-forward "$" nil t 2)
+ (not (memq (char-before (match-beginning 0))
+ '(?\s ?\t ?\n ?, ?.)))
+ (looking-at "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|$\\)")
+ (point)))
+ (case (char-after (1+ (point)))
+ (?\( (search-forward "\\)" nil t))
+ (?\[ (search-forward "\\]" nil t))
+ (otherwise
+ ;; Macro.
+ (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)
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'latex-fragment
+ (list :value (buffer-substring-no-properties begin after-fragment)
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-latex-fragment-interpreter (latex-fragment contents)
"Interpret LATEX-FRAGMENT object as Org syntax.
@@ -3043,138 +2997,146 @@ CONTENTS is nil."
;;;; Line Break
(defun org-element-line-break-parser ()
- "Parse line break at point.
+ "Parse line break at point, if any.
-Return a list whose CAR is `line-break', and CDR a plist with
-`:begin', `:end' and `:post-blank' keywords.
+When at a line break, return a list whose car is `line-break',
+and cdr a plist with `:begin', `:end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the beginning of the line break."
- (list 'line-break
- (list :begin (point)
- :end (progn (forward-line) (point))
- :post-blank 0)))
+ (when (and (org-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."
"\\\\\n")
-(defun org-element-line-break-successor ()
- "Search for the next line-break object.
-
-Return value is a cons cell whose CAR is `line-break' and CDR is
-beginning position."
- (save-excursion
- (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t)
- (goto-char (match-beginning 1)))))
- ;; A line break can only happen on a non-empty line.
- (when (and beg (re-search-backward "\\S-" (point-at-bol) t))
- (cons 'line-break beg)))))
-
;;;; Link
(defun org-element-link-parser ()
- "Parse link at point.
+ "Parse link at point, if any.
-Return a list whose CAR is `link' and CDR a plist with `:type',
-`:path', `:raw-link', `:application', `:search-option', `:begin',
-`:end', `:contents-begin', `:contents-end' and `:post-blank' as
-keywords.
+When at a link, return a list whose car is `link' and cdr a plist
+with `:type', `:path', `:raw-link', `:application',
+`:search-option', `:begin', `:end', `:contents-begin',
+`:contents-end' and `:post-blank' as keywords. Otherwise, return
+nil.
Assume point is at the beginning of the link."
- (save-excursion
+ (catch 'no-object
(let ((begin (point))
end contents-begin contents-end link-end post-blank path type
raw-link link search-option application)
(cond
;; Type 1: Text targeted from a radio target.
- ((and org-target-link-regexp (looking-at org-target-link-regexp))
+ ((and org-target-link-regexp
+ (save-excursion (or (bolp) (backward-char))
+ (looking-at org-target-link-regexp)))
(setq type "radio"
- link-end (match-end 0)
- path (org-match-string-no-properties 0)
- contents-begin (match-beginning 0)
- contents-end (match-end 0)))
+ link-end (match-end 1)
+ path (org-match-string-no-properties 1)
+ contents-begin (match-beginning 1)
+ contents-end (match-end 1)))
;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
((looking-at org-bracket-link-regexp)
- (setq contents-begin (match-beginning 3)
- contents-end (match-end 3)
- link-end (match-end 0)
- ;; RAW-LINK is the original link. Expand any
- ;; abbreviation in it.
- raw-link (org-translate-link
+ (setq contents-begin (match-beginning 3))
+ (setq contents-end (match-end 3))
+ (setq link-end (match-end 0))
+ ;; RAW-LINK is the original link. Expand any
+ ;; abbreviation in it.
+ ;;
+ ;; Also treat any newline character and associated
+ ;; indentation as a single space character. This is not
+ ;; compatible with RFC 3986, which requires to ignore
+ ;; them altogether. However, doing so would require
+ ;; users to encode spaces on the fly when writing links
+ ;; (e.g., insert [[shell:ls%20*.org]] instead of
+ ;; [[shell:ls *.org]], which defeats Org's focus on
+ ;; simplicity.
+ (setq raw-link (org-translate-link
(org-link-expand-abbrev
- (org-match-string-no-properties 1))))
- ;; Determine TYPE of link and set PATH accordingly.
+ (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" " "
+ (org-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.
(cond
;; File type.
((or (file-name-absolute-p raw-link)
(string-match "\\`\\.\\.?/" raw-link))
- (setq type "file" path raw-link))
+ (setq type "file")
+ (setq path raw-link))
;; Explicit type (http, irc, bbdb...). See `org-link-types'.
((string-match org-link-types-re raw-link)
- (setq type (match-string 1 raw-link)
- ;; According to RFC 3986, extra whitespace should be
- ;; ignored when a URI is extracted.
- path (replace-regexp-in-string
- "[ \t]*\n[ \t]*" "" (substring raw-link (match-end 0)))))
+ (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)
+ ((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.
- ((string-match "\\`(\\(.*\\))\\'" raw-link)
- (setq type "coderef" path (match-string 1 raw-link)))
+ ((and (org-string-match-p "\\`(" raw-link)
+ (org-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.
- ((= (aref raw-link 0) ?#)
- (setq type "custom-id" path (substring raw-link 1)))
+ ((= (string-to-char raw-link) ?#)
+ (setq type "custom-id")
+ (setq path (substring raw-link 1)))
;; Fuzzy type: Internal link either matches a target, an
;; headline name or nothing. PATH is the target or
;; headline's name.
- (t (setq type "fuzzy" path raw-link))))
+ (t
+ (setq type "fuzzy")
+ (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)))
- ;; Type 4: Angular link, e.g., <http://orgmode.org>
+ ;; 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 raw-link (buffer-substring-no-properties
- (match-beginning 1) (match-end 2))
- type (org-match-string-no-properties 1)
- link-end (match-end 0)
- path (org-match-string-no-properties 2))))
+ (setq type (org-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 (throw 'no-object nil)))
;; In any case, deduce end point after trailing white space from
;; LINK-END variable.
- (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
- end (point))
- ;; Special "file" type link processing.
- (when (member type org-element-link-type-is-file)
- ;; Extract opening application and search option.
- (cond ((string-match "^file\\+\\(.*\\)$" type)
- (setq application (match-string 1 type)))
- ((not (string-match "^file" type))
- (setq application type)))
- (when (string-match "::\\(.*\\)\\'" path)
- (setq search-option (match-string 1 path)
- path (replace-match "" nil nil path)))
- ;; Normalize URI.
- (when (and (not (org-string-match-p "\\`//" path))
- (file-name-absolute-p path))
- (setq path (concat "//" (expand-file-name path))))
- ;; Make sure TYPE always reports "file".
- (setq type "file"))
- (list 'link
- (list :type type
- :path path
- :raw-link (or raw-link path)
- :application application
- :search-option search-option
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (save-excursion
+ (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
+ end (point))
+ ;; Special "file" type link processing. Extract opening
+ ;; application and search option, if any. Also normalize URI.
+ (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
+ (setq application (match-string 1 type) type "file")
+ (when (string-match "::\\(.*\\)\\'" path)
+ (setq search-option (match-string 1 path)
+ path (replace-match "" nil nil path)))
+ (setq path (replace-regexp-in-string "\\`/+" "/" path)))
+ (list 'link
+ (list :type type
+ :path path
+ :raw-link (or raw-link path)
+ :application application
+ :search-option search-option
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-link-interpreter (link contents)
"Interpret LINK object as Org syntax.
@@ -3186,188 +3148,131 @@ CONTENTS is the contents of the object, or nil."
raw-link
(if contents (format "[%s]" contents) "")))))
-(defun org-element-link-successor ()
- "Search for the next link object.
-
-Return value is a cons cell whose CAR is `link' and CDR is
-beginning position."
- (save-excursion
- (let ((link-regexp
- (if (not org-target-link-regexp) org-any-link-re
- (concat org-any-link-re "\\|" org-target-link-regexp))))
- (when (re-search-forward link-regexp nil t)
- (cons 'link (match-beginning 0))))))
-
-(defun org-element-plain-link-successor ()
- "Search for the next plain link object.
-
-Return value is a cons cell whose CAR is `link' and CDR is
-beginning position."
- (and (save-excursion (re-search-forward org-plain-link-re nil t))
- (cons 'link (match-beginning 0))))
-
;;;; Macro
(defun org-element-macro-parser ()
- "Parse macro at point.
+ "Parse macro at point, if any.
-Return a list whose CAR is `macro' and CDR a plist with `:key',
-`:args', `:begin', `:end', `:value' and `:post-blank' as
-keywords.
+When at a macro, return a list whose car is `macro' and cdr
+a plist with `:key', `:args', `:begin', `:end', `:value' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the macro."
(save-excursion
- (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))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (args (let ((args (org-match-string-no-properties 3)))
- (when args
- ;; Do not use `org-split-string' since empty
- ;; strings are meaningful here.
- (split-string
- (replace-regexp-in-string
- "\\(\\\\*\\)\\(,\\)"
- (lambda (str)
- (let ((len (length (match-string 1 str))))
- (concat (make-string (/ len 2) ?\\)
- (if (zerop (mod len 2)) "\000" ","))))
- args nil t)
- "\000")))))
- (list 'macro
- (list :key key
- :value value
- :args args
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (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))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (args (let ((args (org-match-string-no-properties 3)))
+ (and args (org-macro-extract-arguments args)))))
+ (list 'macro
+ (list :key key
+ :value value
+ :args args
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-macro-interpreter (macro contents)
"Interpret MACRO object as Org syntax.
CONTENTS is nil."
(org-element-property :value macro))
-(defun org-element-macro-successor ()
- "Search for the next macro object.
-
-Return value is cons cell whose CAR is `macro' and CDR is
-beginning position."
- (save-excursion
- (when (re-search-forward
- "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
- nil t)
- (cons 'macro (match-beginning 0)))))
-
;;;; Radio-target
(defun org-element-radio-target-parser ()
- "Parse radio target at point.
+ "Parse radio target at point, if any.
-Return a list whose CAR is `radio-target' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end', `:value'
-and `:post-blank' as keywords.
+When at a radio target, return a list whose car is `radio-target'
+and cdr a plist with `:begin', `:end', `:contents-begin',
+`:contents-end', `:value' and `:post-blank' as keywords.
+Otherwise, return nil.
Assume point is at the radio target."
(save-excursion
- (looking-at org-radio-target-regexp)
- (let ((begin (point))
- (contents-begin (match-beginning 1))
- (contents-end (match-end 1))
- (value (org-match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'radio-target
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank
- :value value)))))
+ (when (looking-at org-radio-target-regexp)
+ (let ((begin (point))
+ (contents-begin (match-beginning 1))
+ (contents-end (match-end 1))
+ (value (org-match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'radio-target
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank
+ :value value))))))
(defun org-element-radio-target-interpreter (target contents)
"Interpret TARGET object as Org syntax.
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
-(defun org-element-radio-target-successor ()
- "Search for the next radio-target object.
-
-Return value is a cons cell whose CAR is `radio-target' and CDR
-is beginning position."
- (save-excursion
- (when (re-search-forward org-radio-target-regexp nil t)
- (cons 'radio-target (match-beginning 0)))))
-
;;;; Statistics Cookie
(defun org-element-statistics-cookie-parser ()
- "Parse statistics cookie at point.
+ "Parse statistics cookie at point, if any.
-Return a list whose CAR is `statistics-cookie', and CDR a plist
-with `:begin', `:end', `:value' and `:post-blank' keywords.
+When at a statistics cookie, return a list whose car is
+`statistics-cookie', and cdr a plist with `:begin', `:end',
+`:value' and `:post-blank' keywords. Otherwise, return nil.
Assume point is at the beginning of the statistics-cookie."
(save-excursion
- (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
- (let* ((begin (point))
- (value (buffer-substring-no-properties
- (match-beginning 0) (match-end 0)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'statistics-cookie
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank)))))
+ (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
+ (let* ((begin (point))
+ (value (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'statistics-cookie
+ (list :begin begin
+ :end end
+ :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."
(org-element-property :value statistics-cookie))
-(defun org-element-statistics-cookie-successor ()
- "Search for the next statistics cookie object.
-
-Return value is a cons cell whose CAR is `statistics-cookie' and
-CDR is beginning position."
- (save-excursion
- (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t)
- (cons 'statistics-cookie (match-beginning 0)))))
-
;;;; Strike-Through
(defun org-element-strike-through-parser ()
- "Parse strike-through object at point.
+ "Parse strike-through object at point, if any.
-Return a list whose CAR is `strike-through' and CDR is a plist
-with `:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at a strike-through object, return a list whose car is
+`strike-through' and cdr is a plist with `:begin', `:end',
+`:contents-begin' and `:contents-end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the first plus sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'strike-through
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'strike-through
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-strike-through-interpreter (strike-through contents)
"Interpret STRIKE-THROUGH object as Org syntax.
@@ -3378,32 +3283,32 @@ CONTENTS is the contents of the object."
;;;; Subscript
(defun org-element-subscript-parser ()
- "Parse subscript at point.
+ "Parse subscript at point, if any.
-Return a list whose CAR is `subscript' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end',
-`:use-brackets-p' and `:post-blank' as keywords.
+When at a subscript object, return a list whose car is
+`subscript' and cdr a plist with `:begin', `:end',
+`:contents-begin', `:contents-end', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the underscore."
(save-excursion
(unless (bolp) (backward-char))
- (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
- t
- (not (looking-at org-match-substring-regexp))))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 5)
- (match-beginning 3)))
- (contents-end (or (match-end 5) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'subscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-match-substring-regexp)
+ (let ((bracketsp (match-beginning 4))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 4)
+ (match-beginning 3)))
+ (contents-end (or (match-end 4) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'subscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-subscript-interpreter (subscript contents)
"Interpret SUBSCRIPT object as Org syntax.
@@ -3412,46 +3317,36 @@ CONTENTS is the contents of the object."
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
-(defun org-element-sub/superscript-successor ()
- "Search for the next sub/superscript object.
-
-Return value is a cons cell whose CAR is either `subscript' or
-`superscript' and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (when (re-search-forward org-match-substring-regexp nil t)
- (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
- (match-beginning 2)))))
-
;;;; Superscript
(defun org-element-superscript-parser ()
- "Parse superscript at point.
+ "Parse superscript at point, if any.
-Return a list whose CAR is `superscript' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end',
-`:use-brackets-p' and `:post-blank' as keywords.
+When at a superscript object, return a list whose car is
+`superscript' and cdr a plist with `:begin', `:end',
+`:contents-begin', `:contents-end', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the caret."
(save-excursion
(unless (bolp) (backward-char))
- (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
- (not (looking-at org-match-substring-regexp))))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 5)
- (match-beginning 3)))
- (contents-end (or (match-end 5) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'superscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-match-substring-regexp)
+ (let ((bracketsp (match-beginning 4))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 4)
+ (match-beginning 3)))
+ (contents-end (or (match-end 4) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'superscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-superscript-interpreter (superscript contents)
"Interpret SUPERSCRIPT object as Org syntax.
@@ -3465,8 +3360,7 @@ CONTENTS is the contents of the object."
(defun org-element-table-cell-parser ()
"Parse table cell at point.
-
-Return a list whose CAR is `table-cell' and CDR is a plist
+Return a list whose car is `table-cell' and cdr is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end'
and `:post-blank' keywords."
(looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
@@ -3486,291 +3380,270 @@ and `:post-blank' keywords."
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
-(defun org-element-table-cell-successor ()
- "Search for the next table-cell object.
-
-Return value is a cons cell whose CAR is `table-cell' and CDR is
-beginning position."
- (when (looking-at "[ \t]*.*?[ \t]*\\(|\\|$\\)") (cons 'table-cell (point))))
-
;;;; Target
(defun org-element-target-parser ()
- "Parse target at point.
+ "Parse target at point, if any.
-Return a list whose CAR is `target' and CDR a plist with
-`:begin', `:end', `:value' and `:post-blank' as keywords.
+When at a target, return a list whose car is `target' and cdr
+a plist with `:begin', `:end', `:value' and `:post-blank' as
+keywords. Otherwise, return nil.
Assume point is at the target."
(save-excursion
- (looking-at org-target-regexp)
- (let ((begin (point))
- (value (org-match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'target
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank)))))
+ (when (looking-at org-target-regexp)
+ (let ((begin (point))
+ (value (org-match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'target
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank))))))
(defun org-element-target-interpreter (target contents)
"Interpret TARGET object as Org syntax.
CONTENTS is nil."
(format "<<%s>>" (org-element-property :value target)))
-(defun org-element-target-successor ()
- "Search for the next target object.
-
-Return value is a cons cell whose CAR is `target' and CDR is
-beginning position."
- (save-excursion
- (when (re-search-forward org-target-regexp nil t)
- (cons 'target (match-beginning 0)))))
-
;;;; Timestamp
+(defconst org-element--timestamp-regexp
+ (concat org-ts-regexp-both
+ "\\|"
+ "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
+ "\\|"
+ "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
+ "Regexp matching any timestamp type object.")
+
(defun org-element-timestamp-parser ()
- "Parse time stamp at point.
+ "Parse time stamp at point, if any.
-Return a list whose CAR is `timestamp', and CDR a plist with
-`:type', `:raw-value', `:year-start', `:month-start',
-`:day-start', `:hour-start', `:minute-start', `:year-end',
-`:month-end', `:day-end', `:hour-end', `:minute-end',
-`:repeater-type', `:repeater-value', `:repeater-unit',
-`:warning-type', `:warning-value', `:warning-unit', `:begin',
-`:end' and `:post-blank' keywords.
+When at a time stamp, return a list whose car is `timestamp', and
+cdr a plist with `:type', `:raw-value', `:year-start',
+`:month-start', `:day-start', `:hour-start', `:minute-start',
+`:year-end', `:month-end', `:day-end', `:hour-end',
+`:minute-end', `:repeater-type', `:repeater-value',
+`:repeater-unit', `:warning-type', `:warning-value',
+`:warning-unit', `:begin', `:end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the beginning of the timestamp."
- (save-excursion
- (let* ((begin (point))
- (activep (eq (char-after) ?<))
- (raw-value
- (progn
- (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
- (match-string-no-properties 0)))
- (date-start (match-string-no-properties 1))
- (date-end (match-string 3))
- (diaryp (match-beginning 2))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (time-range
- (and (not diaryp)
- (string-match
- "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
- date-start)
- (cons (string-to-number (match-string 2 date-start))
- (string-to-number (match-string 3 date-start)))))
- (type (cond (diaryp 'diary)
- ((and activep (or date-end time-range)) 'active-range)
- (activep 'active)
- ((or date-end time-range) 'inactive-range)
- (t 'inactive)))
- (repeater-props
- (and (not diaryp)
- (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
- raw-value)
- (list
- :repeater-type
- (let ((type (match-string 1 raw-value)))
- (cond ((equal "++" type) 'catch-up)
- ((equal ".+" type) 'restart)
- (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)))))
- (warning-props
- (and (not diaryp)
- (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
- (list
- :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)))))
- year-start month-start day-start hour-start minute-start year-end
- month-end day-end hour-end minute-end)
- ;; Parse date-start.
- (unless diaryp
- (let ((date (org-parse-time-string date-start t)))
- (setq year-start (nth 5 date)
- month-start (nth 4 date)
- day-start (nth 3 date)
- hour-start (nth 2 date)
- minute-start (nth 1 date))))
- ;; Compute date-end. It can be provided directly in time-stamp,
- ;; or extracted from time range. Otherwise, it defaults to the
- ;; same values as date-start.
- (unless diaryp
- (let ((date (and date-end (org-parse-time-string date-end t))))
- (setq year-end (or (nth 5 date) year-start)
- month-end (or (nth 4 date) month-start)
- day-end (or (nth 3 date) day-start)
- hour-end (or (nth 2 date) (car time-range) hour-start)
- minute-end (or (nth 1 date) (cdr time-range) minute-start))))
- (list 'timestamp
- (nconc (list :type type
- :raw-value raw-value
- :year-start year-start
- :month-start month-start
- :day-start day-start
- :hour-start hour-start
- :minute-start minute-start
- :year-end year-end
- :month-end month-end
- :day-end day-end
- :hour-end hour-end
- :minute-end minute-end
- :begin begin
- :end end
- :post-blank post-blank)
- repeater-props
- warning-props)))))
+ (when (org-looking-at-p org-element--timestamp-regexp)
+ (save-excursion
+ (let* ((begin (point))
+ (activep (eq (char-after) ?<))
+ (raw-value
+ (progn
+ (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (match-string-no-properties 0)))
+ (date-start (match-string-no-properties 1))
+ (date-end (match-string 3))
+ (diaryp (match-beginning 2))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (time-range
+ (and (not diaryp)
+ (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start)))))
+ (type (cond (diaryp 'diary)
+ ((and activep (or date-end time-range)) 'active-range)
+ (activep 'active)
+ ((or date-end time-range) 'inactive-range)
+ (t 'inactive)))
+ (repeater-props
+ (and (not diaryp)
+ (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
+ raw-value)
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (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)))))
+ (warning-props
+ (and (not diaryp)
+ (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
+ (list
+ :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)))))
+ year-start month-start day-start hour-start minute-start year-end
+ month-end day-end hour-end minute-end)
+ ;; Parse date-start.
+ (unless diaryp
+ (let ((date (org-parse-time-string date-start t)))
+ (setq year-start (nth 5 date)
+ month-start (nth 4 date)
+ day-start (nth 3 date)
+ hour-start (nth 2 date)
+ minute-start (nth 1 date))))
+ ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; or extracted from time range. Otherwise, it defaults to the
+ ;; same values as date-start.
+ (unless diaryp
+ (let ((date (and date-end (org-parse-time-string date-end t))))
+ (setq year-end (or (nth 5 date) year-start)
+ month-end (or (nth 4 date) month-start)
+ day-end (or (nth 3 date) day-start)
+ hour-end (or (nth 2 date) (car time-range) hour-start)
+ minute-end (or (nth 1 date) (cdr time-range) minute-start))))
+ (list 'timestamp
+ (nconc (list :type type
+ :raw-value raw-value
+ :year-start year-start
+ :month-start month-start
+ :day-start day-start
+ :hour-start hour-start
+ :minute-start minute-start
+ :year-end year-end
+ :month-end month-end
+ :day-end day-end
+ :hour-end hour-end
+ :minute-end minute-end
+ :begin begin
+ :end end
+ :post-blank post-blank)
+ repeater-props
+ warning-props))))))
(defun org-element-timestamp-interpreter (timestamp contents)
"Interpret TIMESTAMP object as Org syntax.
CONTENTS is nil."
- ;; Use `:raw-value' if specified.
- (or (org-element-property :raw-value timestamp)
- ;; Otherwise, build timestamp string.
- (let* ((repeat-string
- (concat
- (case (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"))))
- (warning-string
- (concat
- (case (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"))))
- (build-ts-string
- ;; Build an Org timestamp string from TIME. ACTIVEP is
- ;; non-nil when time stamp is active. If WITH-TIME-P is
- ;; non-nil, add a time part. HOUR-END and MINUTE-END
- ;; specify a time range in the timestamp. REPEAT-STRING
- ;; is 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)
- org-time-stamp-formats)
- time)))
- (when (and hour-end minute-end)
- (string-match "[012]?[0-9]:[0-5][0-9]" ts)
- (setq ts
- (replace-match
- (format "\\&-%02d:%02d" hour-end minute-end)
- nil nil ts)))
- (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
- (dolist (s (list repeat-string warning-string))
- (when (org-string-nw-p s)
- (setq ts (concat (substring ts 0 -1)
- " "
- s
- (substring ts -1)))))
- ;; Return value.
- ts)))
- (type (org-element-property :type timestamp)))
- (case type
- ((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))
- (hour-end (org-element-property :hour-end timestamp))
- (time-range-p (and hour-start hour-end minute-start minute-end
- (or (/= hour-start hour-end)
- (/= minute-start minute-end)))))
- (funcall
- build-ts-string
- (encode-time 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
- (eq type 'active)
- (and hour-start minute-start)
- (and time-range-p hour-end)
- (and time-range-p minute-end))))
- ((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))
- (hour-end (org-element-property :hour-end timestamp)))
- (concat
- (funcall
- build-ts-string (encode-time
- 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
- (eq type 'active-range)
- (and hour-start minute-start))
- "--"
- (funcall build-ts-string
- (encode-time 0
- (or minute-end 0)
- (or hour-end 0)
- (org-element-property :day-end timestamp)
- (org-element-property :month-end timestamp)
- (org-element-property :year-end timestamp))
- (eq type 'active-range)
- (and hour-end minute-end)))))))))
-
-(defun org-element-timestamp-successor ()
- "Search for the next timestamp object.
-
-Return value is a cons cell whose CAR is `timestamp' and CDR is
-beginning position."
- (save-excursion
- (when (re-search-forward
- (concat org-ts-regexp-both
- "\\|"
- "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
- "\\|"
- "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
- nil t)
- (cons 'timestamp (match-beginning 0)))))
+ (let* ((repeat-string
+ (concat
+ (case (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"))))
+ (warning-string
+ (concat
+ (case (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"))))
+ (build-ts-string
+ ;; Build an Org timestamp string from TIME. ACTIVEP is
+ ;; non-nil when time stamp is active. If WITH-TIME-P is
+ ;; non-nil, add a time part. HOUR-END and MINUTE-END
+ ;; specify a time range in the timestamp. REPEAT-STRING is
+ ;; 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)
+ org-time-stamp-formats)
+ time)))
+ (when (and hour-end minute-end)
+ (string-match "[012]?[0-9]:[0-5][0-9]" ts)
+ (setq ts
+ (replace-match
+ (format "\\&-%02d:%02d" hour-end minute-end)
+ nil nil ts)))
+ (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
+ (dolist (s (list repeat-string warning-string))
+ (when (org-string-nw-p s)
+ (setq ts (concat (substring ts 0 -1)
+ " "
+ s
+ (substring ts -1)))))
+ ;; Return value.
+ ts)))
+ (type (org-element-property :type timestamp)))
+ (case type
+ ((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))
+ (hour-end (org-element-property :hour-end timestamp))
+ (time-range-p (and hour-start hour-end minute-start minute-end
+ (or (/= hour-start hour-end)
+ (/= minute-start minute-end)))))
+ (funcall
+ build-ts-string
+ (encode-time 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active)
+ (and hour-start minute-start)
+ (and time-range-p hour-end)
+ (and time-range-p minute-end))))
+ ((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))
+ (hour-end (org-element-property :hour-end timestamp)))
+ (concat
+ (funcall
+ build-ts-string (encode-time
+ 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active-range)
+ (and hour-start minute-start))
+ "--"
+ (funcall build-ts-string
+ (encode-time 0
+ (or minute-end 0)
+ (or hour-end 0)
+ (org-element-property :day-end timestamp)
+ (org-element-property :month-end timestamp)
+ (org-element-property :year-end timestamp))
+ (eq type 'active-range)
+ (and hour-end minute-end)))))
+ (otherwise (org-element-property :raw-value timestamp)))))
;;;; Underline
(defun org-element-underline-parser ()
- "Parse underline object at point.
+ "Parse underline object at point, if any.
-Return a list whose CAR is `underline' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at an underline object, return a list whose car is
+`underline' and cdr is a plist with `:begin', `:end',
+`:contents-begin' and `:contents-end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the first underscore marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'underline
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'underline
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-underline-interpreter (underline contents)
"Interpret UNDERLINE object as Org syntax.
@@ -3781,25 +3654,26 @@ CONTENTS is the contents of the object."
;;;; Verbatim
(defun org-element-verbatim-parser ()
- "Parse verbatim object at point.
+ "Parse verbatim object at point, if any.
-Return a list whose CAR is `verbatim' and CDR is a plist with
-`:value', `:begin', `:end' and `:post-blank' keywords.
+When at a verbatim object, return a list whose car is `verbatim'
+and cdr is a plist with `:value', `:begin', `:end' and
+`:post-blank' keywords. Otherwise, return nil.
Assume point is at the first equal sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'verbatim
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'verbatim
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-verbatim-interpreter (verbatim contents)
"Interpret VERBATIM object as Org syntax.
@@ -3818,10 +3692,9 @@ CONTENTS is nil."
;; are activated for fixed element chaining (e.g., `plain-list' >
;; `item') or fixed conditional element chaining (e.g., `headline' >
;; `section'). Special modes are: `first-section', `item',
-;; `node-property', `quote-section', `section' and `table-row'.
+;; `node-property', `section' and `table-row'.
-(defun org-element--current-element
- (limit &optional granularity special structure)
+(defun org-element--current-element (limit &optional granularity mode structure)
"Parse the element starting at point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -3838,12 +3711,12 @@ recursion. Allowed values are `headline', `greater-element',
nil), secondary values will not be parsed, since they only
contain objects.
-Optional argument SPECIAL, when non-nil, can be either
-`first-section', `item', `node-property', `quote-section',
-`section', and `table-row'.
+Optional argument MODE, when non-nil, can be either
+`first-section', `section', `planning', `item', `node-property'
+and `table-row'.
-If STRUCTURE isn't provided but SPECIAL is set to `item', it will
-be computed.
+If STRUCTURE isn't provided but MODE is set to `item', it will be
+computed.
This function assumes point is always at the beginning of the
element it has to parse."
@@ -3855,30 +3728,33 @@ element it has to parse."
(raw-secondary-p (and granularity (not (eq granularity 'object)))))
(cond
;; Item.
- ((eq special 'item)
+ ((eq mode 'item)
(org-element-item-parser limit structure raw-secondary-p))
;; Table Row.
- ((eq special 'table-row) (org-element-table-row-parser limit))
+ ((eq mode 'table-row) (org-element-table-row-parser limit))
;; Node Property.
- ((eq special 'node-property) (org-element-node-property-parser limit))
+ ((eq mode 'node-property) (org-element-node-property-parser limit))
;; Headline.
((org-with-limited-levels (org-at-heading-p))
(org-element-headline-parser limit raw-secondary-p))
;; Sections (must be checked after headline).
- ((eq special 'section) (org-element-section-parser limit))
- ((eq special 'quote-section) (org-element-quote-section-parser limit))
- ((eq special 'first-section)
+ ((eq mode 'section) (org-element-section-parser limit))
+ ((eq mode 'first-section)
(org-element-section-parser
(or (save-excursion (org-with-limited-levels (outline-next-heading)))
limit)))
+ ;; Planning.
+ ((and (eq mode 'planning) (looking-at org-planning-line-re))
+ (org-element-planning-parser limit))
+ ;; Property drawer.
+ ((and (memq mode '(planning property-drawer))
+ (looking-at org-property-drawer-re))
+ (org-element-property-drawer-parser limit))
;; When not at bol, point is at the beginning of an item or
;; a footnote definition: next item is always a paragraph.
((not (bolp)) (org-element-paragraph-parser limit (list (point))))
- ;; Planning and Clock.
- ((looking-at org-planning-or-clock-line-re)
- (if (equal (match-string 1) org-clock-string)
- (org-element-clock-parser limit)
- (org-element-planning-parser limit)))
+ ;; Clock.
+ ((looking-at org-clock-line-re) (org-element-clock-parser limit))
;; Inlinetask.
((org-at-heading-p)
(org-element-inlinetask-parser limit raw-secondary-p))
@@ -3891,13 +3767,11 @@ element it has to parse."
(goto-char (car affiliated))
(org-element-keyword-parser limit nil))
;; LaTeX Environment.
- ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
+ ((looking-at org-element--latex-begin-environment)
(org-element-latex-environment-parser limit affiliated))
;; Drawer and Property Drawer.
((looking-at org-drawer-regexp)
- (if (equal (match-string 1) "PROPERTIES")
- (org-element-property-drawer-parser limit affiliated)
- (org-element-drawer-parser limit affiliated)))
+ (org-element-drawer-parser limit affiliated))
;; Fixed Width
((looking-at "[ \t]*:\\( \\|$\\)")
(org-element-fixed-width-parser limit affiliated))
@@ -3936,7 +3810,8 @@ element it has to parse."
((looking-at "%%(")
(org-element-diary-sexp-parser limit affiliated))
;; Table.
- ((org-at-table-p t) (org-element-table-parser limit affiliated))
+ ((looking-at "[ \t]*\\(|\\|\\+\\(-+\\+\\)+[ \t]*$\\)")
+ (org-element-table-parser limit affiliated))
;; List.
((looking-at (org-item-re))
(org-element-plain-list-parser
@@ -3980,7 +3855,7 @@ position of point and CDR is nil."
(save-match-data
(org-trim
(buffer-substring-no-properties
- (match-end 0) (point-at-eol)))))
+ (match-end 0) (line-end-position)))))
;; PARSEDP is non-nil when keyword should have its
;; value parsed.
(parsedp (member kwd org-element-parsed-keywords))
@@ -3991,12 +3866,17 @@ position of point and CDR is nil."
(and dualp
(let ((sec (org-match-string-no-properties 2)))
(if (or (not sec) (not parsedp)) sec
- (org-element-parse-secondary-string sec restrict)))))
+ (org-element--parse-objects
+ (match-beginning 2) (match-end 2) nil restrict)))))
;; Attribute a property name to KWD.
(kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
;; Now set final shape for VALUE.
(when parsedp
- (setq value (org-element-parse-secondary-string value restrict)))
+ (setq value
+ (org-element--parse-objects
+ (match-end 0)
+ (progn (end-of-line) (skip-chars-backward " \t") (point))
+ nil restrict)))
(when dualp
(setq value (and (or value dual-value) (cons value dual-value))))
(when (or (member kwd org-element-multiple-keywords)
@@ -4089,23 +3969,28 @@ looked after.
Optional argument PARENT, when non-nil, is the element or object
containing the secondary string. It is used to set correctly
-`:parent' property within the string."
- (let ((local-variables (buffer-local-variables)))
- (with-temp-buffer
- (dolist (v local-variables)
- (ignore-errors
- (if (symbolp v) (makunbound v)
- (org-set-local (car v) (cdr v)))))
- (insert string)
- (restore-buffer-modified-p nil)
- (let ((secondary (org-element--parse-objects
- (point-min) (point-max) nil restriction)))
- (when parent
- (dolist (o secondary) (org-element-put-property o :parent parent)))
- secondary))))
+`:parent' property within the string.
+
+If STRING is the empty string or nil, return nil."
+ (cond
+ ((not string) nil)
+ ((equal string "") nil)
+ (t (let ((local-variables (buffer-local-variables)))
+ (with-temp-buffer
+ (dolist (v local-variables)
+ (ignore-errors
+ (if (symbolp v) (makunbound v)
+ (org-set-local (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))))))
(defun org-element-map
- (data types fun &optional info first-match no-recursion with-affiliated)
+ (data types fun &optional info first-match no-recursion with-affiliated)
"Map a function on selected elements or objects.
DATA is a parse tree, an element, an object, a string, or a list
@@ -4141,7 +4026,7 @@ Assuming TREE is a variable containing an Org buffer parse tree,
the following example will return a flat list of all `src-block'
and `example-block' elements in it:
- \(org-element-map tree '(example-block src-block) 'identity)
+ \(org-element-map tree '(example-block src-block) #'identity)
The following snippet will find the first headline with a level
of 1 and a \"phone\" tag, and will return its beginning position:
@@ -4156,7 +4041,7 @@ of 1 and a \"phone\" tag, and will return its beginning position:
The next example will return a flat list of all `plain-list' type
elements in TREE that are not a sub-list themselves:
- \(org-element-map tree 'plain-list 'identity nil nil 'plain-list)
+ \(org-element-map tree 'plain-list #'identity nil nil 'plain-list)
Eventually, this example will return a flat list of all `bold'
type objects containing a `latex-snippet' type object, even
@@ -4164,112 +4049,98 @@ looking into captions:
\(org-element-map tree 'bold
\(lambda (b)
- \(and (org-element-map b 'latex-snippet 'identity nil t) b))
+ \(and (org-element-map b 'latex-snippet #'identity nil t) b))
nil nil nil t)"
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
- (unless (listp types) (setq types (list types)))
- (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
- ;; Recursion depth is determined by --CATEGORY.
- (let* ((--category
+ (let* ((types (if (listp types) types (list types)))
+ (no-recursion (if (listp no-recursion) no-recursion
+ (list no-recursion)))
+ ;; Recursion depth is determined by --CATEGORY.
+ (--category
(catch 'found
- (let ((category 'greater-elements))
- (mapc (lambda (type)
- (cond ((or (memq type org-element-all-objects)
- (eq type 'plain-text))
- ;; 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)))))
- types)
- category)))
- ;; Compute properties for affiliated keywords if necessary.
- (--affiliated-alist
- (and with-affiliated
- (mapcar (lambda (kwd)
- (cons kwd (intern (concat ":" (downcase kwd)))))
- org-element-affiliated-keywords)))
+ (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))
+ ((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
- (function
- (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)))
- (let ((sec-prop
- (assq --type org-element-secondary-value-alist)))
- (when sec-prop
- (funcall --walk-tree
- (org-element-property (cdr sec-prop) --data)))))
- ;; If --DATA has any 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))
- (mapc (lambda (kwd-pair)
- (let ((kwd (car kwd-pair))
- (value (org-element-property
- (cdr kwd-pair) --data)))
- ;; Pay attention to the type of value.
- ;; Preserve order for multiple keywords.
- (cond
- ((not value))
- ((and (member kwd org-element-multiple-keywords)
- (member kwd org-element-dual-keywords))
- (mapc (lambda (line)
- (funcall --walk-tree (cdr line))
- (funcall --walk-tree (car line)))
- (reverse value)))
- ((member kwd org-element-multiple-keywords)
- (mapc (lambda (line) (funcall --walk-tree line))
- (reverse value)))
- ((member kwd org-element-dual-keywords)
- (funcall --walk-tree (cdr value))
- (funcall --walk-tree (car value)))
- (t (funcall --walk-tree value)))))
- --affiliated-alist))
- ;; 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)))))))))))
+ (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.
@@ -4282,24 +4153,37 @@ looking into captions:
;; level.
;;
;; The second one, `org-element--parse-objects' applies on all objects
-;; of a paragraph or a secondary string. It uses
-;; `org-element--get-next-object-candidates' to optimize the search of
-;; the next object in the buffer.
-;;
-;; More precisely, that function looks for every allowed object type
-;; first. Then, it discards failed searches, keeps further matches,
-;; and searches again types matched behind point, for subsequent
-;; calls. Thus, searching for a given type fails only once, and every
-;; object is searched only once at top level (but sometimes more for
-;; nested types).
+;; of a paragraph or a secondary string. It calls
+;; `org-element--object-lex' to find the next object in the current
+;; container.
+
+(defsubst org-element--next-mode (type parentp)
+ "Return next special mode according to TYPE, or nil.
+TYPE is a symbol representing the type of an element or object
+containing next element if PARENTP is non-nil, or before it
+otherwise. Modes can be either `first-section', `item',
+`node-property', `planning', `property-drawer', `section',
+`table-row' or nil."
+ (if parentp
+ (case type
+ (headline 'section)
+ (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))))
(defun org-element--parse-elements
- (beg end special structure granularity visible-only acc)
+ (beg end mode structure granularity visible-only acc)
"Parse elements between BEG and END positions.
-SPECIAL prioritize some elements over the others. It can be set
-to `first-section', `quote-section', `section' `item' or
-`table-row'.
+MODE prioritizes some elements over the others. It can be set to
+`first-section', `section', `planning', `item', `node-property'
+or `table-row'.
When value is `item', STRUCTURE will be used as the current list
structure.
@@ -4325,7 +4209,7 @@ Elements are accumulated into ACC."
;; Find current element's type and parse it accordingly to
;; its category.
(let* ((element (org-element--current-element
- end granularity special structure))
+ end granularity mode structure))
(type (org-element-type element))
(cbeg (org-element-property :contents-begin element)))
(goto-char (org-element-property :end element))
@@ -4348,13 +4232,7 @@ Elements are accumulated into ACC."
(org-element--parse-elements
cbeg (org-element-property :contents-end element)
;; Possibly switch to a special mode.
- (case type
- (headline
- (if (org-element-property :quotedp element) 'quote-section
- 'section))
- (plain-list 'item)
- (property-drawer 'node-property)
- (table 'table-row))
+ (org-element--next-mode type t)
(and (memq type '(item plain-list))
(org-element-property :structure element))
granularity visible-only element))
@@ -4364,10 +4242,99 @@ Elements are accumulated into ACC."
(org-element--parse-objects
cbeg (org-element-property :contents-end element) element
(org-element-restriction type))))
- (org-element-adopt-elements acc element)))
+ (org-element-adopt-elements acc element)
+ ;; Update mode.
+ (setq mode (org-element--next-mode type nil))))
;; Return result.
acc))
+(defun org-element--object-lex (restriction)
+ "Return next object in current buffer or nil.
+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)
+ (while (and (not found)
+ (re-search-forward org-element--object-regexp limit t))
+ (goto-char (match-beginning 0))
+ (let ((result (match-string 0)))
+ (setq found
+ (cond
+ ((eq (compare-strings result nil nil "call_" nil nil t) t)
+ (and (memq 'inline-babel-call restriction)
+ (org-element-inline-babel-call-parser)))
+ ((eq (compare-strings result nil nil "src_" nil nil t) t)
+ (and (memq 'inline-src-block restriction)
+ (org-element-inline-src-block-parser)))
+ (t
+ (case (char-after)
+ (?^ (and (memq 'superscript restriction)
+ (org-element-superscript-parser)))
+ (?_ (or (and (memq 'subscript restriction)
+ (org-element-subscript-parser))
+ (and (memq 'underline restriction)
+ (org-element-underline-parser))))
+ (?* (and (memq 'bold restriction)
+ (org-element-bold-parser)))
+ (?/ (and (memq 'italic restriction)
+ (org-element-italic-parser)))
+ (?~ (and (memq 'code restriction)
+ (org-element-code-parser)))
+ (?= (and (memq 'verbatim restriction)
+ (org-element-verbatim-parser)))
+ (?+ (and (memq 'strike-through restriction)
+ (org-element-strike-through-parser)))
+ (?@ (and (memq 'export-snippet restriction)
+ (org-element-export-snippet-parser)))
+ (?{ (and (memq 'macro restriction)
+ (org-element-macro-parser)))
+ (?$ (and (memq 'latex-fragment restriction)
+ (org-element-latex-fragment-parser)))
+ (?<
+ (if (eq (aref result 1) ?<)
+ (or (and (memq 'radio-target restriction)
+ (org-element-radio-target-parser))
+ (and (memq 'target restriction)
+ (org-element-target-parser)))
+ (or (and (memq 'timestamp restriction)
+ (org-element-timestamp-parser))
+ (and (memq 'link restriction)
+ (org-element-link-parser)))))
+ (?\\
+ (if (eq (aref result 1) ?\\)
+ (and (memq 'line-break restriction)
+ (org-element-line-break-parser))
+ (or (and (memq 'entity restriction)
+ (org-element-entity-parser))
+ (and (memq 'latex-fragment restriction)
+ (org-element-latex-fragment-parser)))))
+ (?\[
+ (if (eq (aref result 1) ?\[)
+ (and (memq 'link restriction)
+ (org-element-link-parser))
+ (or (and (memq 'footnote-reference restriction)
+ (org-element-footnote-reference-parser))
+ (and (memq 'timestamp restriction)
+ (org-element-timestamp-parser))
+ (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)))))))
+ (or (eobp) (forward-char))))
+ (cond (found)
+ ;; Radio link.
+ ((and limit (memq 'link restriction))
+ (goto-char limit) (org-element-link-parser)))))))
+
(defun org-element--parse-objects (beg end acc restriction)
"Parse objects between BEG and END and return recursive structure.
@@ -4375,85 +4342,44 @@ Objects are accumulated in ACC.
RESTRICTION is a list of object successors which are allowed in
the current object."
- (let ((candidates 'initial))
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (let (next-object)
(while (and (not (eobp))
- (setq candidates
- (org-element--get-next-object-candidates
- restriction candidates)))
- (let ((next-object
- (let ((pos (apply 'min (mapcar 'cdr candidates))))
- (save-excursion
- (goto-char pos)
- (funcall (intern (format "org-element-%s-parser"
- (car (rassq pos candidates)))))))))
- ;; 1. Text before any object. Untabify it.
- (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 ((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))))
-
-(defun org-element--get-next-object-candidates (restriction objects)
- "Return an alist of candidates for the next object.
-
-RESTRICTION is a list of object types, as symbols. Only
-candidates with such types are looked after.
-
-OBJECTS is the previous candidates alist. If it is set to
-`initial', no search has been done before, and all symbols in
-RESTRICTION should be looked after.
-
-Return value is an alist whose CAR is the object type and CDR its
-beginning position."
- (delq
- nil
- (if (eq objects 'initial)
- ;; When searching for the first time, look for every successor
- ;; allowed in RESTRICTION.
- (mapcar
- (lambda (res)
- (funcall (intern (format "org-element-%s-successor" res))))
- restriction)
- ;; Focus on objects returned during last search. Keep those
- ;; still after point. Search again objects before it.
- (mapcar
- (lambda (obj)
- (if (>= (cdr obj) (point)) obj
- (let* ((type (car obj))
- (succ (or (cdr (assq type org-element-object-successor-alist))
- type)))
- (and succ
- (funcall (intern (format "org-element-%s-successor" succ)))))))
- objects))))
+ (setq next-object (org-element--object-lex restriction)))
+ ;; 1. Text before any object. Untabify it.
+ (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 ((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)))
@@ -4468,71 +4394,77 @@ beginning position."
;; `org-element--interpret-affiliated-keywords'.
;;;###autoload
-(defun org-element-interpret-data (data &optional parent)
+(defun org-element-interpret-data (data)
"Interpret DATA as Org syntax.
-
DATA is a parse tree, an element, an object or a secondary string
-to interpret.
+to interpret. Return Org syntax as a string."
+ (org-element--interpret-data-1 data nil))
-Optional argument PARENT is used for recursive calls. It contains
+(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 obj parent))
- data ""))
+ (lambda (obj) (org-element--interpret-data-1 obj parent)) data ""))
;; Full Org document.
((eq type 'org-data)
- (mapconcat
- (lambda (obj) (org-element-interpret-data obj parent))
- (org-element-contents data) ""))
+ (mapconcat (lambda (obj) (org-element--interpret-data-1 obj parent))
+ (org-element-contents data) ""))
;; Plain text: return it.
((stringp data) data)
- ;; Element/Object without contents.
- ((not (org-element-contents data))
- (funcall (intern (format "org-element-%s-interpreter" type))
- data nil))
- ;; Element/Object with contents.
+ ;; Element or object without contents.
+ ((not (org-element-contents data)) (funcall interpret data nil))
+ ;; Element or object with contents.
(t
- (let* ((greaterp (memq type org-element-greater-elements))
- (objectp (and (not greaterp)
- (memq type org-element-recursive-objects)))
- (contents
- (mapconcat
- (lambda (obj) (org-element-interpret-data obj data))
- (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 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))))))
- "")))
- (funcall (intern (format "org-element-%s-interpreter" type))
- data
- (if greaterp (org-element-normalize-contents contents)
- contents)))))))
+ (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 (memq type org-element-all-objects)
- (concat results (make-string post-blank 32))
+ (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 10)))))))
+ (make-string post-blank ?\n)))))))
(defun org-element--interpret-affiliated-keywords (element)
"Return ELEMENT's affiliated keywords as Org syntax.
@@ -4616,25 +4548,29 @@ indentation is not done with TAB characters."
(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 first
- ;; string hasn't been seen yet. It is required as this
- ;; string is the only one whose indentation doesn't happen
- ;; after a newline character.
+ ;; 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 (and first-flag (stringp object))
+ (when first-flag
(setq first-flag nil)
- (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)))))
+ ;; 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.
@@ -4644,41 +4580,1056 @@ indentation is not done with TAB characters."
;; string minus common indentation.
(let* (build ; For byte compiler.
(build
- (function
- (lambda (blob first-flag)
- ;; Return BLOB with all its strings indentation
- ;; shortened from MIN-IND white spaces. FIRST-FLAG
- ;; is non-nil when the first string hasn't been seen
- ;; yet.
- (setcdr (cdr blob)
- (mapcar
- #'(lambda (object)
- (when (and first-flag (stringp object))
- (setq first-flag nil)
- (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))
- (t object)))
- (org-element-contents blob)))
- blob))))
+ (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))))))
+;;; Cache
+;;
+;; Implement a caching mechanism for `org-element-at-point' and
+;; `org-element-context', which see.
+;;
+;; A single public function is provided: `org-element-cache-reset'.
+;;
+;; Cache is enabled by default, but can be disabled globally with
+;; `org-element-use-cache'. `org-element-cache-sync-idle-time',
+;; org-element-cache-sync-duration' and `org-element-cache-sync-break'
+;; can be tweaked to control caching behaviour.
+;;
+;; Internally, parsed elements are stored in an AVL tree,
+;; `org-element--cache'. This tree is updated lazily: whenever
+;; a change happens to the buffer, a synchronization request is
+;; registered in `org-element--cache-sync-requests' (see
+;; `org-element--cache-submit-request'). During idle time, requests
+;; are processed by `org-element--cache-sync'. Synchronization also
+;; happens when an element is required from the cache. In this case,
+;; the process stops as soon as the needed element is up-to-date.
+;;
+;; A synchronization request can only apply on a synchronized part of
+;; the cache. Therefore, the cache is updated at least to the
+;; location where the new request applies. Thus, requests are ordered
+;; from left to right and all elements starting before the first
+;; request are correct. This property is used by functions like
+;; `org-element--cache-find' to retrieve elements in the part of the
+;; cache that can be trusted.
+;;
+;; A request applies to every element, starting from its original
+;; location (or key, see below). When a request is processed, it
+;; moves forward and may collide the next one. In this case, both
+;; requests are merged into a new one that starts from that element.
+;; As a consequence, the whole synchronization complexity does not
+;; depend on the number of pending requests, but on the number of
+;; elements the very first request will be applied on.
+;;
+;; Elements cannot be accessed through their beginning position, which
+;; may or may not be up-to-date. Instead, each element in the tree is
+;; associated to a key, obtained with `org-element--cache-key'. This
+;; mechanism is robust enough to preserve total order among elements
+;; even when the tree is only partially synchronized.
+;;
+;; Objects contained in an element are stored in a hash table,
+;; `org-element--cache-objects'.
+
+
+(defvar org-element-use-cache t
+ "Non nil when Org parser should cache its results.
+This is mostly for debugging purpose.")
+
+(defvar org-element-cache-sync-idle-time 0.6
+ "Length, in seconds, of idle time before syncing cache.")
+
+(defvar org-element-cache-sync-duration (seconds-to-time 0.04)
+ "Maximum duration, as a time value, for a cache synchronization.
+If the synchronization is not over after this delay, the process
+pauses and resumes after `org-element-cache-sync-break'
+seconds.")
+
+(defvar org-element-cache-sync-break (seconds-to-time 0.3)
+ "Duration, as a time value, of the pause between synchronizations.
+See `org-element-cache-sync-duration' for more information.")
+
+
+;;;; Data Structure
+
+(defvar org-element--cache nil
+ "AVL tree used to cache elements.
+Each node of the tree contains an element. Comparison is done
+with `org-element--cache-compare'. This cache is used in
+`org-element-at-point'.")
+
+(defvar org-element--cache-objects nil
+ "Hash table used as to cache objects.
+Key is an element, as returned by `org-element-at-point', and
+value is an alist where each association is:
+
+ \(PARENT COMPLETEP . OBJECTS)
+
+where PARENT is an element or object, COMPLETEP is a boolean,
+non-nil when all direct children of parent are already cached and
+OBJECTS is a list of such children, as objects, from farthest to
+closest.
+
+In the following example, \\alpha, bold object and \\beta are
+contained within a paragraph
+
+ \\alpha *\\beta*
+
+If the paragraph is completely parsed, OBJECTS-DATA will be
+
+ \((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
+ \(BOLD-OBJECT t ENTITY-OBJECT))
+
+whereas in a partially parsed paragraph, it could be
+
+ \((PARAGRAPH nil ENTITY-OBJECT))
+
+This cache is used in `org-element-context'.")
+
+(defvar org-element--cache-sync-requests nil
+ "List of pending synchronization requests.
+
+A request is a vector with the following pattern:
+
+ \[NEXT BEG END OFFSET PARENT PHASE]
+
+Processing a synchronization request consists of three phases:
+
+ 0. Delete modified elements,
+ 1. Fill missing area in cache,
+ 2. Shift positions and re-parent elements after the changes.
+
+During phase 0, NEXT is the key of the first element to be
+removed, BEG and END is buffer position delimiting the
+modifications. Elements starting between them (inclusive) are
+removed. So are elements whose parent is removed. PARENT, when
+non-nil, is the parent of the first element to be removed.
+
+During phase 1, NEXT is the key of the next known element in
+cache and BEG its beginning position. Parse buffer between that
+element and the one before it in order to determine the parent of
+the next element. Set PARENT to the element containing NEXT.
+
+During phase 2, NEXT is the key of the next element to shift in
+the parse tree. All elements starting from this one have their
+properties relatives to buffer positions shifted by integer
+OFFSET and, if they belong to element PARENT, are adopted by it.
+
+PHASE specifies the phase number, as an integer.")
+
+(defvar org-element--cache-sync-timer nil
+ "Timer used for cache synchronization.")
+
+(defvar org-element--cache-sync-keys nil
+ "Hash table used to store keys during synchronization.
+See `org-element--cache-key' for more information.")
+
+(defsubst org-element--cache-key (element)
+ "Return a unique key for ELEMENT in cache tree.
+
+Keys are used to keep a total order among elements in the cache.
+Comparison is done with `org-element--cache-key-less-p'.
+
+When no synchronization is taking place, a key is simply the
+beginning position of the element, or that position plus one in
+the case of an first item (respectively row) in
+a list (respectively a table).
+
+During a synchronization, the key is the one the element had when
+the cache was synchronized for the last time. Elements added to
+cache during the synchronization get a new key generated with
+`org-element--cache-generate-key'.
+
+Such keys are stored in `org-element--cache-sync-keys'. The hash
+table is cleared once the synchronization is complete."
+ (or (gethash element org-element--cache-sync-keys)
+ (let* ((begin (org-element-property :begin element))
+ ;; Increase beginning position of items (respectively
+ ;; table rows) by one, so the first item can get
+ ;; a different key from its parent list (respectively
+ ;; table).
+ (key (if (memq (org-element-type element) '(item table-row))
+ (1+ begin)
+ begin)))
+ (if org-element--cache-sync-requests
+ (puthash element key org-element--cache-sync-keys)
+ key))))
+
+(defun org-element--cache-generate-key (lower upper)
+ "Generate a key between LOWER and UPPER.
+
+LOWER and UPPER are integers or lists, possibly empty.
+
+If LOWER and UPPER are equals, return LOWER. Otherwise, return
+a unique key, as an integer or a list of integers, according to
+the following rules:
+
+ - LOWER and UPPER are compared level-wise until values differ.
+
+ - If, at a given level, LOWER and UPPER differ from more than
+ 2, the new key shares all the levels above with LOWER and
+ gets a new level. Its value is the mean between LOWER and
+ UPPER:
+
+ \(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)
+
+ is equivalent to
+
+ \(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'.
+
+ - 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)
+
+ is equivalent to
+
+ \(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
+
+When they are not equals, the function assumes that LOWER is
+lesser than UPPER, per `org-element--cache-key-less-p'."
+ (if (equal lower upper) lower
+ (let ((lower (if (integerp lower) (list lower) lower))
+ (upper (if (integerp upper) (list upper) upper))
+ skip-upper key)
+ (catch 'exit
+ (while t
+ (let ((min (or (car lower) most-negative-fixnum))
+ (max (cond (skip-upper most-positive-fixnum)
+ ((car upper))
+ (t most-positive-fixnum))))
+ (if (< (1+ min) max)
+ (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1))))
+ (throw 'exit (if key (nreverse (cons mean key)) mean)))
+ (when (and (< min max) (not skip-upper))
+ ;; When at a given level, LOWER and UPPER differ from
+ ;; 1, ignore UPPER altogether. Instead create a key
+ ;; between LOWER and the greatest key with the same
+ ;; prefix as LOWER so far.
+ (setq skip-upper t))
+ (push min key)
+ (setq lower (cdr lower) upper (cdr upper)))))))))
+
+(defsubst org-element--cache-key-less-p (a b)
+ "Non-nil if key A is less than key B.
+A and B are either integers or lists of integers, as returned by
+`org-element--cache-key'."
+ (if (integerp a) (if (integerp b) (< a b) (<= a (car b)))
+ (if (integerp b) (< (car a) b)
+ (catch 'exit
+ (while (and a b)
+ (cond ((car-less-than-car a b) (throw 'exit t))
+ ((car-less-than-car b a) (throw 'exit nil))
+ (t (setq a (cdr a) b (cdr b)))))
+ ;; If A is empty, either keys are equal (B is also empty) and
+ ;; we return nil, or A is lesser than B (B is longer) and we
+ ;; return a non-nil value.
+ ;;
+ ;; If A is not empty, B is necessarily empty and A is greater
+ ;; than B (A is longer). Therefore, return nil.
+ (and (null a) b)))))
+
+(defun org-element--cache-compare (a b)
+ "Non-nil when element A is located before element B."
+ (org-element--cache-key-less-p (org-element--cache-key a)
+ (org-element--cache-key b)))
+
+(defsubst org-element--cache-root ()
+ "Return root value in cache.
+This function assumes `org-element--cache' is a valid AVL tree."
+ (avl-tree--node-left (avl-tree--dummyroot org-element--cache)))
+
+
+;;;; Tools
+
+(defsubst org-element--cache-active-p ()
+ "Non-nil when cache is active in current buffer."
+ (and org-element-use-cache
+ (or (derived-mode-p 'org-mode) orgstruct-mode)))
+
+(defun org-element--cache-find (pos &optional side)
+ "Find element in cache starting at POS or before.
+
+POS refers to a buffer position.
+
+When optional argument SIDE is non-nil, the function checks for
+elements starting at or past POS instead. If SIDE is `both', the
+function returns a cons cell where car is the first element
+starting at or before POS and cdr the first element starting
+after POS.
+
+The function can only find elements in the synchronized part of
+the cache."
+ (let ((limit (and org-element--cache-sync-requests
+ (aref (car org-element--cache-sync-requests) 0)))
+ (node (org-element--cache-root))
+ lower upper)
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (begin (org-element-property :begin element)))
+ (cond
+ ((and limit
+ (not (org-element--cache-key-less-p
+ (org-element--cache-key element) limit)))
+ (setq node (avl-tree--node-left node)))
+ ((> begin pos)
+ (setq upper element
+ node (avl-tree--node-left node)))
+ ((< begin pos)
+ (setq lower element
+ node (avl-tree--node-right node)))
+ ;; We found an element in cache starting at POS. If `side'
+ ;; is `both' we also want the next one in order to generate
+ ;; a key in-between.
+ ;;
+ ;; If the element is the first row or item in a table or
+ ;; a plain list, we always return the table or the plain
+ ;; list.
+ ;;
+ ;; In any other case, we return the element found.
+ ((eq side 'both)
+ (setq lower element)
+ (setq node (avl-tree--node-right node)))
+ ((and (memq (org-element-type element) '(item table-row))
+ (let ((parent (org-element-property :parent element)))
+ (and (= (org-element-property :begin element)
+ (org-element-property :contents-begin parent))
+ (setq node nil
+ lower parent
+ upper parent)))))
+ (t
+ (setq node nil
+ lower element
+ upper element)))))
+ (case side
+ (both (cons lower upper))
+ ((nil) lower)
+ (otherwise upper))))
+
+(defun org-element--cache-put (element &optional data)
+ "Store ELEMENT in current buffer's cache, if allowed.
+When optional argument DATA is non-nil, assume is it object data
+relative to ELEMENT and store it in the objects cache."
+ (cond ((not (org-element--cache-active-p)) nil)
+ ((not data)
+ (when org-element--cache-sync-requests
+ ;; During synchronization, first build an appropriate key
+ ;; for the new element so `avl-tree-enter' can insert it at
+ ;; the right spot in the cache.
+ (let ((keys (org-element--cache-find
+ (org-element-property :begin element) 'both)))
+ (puthash element
+ (org-element--cache-generate-key
+ (and (car keys) (org-element--cache-key (car keys)))
+ (cond ((cdr keys) (org-element--cache-key (cdr keys)))
+ (org-element--cache-sync-requests
+ (aref (car org-element--cache-sync-requests) 0))))
+ org-element--cache-sync-keys)))
+ (avl-tree-enter org-element--cache element))
+ ;; Headlines are not stored in cache, so objects in titles are
+ ;; not stored either.
+ ((eq (org-element-type element) 'headline) nil)
+ (t (puthash element data org-element--cache-objects))))
+
+(defsubst org-element--cache-remove (element)
+ "Remove ELEMENT from cache.
+Assume ELEMENT belongs to cache and that a cache is active."
+ (avl-tree-delete org-element--cache element)
+ (remhash element org-element--cache-objects))
+
+
+;;;; Synchronization
+
+(defsubst org-element--cache-set-timer (buffer)
+ "Set idle timer for cache synchronization in BUFFER."
+ (when org-element--cache-sync-timer
+ (cancel-timer org-element--cache-sync-timer))
+ (setq org-element--cache-sync-timer
+ (run-with-idle-timer
+ (let ((idle (current-idle-time)))
+ (if idle (time-add idle org-element-cache-sync-break)
+ org-element-cache-sync-idle-time))
+ nil
+ #'org-element--cache-sync
+ buffer)))
+
+(defsubst org-element--cache-interrupt-p (time-limit)
+ "Non-nil when synchronization process should be interrupted.
+TIME-LIMIT is a time value or nil."
+ (and time-limit
+ (or (input-pending-p)
+ (time-less-p time-limit (current-time)))))
+
+(defsubst org-element--cache-shift-positions (element offset &optional props)
+ "Shift ELEMENT properties relative to buffer positions by OFFSET.
+
+Properties containing buffer positions are `:begin', `:end',
+`:contents-begin', `:contents-end' and `:structure'. When
+optional argument PROPS is a list of keywords, only shift
+properties provided in that list.
+
+Properties are modified by side-effect."
+ (let ((properties (nth 1 element)))
+ ;; Shift `:structure' property for the first plain list only: it
+ ;; is the only one that really matters and it prevents from
+ ;; shifting it more than once.
+ (when (and (or (not props) (memq :structure props))
+ (eq (org-element-type element) 'plain-list)
+ (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)))
+ (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
+ (let ((value (and (or (not props) (memq key props))
+ (plist-get properties key))))
+ (and value (plist-put properties key (+ offset value)))))))
+
+(defun org-element--cache-sync (buffer &optional threshold future-change)
+ "Synchronize cache with recent modification in BUFFER.
+
+When optional argument THRESHOLD is non-nil, do the
+synchronization for all elements starting before or at threshold,
+then exit. Otherwise, synchronize cache for as long as
+`org-element-cache-sync-duration' or until Emacs leaves idle
+state.
+
+FUTURE-CHANGE, when non-nil, is a buffer position where changes
+not registered yet in the cache are going to happen. It is used
+in `org-element--cache-submit-request', where cache is partially
+updated before current modification are actually submitted."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (let ((inhibit-quit t) request next)
+ (when org-element--cache-sync-timer
+ (cancel-timer org-element--cache-sync-timer))
+ (catch 'interrupt
+ (while org-element--cache-sync-requests
+ (setq request (car org-element--cache-sync-requests)
+ next (nth 1 org-element--cache-sync-requests))
+ (org-element--cache-process-request
+ request
+ (and next (aref next 0))
+ threshold
+ (and (not threshold)
+ (time-add (current-time)
+ org-element-cache-sync-duration))
+ future-change)
+ ;; Request processed. Merge current and next offsets and
+ ;; transfer ending position.
+ (when next
+ (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))))
+ ;; If more requests are awaiting, set idle timer accordingly.
+ ;; Otherwise, reset keys.
+ (if org-element--cache-sync-requests
+ (org-element--cache-set-timer buffer)
+ (clrhash org-element--cache-sync-keys))))))
+
+(defun org-element--cache-process-request
+ (request next threshold time-limit future-change)
+ "Process synchronization REQUEST for all entries before NEXT.
+
+REQUEST is a vector, built by `org-element--cache-submit-request'.
+
+NEXT is a cache key, as returned by `org-element--cache-key'.
+
+When non-nil, THRESHOLD is a buffer position. Synchronization
+stops as soon as a shifted element begins after it.
+
+When non-nil, TIME-LIMIT is a time value. Synchronization stops
+after this time or when Emacs exits idle state.
+
+When non-nil, FUTURE-CHANGE is a buffer position where changes
+not registered yet in the cache are going to happen. See
+`org-element--cache-submit-request' for more information.
+
+Throw `interrupt' if the process stops before completing the
+request."
+ (catch 'quit
+ (when (= (aref request 5) 0)
+ ;; Phase 0.
+ ;;
+ ;; Delete all elements starting after BEG, but not after buffer
+ ;; position END or past element with key NEXT. Also delete
+ ;; elements contained within a previously removed element
+ ;; (stored in `last-container').
+ ;;
+ ;; At each iteration, we start again at tree root since
+ ;; a deletion modifies structure of the balanced tree.
+ (catch 'end-phase
+ (while t
+ (when (org-element--cache-interrupt-p time-limit)
+ (throw 'interrupt nil))
+ ;; Find first element in cache with key BEG or after it.
+ (let ((beg (aref request 0))
+ (end (aref request 2))
+ (node (org-element--cache-root))
+ data data-key last-container)
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (key (org-element--cache-key element)))
+ (cond
+ ((org-element--cache-key-less-p key beg)
+ (setq node (avl-tree--node-right node)))
+ ((org-element--cache-key-less-p beg key)
+ (setq data element
+ data-key key
+ node (avl-tree--node-left node)))
+ (t (setq data element
+ data-key key
+ node nil)))))
+ (if data
+ (let ((pos (org-element-property :begin data)))
+ (if (if (or (not next)
+ (org-element--cache-key-less-p data-key next))
+ (<= pos end)
+ (and last-container
+ (let ((up data))
+ (while (and up (not (eq up last-container)))
+ (setq up (org-element-property :parent up)))
+ up)))
+ (progn (when (and (not last-container)
+ (> (org-element-property :end data)
+ end))
+ (setq last-container data))
+ (org-element--cache-remove data))
+ (aset request 0 data-key)
+ (aset request 1 pos)
+ (aset request 5 1)
+ (throw 'end-phase nil)))
+ ;; No element starting after modifications left in
+ ;; cache: further processing is futile.
+ (throw 'quit t))))))
+ (when (= (aref request 5) 1)
+ ;; Phase 1.
+ ;;
+ ;; Phase 0 left a hole in the cache. Some elements after it
+ ;; could have parents within. For example, in the following
+ ;; buffer:
+ ;;
+ ;; - item
+ ;;
+ ;;
+ ;; Paragraph1
+ ;;
+ ;; Paragraph2
+ ;;
+ ;; if we remove a blank line between "item" and "Paragraph1",
+ ;; everything down to "Paragraph2" is removed from cache. But
+ ;; the paragraph now belongs to the list, and its `:parent'
+ ;; property no longer is accurate.
+ ;;
+ ;; Therefore we need to parse again elements in the hole, or at
+ ;; least in its last section, so that we can re-parent
+ ;; subsequent elements, during phase 2.
+ ;;
+ ;; Note that we only need to get the parent from the first
+ ;; element in cache after the hole.
+ ;;
+ ;; When next key is lesser or equal to the current one, delegate
+ ;; phase 1 processing to next request in order to preserve key
+ ;; order among requests.
+ (let ((key (aref request 0)))
+ (when (and next (not (org-element--cache-key-less-p key next)))
+ (let ((next-request (nth 1 org-element--cache-sync-requests)))
+ (aset next-request 0 key)
+ (aset next-request 1 (aref request 1))
+ (aset next-request 5 1))
+ (throw 'quit t)))
+ ;; Next element will start at its beginning position plus
+ ;; offset, since it hasn't been shifted yet. Therefore, LIMIT
+ ;; contains the real beginning position of the first element to
+ ;; shift and re-parent.
+ (let ((limit (+ (aref request 1) (aref request 3))))
+ (cond ((and threshold (> limit threshold)) (throw 'interrupt nil))
+ ((and future-change (>= limit future-change))
+ ;; Changes are going to happen around this element and
+ ;; they will trigger another phase 1 request. Skip the
+ ;; current one.
+ (aset request 5 2))
+ (t
+ (let ((parent (org-element--parse-to limit t time-limit)))
+ (aset request 4 parent)
+ (aset request 5 2))))))
+ ;; Phase 2.
+ ;;
+ ;; Shift all elements starting from key START, but before NEXT, by
+ ;; OFFSET, and re-parent them when appropriate.
+ ;;
+ ;; Elements are modified by side-effect so the tree structure
+ ;; remains intact.
+ ;;
+ ;; Once THRESHOLD, if any, is reached, or once there is an input
+ ;; pending, exit. Before leaving, the current synchronization
+ ;; request is updated.
+ (let ((start (aref request 0))
+ (offset (aref request 3))
+ (parent (aref request 4))
+ (node (org-element--cache-root))
+ (stack (list nil))
+ (leftp t)
+ exit-flag)
+ ;; No re-parenting nor shifting planned: request is over.
+ (when (and (not parent) (zerop offset)) (throw 'quit t))
+ (while node
+ (let* ((data (avl-tree--node-data node))
+ (key (org-element--cache-key data)))
+ (if (and leftp (avl-tree--node-left node)
+ (not (org-element--cache-key-less-p key start)))
+ (progn (push node stack)
+ (setq node (avl-tree--node-left node)))
+ (unless (org-element--cache-key-less-p key start)
+ ;; We reached NEXT. Request is complete.
+ (when (equal key next) (throw 'quit t))
+ ;; Handle interruption request. Update current request.
+ (when (or exit-flag (org-element--cache-interrupt-p time-limit))
+ (aset request 0 key)
+ (aset request 4 parent)
+ (throw 'interrupt nil))
+ ;; Shift element.
+ (unless (zerop offset)
+ (org-element--cache-shift-positions data offset)
+ ;; Shift associated objects data, if any.
+ (dolist (object-data (gethash data org-element--cache-objects))
+ (dolist (object (cddr object-data))
+ (org-element--cache-shift-positions object offset))))
+ (let ((begin (org-element-property :begin data)))
+ ;; Update PARENT and re-parent DATA, only when
+ ;; necessary. Propagate new structures for lists.
+ (while (and parent
+ (<= (org-element-property :end parent) begin))
+ (setq parent (org-element-property :parent parent)))
+ (cond ((and (not parent) (zerop offset)) (throw 'quit nil))
+ ((and parent
+ (let ((p (org-element-property :parent data)))
+ (or (not p)
+ (< (org-element-property :begin p)
+ (org-element-property :begin parent)))))
+ (org-element-put-property data :parent parent)
+ (let ((s (org-element-property :structure parent)))
+ (when (and s (org-element-property :structure data))
+ (org-element-put-property data :structure s)))))
+ ;; Cache is up-to-date past THRESHOLD. Request
+ ;; interruption.
+ (when (and threshold (> begin threshold)) (setq exit-flag t))))
+ (setq node (if (setq leftp (avl-tree--node-right node))
+ (avl-tree--node-right node)
+ (pop stack))))))
+ ;; We reached end of tree: synchronization complete.
+ t)))
+
+(defun org-element--parse-to (pos &optional syncp time-limit)
+ "Parse elements in current section, down to POS.
+
+Start parsing from the closest between the last known element in
+cache or headline above. Return the smallest element containing
+POS.
+
+When optional argument SYNCP is non-nil, return the parent of the
+element containing POS instead. In that case, it is also
+possible to provide TIME-LIMIT, which is a time value specifying
+when the parsing should stop. The function throws `interrupt' if
+the process stopped before finding the expected result."
+ (catch 'exit
+ (org-with-wide-buffer
+ (goto-char pos)
+ (let* ((cached (and (org-element--cache-active-p)
+ (org-element--cache-find pos nil)))
+ (begin (org-element-property :begin cached))
+ element next mode)
+ (cond
+ ;; Nothing in cache before point: start parsing from first
+ ;; element following headline above, or first element in
+ ;; buffer.
+ ((not cached)
+ (when (org-with-limited-levels (outline-previous-heading))
+ (setq mode 'planning)
+ (forward-line))
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line))
+ ;; Cache returned exact match: return it.
+ ((= pos begin)
+ (throw 'exit (if syncp (org-element-property :parent cached) cached)))
+ ;; There's a headline between cached value and POS: cached
+ ;; value is invalid. Start parsing from first element
+ ;; following the headline.
+ ((re-search-backward
+ (org-with-limited-levels org-outline-regexp-bol) begin t)
+ (forward-line)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (setq mode 'planning))
+ ;; Check if CACHED or any of its ancestors contain point.
+ ;;
+ ;; If there is such an element, we inspect it in order to know
+ ;; if we return it or if we need to parse its contents.
+ ;; Otherwise, we just start parsing from current location,
+ ;; which is right after the top-most element containing
+ ;; CACHED.
+ ;;
+ ;; As a special case, if POS is at the end of the buffer, we
+ ;; want to return the innermost element ending there.
+ ;;
+ ;; Also, if we find an ancestor and discover that we need to
+ ;; parse its contents, make sure we don't start from
+ ;; `:contents-begin', as we would otherwise go past CACHED
+ ;; again. Instead, in that situation, we will resume parsing
+ ;; from NEXT, which is located after CACHED or its higher
+ ;; ancestor not containing point.
+ (t
+ (let ((up cached)
+ (pos (if (= (point-max) pos) (1- pos) pos)))
+ (goto-char (or (org-element-property :contents-begin cached) begin))
+ (while (let ((end (org-element-property :end up)))
+ (and (<= end pos)
+ (goto-char end)
+ (setq up (org-element-property :parent up)))))
+ (cond ((not up))
+ ((eobp) (setq element up))
+ (t (setq element up next (point)))))))
+ ;; Parse successively each element until we reach POS.
+ (let ((end (or (org-element-property :end element)
+ (save-excursion
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ (parent element))
+ (while t
+ (when syncp
+ (cond ((= (point) pos) (throw 'exit parent))
+ ((org-element--cache-interrupt-p time-limit)
+ (throw 'interrupt nil))))
+ (unless element
+ (setq element (org-element--current-element
+ end 'element mode
+ (org-element-property :structure parent)))
+ (org-element-put-property element :parent parent)
+ (org-element--cache-put element))
+ (let ((elem-end (org-element-property :end element))
+ (type (org-element-type element)))
+ (cond
+ ;; Skip any element ending before point. Also skip
+ ;; element ending at point (unless it is also the end of
+ ;; buffer) since we're sure that another element begins
+ ;; after it.
+ ((and (<= elem-end pos) (/= (point-max) elem-end))
+ (goto-char elem-end)
+ (setq mode (org-element--next-mode type nil)))
+ ;; A non-greater element contains point: return it.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit element))
+ ;; Otherwise, we have to decide if ELEMENT really
+ ;; contains POS. In that case we start parsing from
+ ;; contents' beginning.
+ ;;
+ ;; If POS is at contents' beginning but it is also at
+ ;; the beginning of the first item in a list or a table.
+ ;; In that case, we need to create an anchor for that
+ ;; list or table, so return it.
+ ;;
+ ;; Also, if POS is at the end of the buffer, no element
+ ;; can start after it, but more than one may end there.
+ ;; Arbitrarily, we choose to return the innermost of
+ ;; such elements.
+ ((let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (when (or syncp
+ (and cbeg cend
+ (or (< cbeg pos)
+ (and (= cbeg pos)
+ (not (memq type '(plain-list table)))))
+ (or (> cend pos)
+ (and (= cend pos) (= (point-max) pos)))))
+ (goto-char (or next cbeg))
+ (setq next nil
+ mode (org-element--next-mode type t)
+ parent element
+ end cend))))
+ ;; Otherwise, return ELEMENT as it is the smallest
+ ;; element containing POS.
+ (t (throw 'exit element))))
+ (setq element nil)))))))
+
+
+;;;; Staging Buffer Changes
+
+(defconst org-element--cache-sensitive-re
+ (concat
+ org-outline-regexp-bol "\\|"
+ "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|"
+ "^[ \t]*\\(?:"
+ "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|"
+ "\\\\begin{[A-Za-z0-9*]+}" "\\|"
+ ":\\(?:\\w\\|[-_]\\)+:[ \t]*$"
+ "\\)")
+ "Regexp matching a sensitive line, structure wise.
+A sensitive line is a headline, inlinetask, block, drawer, or
+latex-environment boundary. When such a line is modified,
+structure changes in the document may propagate in the whole
+section, possibly making cache invalid.")
+
+(defvar org-element--cache-change-warning nil
+ "Non-nil when a sensitive line is about to be changed.
+It is a symbol among nil, t and `headline'.")
+
+(defun org-element--cache-before-change (beg end)
+ "Request extension of area going to be modified if needed.
+BEG and END are the beginning and end of the range of changed
+text. See `before-change-functions' for more information."
+ (when (org-element--cache-active-p)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((bottom (save-excursion (goto-char end) (line-end-position))))
+ (setq org-element--cache-change-warning
+ (save-match-data
+ (if (and (org-with-limited-levels (org-at-heading-p))
+ (= (line-end-position) bottom))
+ 'headline
+ (let ((case-fold-search t))
+ (re-search-forward
+ org-element--cache-sensitive-re bottom t)))))))))
+
+(defun org-element--cache-after-change (beg end pre)
+ "Update buffer modifications for current buffer.
+BEG and END are the beginning and end of the range of changed
+text, and the length in bytes of the pre-change text replaced by
+that range. See `after-change-functions' for more information."
+ (when (org-element--cache-active-p)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (save-match-data
+ (let ((top (point))
+ (bottom (save-excursion (goto-char end) (line-end-position))))
+ ;; Determine if modified area needs to be extended, according
+ ;; 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
+ (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))))
+ ;; Effectively extend modified area.
+ (org-with-limited-levels
+ (setq top (progn (goto-char top)
+ (when (outline-previous-heading) (forward-line))
+ (point)))
+ (setq bottom (progn (goto-char bottom)
+ (if (outline-next-heading) (1- (point))
+ (point))))))
+ ;; Store synchronization request.
+ (let ((offset (- end beg pre)))
+ (org-element--cache-submit-request top (- bottom offset) offset)))))
+ ;; Activate a timer to process the request during idle time.
+ (org-element--cache-set-timer (current-buffer))))
+
+(defun org-element--cache-for-removal (beg end offset)
+ "Return first element to remove from cache.
+
+BEG and END are buffer positions delimiting buffer modifications.
+OFFSET is the size of the changes.
+
+Returned element is usually the first element in cache containing
+any position between BEG and END. As an exception, greater
+elements around the changes that are robust to contents
+modifications are preserved and updated according to the
+changes."
+ (let* ((elements (org-element--cache-find (1- beg) 'both))
+ (before (car elements))
+ (after (cdr elements)))
+ (if (not before) after
+ (let ((up before)
+ (robust-flag t))
+ (while up
+ (if (let ((type (org-element-type up)))
+ (and (or (memq type '(center-block dynamic-block quote-block
+ special-block))
+ ;; Drawers named "PROPERTIES" are probably
+ ;; a properties drawer being edited. Force
+ ;; parsing to check if editing is over.
+ (and (eq type 'drawer)
+ (not (string=
+ (org-element-property :drawer-name up)
+ "PROPERTIES"))))
+ (let ((cbeg (org-element-property :contents-begin up)))
+ (and cbeg
+ (<= cbeg beg)
+ (> (org-element-property :contents-end up) end)))))
+ ;; UP is a robust greater element containing changes.
+ ;; We only need to extend its ending boundaries.
+ (org-element--cache-shift-positions
+ up offset '(:contents-end :end))
+ (setq before up)
+ (when robust-flag (setq robust-flag nil)))
+ (setq up (org-element-property :parent up)))
+ ;; We're at top level element containing ELEMENT: if it's
+ ;; altered by buffer modifications, it is first element in
+ ;; cache to be removed. Otherwise, that first element is the
+ ;; following one.
+ ;;
+ ;; As a special case, do not remove BEFORE if it is a robust
+ ;; container for current changes.
+ (if (or (< (org-element-property :end before) beg) robust-flag) after
+ before)))))
+
+(defun org-element--cache-submit-request (beg end offset)
+ "Submit a new cache synchronization request for current buffer.
+BEG and END are buffer positions delimiting the minimal area
+where cache data should be removed. OFFSET is the size of the
+change, as an integer."
+ (let ((next (car org-element--cache-sync-requests))
+ delete-to delete-from)
+ (if (and next
+ (zerop (aref next 5))
+ (> (setq delete-to (+ (aref next 2) (aref next 3))) end)
+ (<= (setq delete-from (aref next 1)) end))
+ ;; Current changes can be merged with first sync request: we
+ ;; can save a partial cache synchronization.
+ (progn
+ (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.
+ (if (> beg delete-from)
+ (let ((up (aref next 4)))
+ (while up
+ (org-element--cache-shift-positions
+ up offset '(:contents-end :end))
+ (setq up (org-element-property :parent up))))
+ (let ((first (org-element--cache-for-removal beg delete-to offset)))
+ (when first
+ (aset next 0 (org-element--cache-key first))
+ (aset next 1 (org-element-property :begin first))
+ (aset next 4 (org-element-property :parent first))))))
+ ;; Ensure cache is correct up to END. Also make sure that NEXT,
+ ;; if any, is no longer a 0-phase request, thus ensuring that
+ ;; phases are properly ordered. We need to provide OFFSET as
+ ;; optional parameter since current modifications are not known
+ ;; yet to the otherwise correct part of the cache (i.e, before
+ ;; the first request).
+ (when next (org-element--cache-sync (current-buffer) end beg))
+ (let ((first (org-element--cache-for-removal beg end offset)))
+ (if first
+ (push (let ((beg (org-element-property :begin first))
+ (key (org-element--cache-key first)))
+ (cond
+ ;; When changes happen before the first known
+ ;; element, re-parent and shift the rest of the
+ ;; cache.
+ ((> beg end) (vector key beg nil offset nil 1))
+ ;; Otherwise, we find the first non robust
+ ;; element containing END. All elements between
+ ;; FIRST and this one are to be removed.
+ ((let ((first-end (org-element-property :end first)))
+ (and (> first-end end)
+ (vector key beg first-end offset first 0))))
+ (t
+ (let* ((element (org-element--cache-find end))
+ (end (org-element-property :end element))
+ (up element))
+ (while (and (setq up (org-element-property :parent up))
+ (>= (org-element-property :begin up) beg))
+ (setq end (org-element-property :end up)
+ element up))
+ (vector key beg end offset element 0)))))
+ org-element--cache-sync-requests)
+ ;; 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)))))))
+
+
+;;;; Public Functions
+
+;;;###autoload
+(defun org-element-cache-reset (&optional all)
+ "Reset cache in current buffer.
+When optional argument ALL is non-nil, reset cache in all Org
+buffers."
+ (interactive "P")
+ (dolist (buffer (if all (buffer-list) (list (current-buffer))))
+ (with-current-buffer buffer
+ (when (org-element--cache-active-p)
+ (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)
+ (add-hook 'before-change-functions
+ #'org-element--cache-before-change nil t)
+ (add-hook 'after-change-functions
+ #'org-element--cache-after-change nil t)))))
+
+;;;###autoload
+(defun org-element-cache-refresh (pos)
+ "Refresh cache at position POS."
+ (when (org-element--cache-active-p)
+ (org-element--cache-sync (current-buffer) pos)
+ (org-element--cache-submit-request pos pos 0)
+ (org-element--cache-set-timer (current-buffer))))
+
+
+
;;; The Toolbox
;;
;; The first move is to implement a way to obtain the smallest element
;; containing point. This is the job of `org-element-at-point'. It
;; basically jumps back to the beginning of section containing point
-;; and moves, element after element, with
+;; and proceed, one element after the other, with
;; `org-element--current-element' until the container is found. Note:
;; When using `org-element-at-point', secondary values are never
;; parsed since the function focuses on elements, not on objects.
@@ -4689,8 +5640,9 @@ indentation is not done with TAB characters."
;; `org-element-nested-p' and `org-element-swap-A-B' may be used
;; internally by navigation and manipulation tools.
+
;;;###autoload
-(defun org-element-at-point (&optional keep-trail)
+(defun org-element-at-point ()
"Determine closest element around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -4701,118 +5653,36 @@ Possible types are defined in `org-element-all-elements'.
Properties depend on element or object type, but always include
`:begin', `:end', `:parent' and `:post-blank' properties.
-As a special case, if point is at the very beginning of a list or
-sub-list, returned element will be that list instead of the first
-item. In the same way, if point is at the beginning of the first
-row of a table, returned element will be the table instead of the
-first row.
-
-If optional argument KEEP-TRAIL is non-nil, the function returns
-a list of elements leading to element at point. The list's CAR
-is always the element at point. The following positions contain
-element's siblings, then parents, siblings of parents, until the
-first element of current section."
+As a special case, if point is at the very beginning of the first
+item in a list or sub-list, returned element will be that list
+instead of the item. Likewise, if point is at the beginning of
+the first row of a table, returned element will be the table
+instead of the first row.
+
+When point is at the end of the buffer, return the innermost
+element ending there."
(org-with-wide-buffer
- ;; If at a headline, parse it. It is the sole element that
- ;; doesn't require to know about context. Be sure to disallow
- ;; secondary string parsing, though.
- (if (org-with-limited-levels (org-at-heading-p))
- (progn
- (beginning-of-line)
- (if (not keep-trail) (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser (point-max) t))))
- ;; Otherwise move at the beginning of the section containing
- ;; point.
- (catch 'exit
- (let ((origin (point))
- (end (save-excursion
- (org-with-limited-levels (outline-next-heading)) (point)))
- element type special-flag trail struct prevs parent)
- (org-with-limited-levels
- (if (org-before-first-heading-p)
- ;; In empty lines at buffer's beginning, return nil.
- (progn (goto-char (point-min))
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- (throw 'exit nil)))
- (org-back-to-heading)
- (forward-line)
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- ;; In blank lines just after the headline, point still
- ;; belongs to the headline.
- (throw 'exit
- (progn (skip-chars-backward " \r\t\n")
- (beginning-of-line)
- (if (not keep-trail)
- (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser
- (point-max) t))))))))
- (beginning-of-line)
- ;; Parse successively each element, skipping those ending
- ;; before original position.
- (while t
- (setq element
- (org-element--current-element end 'element special-flag struct)
- type (car element))
- (org-element-put-property element :parent parent)
- (when keep-trail (push element trail))
- (cond
- ;; 1. Skip any element ending before point. Also skip
- ;; element ending at point when we're sure that another
- ;; element has started.
- ((let ((elem-end (org-element-property :end element)))
- (when (or (< elem-end origin)
- (and (= elem-end origin) (/= elem-end end)))
- (goto-char elem-end))))
- ;; 2. An element containing point is always the element at
- ;; point.
- ((not (memq type org-element-greater-elements))
- (throw 'exit (if keep-trail trail element)))
- ;; 3. At any other greater element type, if point is
- ;; within contents, move into it.
- (t
- (let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
- ;; Create an anchor for tables and plain lists:
- ;; when point is at the very beginning of these
- ;; elements, ignoring affiliated keywords,
- ;; target them instead of their contents.
- (and (= cbeg origin) (memq type '(plain-list table)))
- ;; When point is at contents end, do not move
- ;; into elements with an explicit ending, but
- ;; return that element instead.
- (and (= cend origin)
- (or (memq type
- '(center-block
- drawer dynamic-block inlinetask
- property-drawer quote-block
- special-block))
- ;; Corner case: if a list ends at the
- ;; end of a buffer without a final new
- ;; line, return last element in last
- ;; item instead.
- (and (memq type '(item plain-list))
- (progn (goto-char cend)
- (or (bolp) (not (eobp))))))))
- (throw 'exit (if keep-trail trail element))
- (setq parent element)
- (case type
- (plain-list
- (setq special-flag 'item
- struct (org-element-property :structure element)))
- (item (setq special-flag nil))
- (property-drawer
- (setq special-flag 'node-property struct nil))
- (table (setq special-flag 'table-row struct nil))
- (otherwise (setq special-flag nil struct nil)))
- (setq end cend)
- (goto-char cbeg)))))))))))
+ (let ((origin (point)))
+ (end-of-line)
+ (skip-chars-backward " \r\t\n")
+ (cond
+ ;; Within blank lines at the beginning of buffer, return nil.
+ ((bobp) nil)
+ ;; Within blank lines right after a headline, return that
+ ;; headline.
+ ((org-with-limited-levels (org-at-heading-p))
+ (beginning-of-line)
+ (org-element-headline-parser (point-max) t))
+ ;; Otherwise parse until we find element containing ORIGIN.
+ (t
+ (when (org-element--cache-active-p)
+ (if (not org-element--cache) (org-element-cache-reset)
+ (org-element--cache-sync (current-buffer) origin)))
+ (org-element--parse-to origin))))))
;;;###autoload
(defun org-element-context (&optional element)
- "Return closest element or object around point.
+ "Return smallest element or object around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element or object and PROPS a plist of properties
@@ -4823,34 +5693,36 @@ Possible types are defined in `org-element-all-elements' and
object type, but always include `:begin', `:end', `:parent' and
`:post-blank'.
+As a special case, if point is right after an object and not at
+the beginning of any other object, return that object.
+
Optional argument ELEMENT, when non-nil, is the closest element
containing point, as returned by `org-element-at-point'.
Providing it allows for quicker computation."
(catch 'objects-forbidden
(org-with-wide-buffer
- (let* ((origin (point))
- (element (or element (org-element-at-point)))
- (type (org-element-type element))
- context)
- ;; Check if point is inside an element containing objects or at
- ;; a secondary string. In that case, narrow buffer to the
- ;; containing area. Otherwise, return ELEMENT.
+ (let* ((pos (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element)))
+ ;; If point is inside an element containing objects or
+ ;; a secondary string, narrow buffer to the container and
+ ;; proceed with parsing. Otherwise, return ELEMENT.
(cond
;; At a parsed affiliated keyword, check if we're inside main
;; or dual value.
((let ((post (org-element-property :post-affiliated element)))
- (and post (< origin post)))
+ (and post (< pos post)))
(beginning-of-line)
(let ((case-fold-search t)) (looking-at org-element--affiliated-re))
(cond
((not (member-ignore-case (match-string 1)
org-element-parsed-keywords))
(throw 'objects-forbidden element))
- ((< (match-end 0) origin)
+ ((< (match-end 0) pos)
(narrow-to-region (match-end 0) (line-end-position)))
((and (match-beginning 2)
- (>= origin (match-beginning 2))
- (< origin (match-end 2)))
+ (>= pos (match-beginning 2))
+ (< pos (match-end 2)))
(narrow-to-region (match-beginning 2) (match-end 2)))
(t (throw 'objects-forbidden element)))
;; Also change type to retrieve correct restrictions.
@@ -4862,15 +5734,14 @@ Providing it allows for quicker computation."
(beginning-of-line)
(search-forward tag (line-end-position))
(goto-char (match-beginning 0))
- (if (and (>= origin (point)) (< origin (match-end 0)))
+ (if (and (>= pos (point)) (< pos (match-end 0)))
(narrow-to-region (point) (match-end 0))
(throw 'objects-forbidden element)))))
- ;; At an headline or inlinetask, objects are located within
- ;; their title.
+ ;; At an headline or inlinetask, objects are in title.
((memq type '(headline inlinetask))
(goto-char (org-element-property :begin element))
(skip-chars-forward "*")
- (if (and (> origin (point)) (< origin (line-end-position)))
+ (if (and (> pos (point)) (< pos (line-end-position)))
(narrow-to-region (point) (line-end-position))
(throw 'objects-forbidden element)))
;; At a paragraph, a table-row or a verse block, objects are
@@ -4879,67 +5750,142 @@ Providing it allows for quicker computation."
(let ((cbeg (org-element-property :contents-begin element))
(cend (org-element-property :contents-end element)))
;; CBEG is nil for table rules.
- (if (and cbeg cend (>= origin cbeg) (< origin cend))
+ (if (and cbeg cend (>= pos cbeg)
+ (or (< pos cend) (and (= pos cend) (eobp))))
(narrow-to-region cbeg cend)
(throw 'objects-forbidden element))))
- ;; At a parsed keyword, objects are located within value.
- ((eq type 'keyword)
- (if (not (member (org-element-property :key element)
- org-element-document-properties))
- (throw 'objects-forbidden element)
- (beginning-of-line)
- (search-forward ":")
- (if (and (>= origin (point)) (< origin (line-end-position)))
- (narrow-to-region (point) (line-end-position))
- (throw 'objects-forbidden element))))
;; At a planning line, if point is at a timestamp, return it,
;; otherwise, return element.
((eq type 'planning)
(dolist (p '(:closed :deadline :scheduled))
(let ((timestamp (org-element-property p element)))
(when (and timestamp
- (<= (org-element-property :begin timestamp) origin)
- (> (org-element-property :end timestamp) origin))
+ (<= (org-element-property :begin timestamp) pos)
+ (> (org-element-property :end timestamp) pos))
(throw 'objects-forbidden timestamp))))
+ ;; All other locations cannot contain objects: bail out.
(throw 'objects-forbidden element))
(t (throw 'objects-forbidden element)))
(goto-char (point-min))
(let ((restriction (org-element-restriction type))
- (parent element)
- (candidates 'initial))
- (catch 'exit
- (while (setq candidates
- (org-element--get-next-object-candidates
- restriction candidates))
- (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
- candidates)))
- ;; If ORIGIN is before next object in element, there's
- ;; no point in looking further.
- (if (> (cdr closest-cand) origin) (throw 'exit parent)
- (let* ((object
- (progn (goto-char (cdr closest-cand))
- (funcall (intern (format "org-element-%s-parser"
- (car closest-cand))))))
- (cbeg (org-element-property :contents-begin object))
- (cend (org-element-property :contents-end object))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin) (goto-char obj-end))
- ;; ORIGIN is within a non-recursive object or at
- ;; an object boundaries: Return that object.
- ((or (not cbeg) (< origin cbeg) (>= origin cend))
- (throw 'exit
- (org-element-put-property object :parent parent)))
- ;; Otherwise, move within current object and
- ;; restrict search to the end of its contents.
- (t (goto-char cbeg)
- (narrow-to-region (point) cend)
- (org-element-put-property object :parent parent)
- (setq parent object
- restriction (org-element-restriction object)
- candidates 'initial)))))))
- parent))))))
+ (parent element)
+ (cache (cond ((not (org-element--cache-active-p)) nil)
+ (org-element--cache-objects
+ (gethash element org-element--cache-objects))
+ (t (org-element-cache-reset) nil)))
+ next object-data last)
+ (prog1
+ (catch 'exit
+ (while t
+ ;; When entering PARENT for the first time, get list
+ ;; of objects within known so far. Store it in
+ ;; OBJECT-DATA.
+ (unless next
+ (let ((data (assq parent cache)))
+ (if data (setq object-data data)
+ (push (setq object-data (list parent nil)) cache))))
+ ;; Find NEXT object for analysis.
+ (catch 'found
+ ;; If NEXT is non-nil, we already exhausted the
+ ;; cache so we can parse buffer to find the object
+ ;; after it.
+ (if next (setq next (org-element--object-lex restriction))
+ ;; Otherwise, check if cache can help us.
+ (let ((objects (cddr object-data))
+ (completep (nth 1 object-data)))
+ (cond
+ ((and (not objects) completep) (throw 'exit parent))
+ ((not objects)
+ (setq next (org-element--object-lex restriction)))
+ (t
+ (let ((cache-limit
+ (org-element-property :end (car objects))))
+ (if (>= cache-limit pos)
+ ;; Cache contains the information needed.
+ (dolist (object objects (throw 'exit parent))
+ (when (<= (org-element-property :begin object)
+ pos)
+ (if (>= (org-element-property :end object)
+ pos)
+ (throw 'found (setq next object))
+ (throw 'exit parent))))
+ (goto-char cache-limit)
+ (setq next
+ (org-element--object-lex restriction))))))))
+ ;; If we have a new object to analyze, store it in
+ ;; cache. Otherwise record that there is nothing
+ ;; more to parse in this element at this depth.
+ (if next
+ (progn (org-element-put-property next :parent parent)
+ (push next (cddr object-data)))
+ (setcar (cdr object-data) t)))
+ ;; Process NEXT, if any, in order to know if we need
+ ;; to skip it, return it or move into it.
+ (if (or (not next) (> (org-element-property :begin next) pos))
+ (throw 'exit (or last parent))
+ (let ((end (org-element-property :end next))
+ (cbeg (org-element-property :contents-begin next))
+ (cend (org-element-property :contents-end next)))
+ (cond
+ ;; Skip objects ending before point. Also skip
+ ;; objects ending at point unless it is also the
+ ;; end of buffer, since we want to return the
+ ;; innermost object.
+ ((and (<= end pos) (/= (point-max) end))
+ (goto-char end)
+ ;; For convenience, when object ends at POS,
+ ;; without any space, store it in LAST, as we
+ ;; will return it if no object starts here.
+ (when (and (= end pos)
+ (not (memq (char-before) '(?\s ?\t))))
+ (setq last next)))
+ ;; If POS is within a container object, move
+ ;; into that object.
+ ((and cbeg cend
+ (>= pos cbeg)
+ (or (< pos cend)
+ ;; At contents' end, if there is no
+ ;; space before point, also move into
+ ;; object, for consistency with
+ ;; convenience feature above.
+ (and (= pos cend)
+ (or (= (point-max) pos)
+ (not (memq (char-before pos)
+ '(?\s ?\t)))))))
+ (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (setq parent next
+ restriction (org-element-restriction next)
+ next nil
+ object-data nil))
+ ;; Otherwise, return NEXT.
+ (t (throw 'exit next)))))))
+ ;; Store results in cache, if applicable.
+ (org-element--cache-put element cache)))))))
+
+(defun org-element-lineage (blob &optional types with-self)
+ "List all ancestors of a given element or object.
+
+BLOB is an object or element.
+
+When optional argument TYPES is a list of symbols, return the
+first element or object in the lineage whose type belongs to that
+list.
+
+When optional argument WITH-SELF is non-nil, lineage includes
+BLOB itself as the first element, and TYPES, if provided, also
+apply to it.
+
+When BLOB is obtained through `org-element-context' or
+`org-element-at-point', only ancestors from its section can be
+found. There is no such limitation when BLOB belongs to a full
+parse tree."
+ (let ((up (if with-self blob (org-element-property :parent blob)))
+ ancestors)
+ (while (and up (not (memq (org-element-type up) types)))
+ (unless types (push up ancestors))
+ (setq up (org-element-property :parent up)))
+ (if types up (nreverse ancestors))))
(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
@@ -4982,15 +5928,23 @@ end of ELEM-A."
(goto-char (org-element-property :end elem-B))
(skip-chars-backward " \r\t\n")
(point-at-eol)))
- ;; Store overlays responsible for visibility status. We
- ;; also need to store their boundaries as they will be
+ ;; Store inner overlays responsible for visibility status.
+ ;; We also need to store their boundaries as they will be
;; removed from buffer.
(overlays
(cons
- (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-A end-A))
- (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-B end-B))))
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-A)
+ (<= (overlay-end o) end-A)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-A end-A)))
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-B)
+ (<= (overlay-end o) end-B)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-B end-B)))))
;; Get contents.
(body-A (buffer-substring beg-A end-A))
(body-B (delete-and-extract-region beg-B end-B)))
@@ -5001,20 +5955,47 @@ end of ELEM-A."
(insert body-A)
;; Restore ex ELEM-A overlays.
(let ((offset (- beg-B beg-A)))
- (mapc (lambda (ov)
- (move-overlay
- (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset)))
- (car overlays))
+ (dolist (o (car overlays))
+ (move-overlay (car o) (+ (nth 1 o) offset) (+ (nth 2 o) offset)))
(goto-char beg-A)
(delete-region beg-A end-A)
(insert body-B)
;; Restore ex ELEM-B overlays.
- (mapc (lambda (ov)
- (move-overlay
- (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset)))
- (cdr overlays)))
+ (dolist (o (cdr overlays))
+ (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)
;; Local variables:
diff --git a/lisp/org-entities.el b/lisp/org-entities.el
index 6324a62..f0f7b54 100644
--- a/lisp/org-entities.el
+++ b/lisp/org-entities.el
@@ -1,6 +1,6 @@
;;; org-entities.el --- Support for special entities in Org-mode
-;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Ulf Stegemann <ulf at zeitform dot de>
@@ -38,13 +38,18 @@
:tag "Org Entities"
:group 'org)
-(defcustom org-entities-ascii-explanatory nil
- "Non-nil means replace special entities in ASCII.
-For example, this will replace \"\\nsup\" with \"[not a superset of]\"
-in backends where the corresponding character is not available."
- :group 'org-entities
- :version "24.1"
- :type 'boolean)
+(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)))))
(defcustom org-entities-user nil
"User-defined entities used in Org-mode to produce special characters.
@@ -53,15 +58,13 @@ of the entity that can be inserted into an Org file as \\name with the
appropriate replacements for the different export backends. The order
of the fields is the following
-name As a string, without the leading backslash
-LaTeX replacement In ready LaTeX, no further processing will take place
-LaTeX mathp A Boolean, either t or nil. t if this entity needs
- to be in math mode.
+name As a string, without the leading backslash.
+LaTeX replacement In ready LaTeX, no further processing will take place.
+LaTeX mathp Either t or nil. When t this entity needs to be in
+ math mode.
HTML replacement In ready HTML, no further processing will take place.
Usually this will be an &...; entity.
-ASCII replacement Plain ASCII, no extensions. Symbols that cannot be
- represented will be left as they are, but see the.
- variable `org-entities-ascii-explanatory'.
+ASCII replacement Plain ASCII, no extensions.
Latin1 replacement Use the special characters available in latin1.
utf-8 replacement Use the special characters available in utf-8.
@@ -77,439 +80,452 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
(string :tag "HTML ")
(string :tag "ASCII ")
(string :tag "Latin1")
- (string :tag "utf-8 "))))
+ (string :tag "utf-8 ")))
+ :safe #'org-entities--user-safe-p)
(defconst org-entities
- '(
- "* Letters"
- "** Latin"
- ("Agrave" "\\`{A}" nil "&Agrave;" "A" "À" "À")
- ("agrave" "\\`{a}" nil "&agrave;" "a" "à" "à")
- ("Aacute" "\\'{A}" nil "&Aacute;" "A" "Á" "Á")
- ("aacute" "\\'{a}" nil "&aacute;" "a" "á" "á")
- ("Acirc" "\\^{A}" nil "&Acirc;" "A" "Â" "Â")
- ("acirc" "\\^{a}" nil "&acirc;" "a" "â" "â")
- ("Atilde" "\\~{A}" nil "&Atilde;" "A" "Ã" "Ã")
- ("atilde" "\\~{a}" nil "&atilde;" "a" "ã" "ã")
- ("Auml" "\\\"{A}" nil "&Auml;" "Ae" "Ä" "Ä")
- ("auml" "\\\"{a}" nil "&auml;" "ae" "ä" "ä")
- ("Aring" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
- ("AA" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
- ("aring" "\\aa{}" nil "&aring;" "a" "å" "å")
- ("AElig" "\\AE{}" nil "&AElig;" "AE" "Æ" "Æ")
- ("aelig" "\\ae{}" nil "&aelig;" "ae" "æ" "æ")
- ("Ccedil" "\\c{C}" nil "&Ccedil;" "C" "Ç" "Ç")
- ("ccedil" "\\c{c}" nil "&ccedil;" "c" "ç" "ç")
- ("Egrave" "\\`{E}" nil "&Egrave;" "E" "È" "È")
- ("egrave" "\\`{e}" nil "&egrave;" "e" "è" "è")
- ("Eacute" "\\'{E}" nil "&Eacute;" "E" "É" "É")
- ("eacute" "\\'{e}" nil "&eacute;" "e" "é" "é")
- ("Ecirc" "\\^{E}" nil "&Ecirc;" "E" "Ê" "Ê")
- ("ecirc" "\\^{e}" nil "&ecirc;" "e" "ê" "ê")
- ("Euml" "\\\"{E}" nil "&Euml;" "E" "Ë" "Ë")
- ("euml" "\\\"{e}" nil "&euml;" "e" "ë" "ë")
- ("Igrave" "\\`{I}" nil "&Igrave;" "I" "Ì" "Ì")
- ("igrave" "\\`{i}" nil "&igrave;" "i" "ì" "ì")
- ("Iacute" "\\'{I}" nil "&Iacute;" "I" "Í" "Í")
- ("iacute" "\\'{i}" nil "&iacute;" "i" "í" "í")
- ("Icirc" "\\^{I}" nil "&Icirc;" "I" "Î" "Î")
- ("icirc" "\\^{i}" nil "&icirc;" "i" "î" "î")
- ("Iuml" "\\\"{I}" nil "&Iuml;" "I" "Ï" "Ï")
- ("iuml" "\\\"{i}" nil "&iuml;" "i" "ï" "ï")
- ("Ntilde" "\\~{N}" nil "&Ntilde;" "N" "Ñ" "Ñ")
- ("ntilde" "\\~{n}" nil "&ntilde;" "n" "ñ" "ñ")
- ("Ograve" "\\`{O}" nil "&Ograve;" "O" "Ò" "Ò")
- ("ograve" "\\`{o}" nil "&ograve;" "o" "ò" "ò")
- ("Oacute" "\\'{O}" nil "&Oacute;" "O" "Ó" "Ó")
- ("oacute" "\\'{o}" nil "&oacute;" "o" "ó" "ó")
- ("Ocirc" "\\^{O}" nil "&Ocirc;" "O" "Ô" "Ô")
- ("ocirc" "\\^{o}" nil "&ocirc;" "o" "ô" "ô")
- ("Otilde" "\\~{O}" nil "&Otilde;" "O" "Õ" "Õ")
- ("otilde" "\\~{o}" nil "&otilde;" "o" "õ" "õ")
- ("Ouml" "\\\"{O}" nil "&Ouml;" "Oe" "Ö" "Ö")
- ("ouml" "\\\"{o}" nil "&ouml;" "oe" "ö" "ö")
- ("Oslash" "\\O" nil "&Oslash;" "O" "Ø" "Ø")
- ("oslash" "\\o{}" nil "&oslash;" "o" "ø" "ø")
- ("OElig" "\\OE{}" nil "&OElig;" "OE" "OE" "Œ")
- ("oelig" "\\oe{}" nil "&oelig;" "oe" "oe" "œ")
- ("Scaron" "\\v{S}" nil "&Scaron;" "S" "S" "Š")
- ("scaron" "\\v{s}" nil "&scaron;" "s" "s" "š")
- ("szlig" "\\ss{}" nil "&szlig;" "ss" "ß" "ß")
- ("Ugrave" "\\`{U}" nil "&Ugrave;" "U" "Ù" "Ù")
- ("ugrave" "\\`{u}" nil "&ugrave;" "u" "ù" "ù")
- ("Uacute" "\\'{U}" nil "&Uacute;" "U" "Ú" "Ú")
- ("uacute" "\\'{u}" nil "&uacute;" "u" "ú" "ú")
- ("Ucirc" "\\^{U}" nil "&Ucirc;" "U" "Û" "Û")
- ("ucirc" "\\^{u}" nil "&ucirc;" "u" "û" "û")
- ("Uuml" "\\\"{U}" nil "&Uuml;" "Ue" "Ü" "Ü")
- ("uuml" "\\\"{u}" nil "&uuml;" "ue" "ü" "ü")
- ("Yacute" "\\'{Y}" nil "&Yacute;" "Y" "Ý" "Ý")
- ("yacute" "\\'{y}" nil "&yacute;" "y" "ý" "ý")
- ("Yuml" "\\\"{Y}" nil "&Yuml;" "Y" "Y" "Ÿ")
- ("yuml" "\\\"{y}" nil "&yuml;" "y" "ÿ" "ÿ")
-
- "** Latin (special face)"
- ("fnof" "\\textit{f}" nil "&fnof;" "f" "f" "ƒ")
- ("real" "\\Re" t "&real;" "R" "R" "ℜ")
- ("image" "\\Im" t "&image;" "I" "I" "ℑ")
- ("weierp" "\\wp" t "&weierp;" "P" "P" "℘")
- ("ell" "\\ell" t "&ell;" "ell" "ell" "ℓ")
- ("imath" "\\imath" t "&imath;" "[dotless i]" "dotless i" "ı")
- ("jmath" "\\jmath" t "&jmath;" "[dotless j]" "dotless j" "ȷ")
-
- "** Greek"
- ("Alpha" "A" nil "&Alpha;" "Alpha" "Alpha" "Α")
- ("alpha" "\\alpha" t "&alpha;" "alpha" "alpha" "α")
- ("Beta" "B" nil "&Beta;" "Beta" "Beta" "Β")
- ("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" "δ")
- ("Epsilon" "E" nil "&Epsilon;" "Epsilon" "Epsilon" "Ε")
- ("epsilon" "\\epsilon" t "&epsilon;" "epsilon" "epsilon" "ε")
- ("varepsilon" "\\varepsilon" t "&epsilon;" "varepsilon" "varepsilon" "ε")
- ("Zeta" "Z" nil "&Zeta;" "Zeta" "Zeta" "Ζ")
- ("zeta" "\\zeta" t "&zeta;" "zeta" "zeta" "ζ")
- ("Eta" "H" nil "&Eta;" "Eta" "Eta" "Η")
- ("eta" "\\eta" t "&eta;" "eta" "eta" "η")
- ("Theta" "\\Theta" t "&Theta;" "Theta" "Theta" "Θ")
- ("theta" "\\theta" t "&theta;" "theta" "theta" "θ")
- ("thetasym" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
- ("vartheta" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
- ("Iota" "I" nil "&Iota;" "Iota" "Iota" "Ι")
- ("iota" "\\iota" t "&iota;" "iota" "iota" "ι")
- ("Kappa" "K" nil "&Kappa;" "Kappa" "Kappa" "Κ")
- ("kappa" "\\kappa" t "&kappa;" "kappa" "kappa" "κ")
- ("Lambda" "\\Lambda" t "&Lambda;" "Lambda" "Lambda" "Λ")
- ("lambda" "\\lambda" t "&lambda;" "lambda" "lambda" "λ")
- ("Mu" "M" nil "&Mu;" "Mu" "Mu" "Μ")
- ("mu" "\\mu" t "&mu;" "mu" "mu" "μ")
- ("nu" "\\nu" t "&nu;" "nu" "nu" "ν")
- ("Nu" "N" nil "&Nu;" "Nu" "Nu" "Ν")
- ("Xi" "\\Xi" t "&Xi;" "Xi" "Xi" "Ξ")
- ("xi" "\\xi" t "&xi;" "xi" "xi" "ξ")
- ("Omicron" "O" nil "&Omicron;" "Omicron" "Omicron" "Ο")
- ("omicron" "\\textit{o}" nil "&omicron;" "omicron" "omicron" "ο")
- ("Pi" "\\Pi" t "&Pi;" "Pi" "Pi" "Π")
- ("pi" "\\pi" t "&pi;" "pi" "pi" "π")
- ("Rho" "P" nil "&Rho;" "Rho" "Rho" "Ρ")
- ("rho" "\\rho" t "&rho;" "rho" "rho" "ρ")
- ("Sigma" "\\Sigma" t "&Sigma;" "Sigma" "Sigma" "Σ")
- ("sigma" "\\sigma" t "&sigma;" "sigma" "sigma" "σ")
- ("sigmaf" "\\varsigma" t "&sigmaf;" "sigmaf" "sigmaf" "ς")
- ("varsigma" "\\varsigma" t "&sigmaf;" "varsigma" "varsigma" "ς")
- ("Tau" "T" nil "&Tau;" "Tau" "Tau" "Τ")
- ("Upsilon" "\\Upsilon" t "&Upsilon;" "Upsilon" "Upsilon" "Υ")
- ("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" "ɸ")
- ("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
- ("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
- ("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
- ("Psi" "\\Psi" t "&Psi;" "Psi" "Psi" "Ψ")
- ("psi" "\\psi" t "&psi;" "psi" "psi" "ψ")
- ("tau" "\\tau" t "&tau;" "tau" "tau" "τ")
- ("Omega" "\\Omega" t "&Omega;" "Omega" "Omega" "Ω")
- ("omega" "\\omega" t "&omega;" "omega" "omega" "ω")
- ("piv" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
- ("varpi" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
- ("partial" "\\partial" t "&part;" "[partial differential]" "[partial differential]" "∂")
-
- "** Hebrew"
- ("alefsym" "\\aleph" t "&alefsym;" "aleph" "aleph" "ℵ")
- ("aleph" "\\aleph" t "&aleph;" "aleph" "aleph" "ℵ")
- ("gimel" "\\gimel" t "&gimel;" "gimel" "gimel" "ℷ")
- ("beth" "\\beth" t "&beth;" "beth" "beth" "ב")
- ("dalet" "\\daleth" t "&daleth;" "dalet" "dalet" "ד")
-
- "** Dead languages"
- ("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
- ("eth" "\\dh{}" nil "&eth;" "dh" "ð" "ð")
- ("THORN" "\\TH{}" nil "&THORN;" "TH" "Þ" "Þ")
- ("thorn" "\\th{}" nil "&thorn;" "th" "þ" "þ")
-
- "* Punctuation"
- "** Dots and Marks"
- ("dots" "\\dots{}" nil "&hellip;" "..." "..." "…")
- ("cdots" "\\cdots{}" t "&ctdot;" "..." "..." "⋯")
- ("hellip" "\\dots{}" nil "&hellip;" "..." "..." "…")
- ("middot" "\\textperiodcentered{}" nil "&middot;" "." "·" "·")
- ("iexcl" "!`" nil "&iexcl;" "!" "¡" "¡")
- ("iquest" "?`" nil "&iquest;" "?" "¿" "¿")
-
- "** Dash-like"
- ("shy" "\\-" nil "&shy;" "" "" "")
- ("ndash" "--" nil "&ndash;" "-" "-" "–")
- ("mdash" "---" nil "&mdash;" "--" "--" "—")
-
- "** Quotations"
- ("quot" "\\textquotedbl{}" nil "&quot;" "\"" "\"" "\"")
- ("acute" "\\textasciiacute{}" nil "&acute;" "'" "´" "´")
- ("ldquo" "\\textquotedblleft{}" nil "&ldquo;" "\"" "\"" "“")
- ("rdquo" "\\textquotedblright{}" nil "&rdquo;" "\"" "\"" "”")
- ("bdquo" "\\quotedblbase{}" nil "&bdquo;" "\"" "\"" "„")
- ("lsquo" "\\textquoteleft{}" nil "&lsquo;" "`" "`" "‘")
- ("rsquo" "\\textquoteright{}" nil "&rsquo;" "'" "'" "’")
- ("sbquo" "\\quotesinglbase{}" nil "&sbquo;" "," "," "‚")
- ("laquo" "\\guillemotleft{}" nil "&laquo;" "<<" "«" "«")
- ("raquo" "\\guillemotright{}" nil "&raquo;" ">>" "»" "»")
- ("lsaquo" "\\guilsinglleft{}" nil "&lsaquo;" "<" "<" "‹")
- ("rsaquo" "\\guilsinglright{}" nil "&rsaquo;" ">" ">" "›")
-
- "* Other"
- "** Misc. (often used)"
- ("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
- ("vert" "\\vert{}" t "&vert;" "|" "|" "|")
- ("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
- ("S" "\\S" nil "&sect;" "paragraph" "§" "§")
- ("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
- ("amp" "\\&" nil "&amp;" "&" "&" "&")
- ("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
- ("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
- ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~")
- ("slash" "/" nil "/" "/" "/" "/")
- ("plus" "+" nil "+" "+" "+" "+")
- ("under" "\\_" nil "_" "_" "_" "_")
- ("equal" "=" nil "=" "=" "=" "=")
- ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
- ("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
- ("dag" "\\dag{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
- ("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
- ("ddag" "\\ddag{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
-
- "** Whitespace"
- ("nbsp" "~" nil "&nbsp;" " " " " " ")
- ("ensp" "\\hspace*{.5em}" nil "&ensp;" " " " " " ")
- ("emsp" "\\hspace*{1em}" nil "&emsp;" " " " " " ")
- ("thinsp" "\\hspace*{.2em}" nil "&thinsp;" " " " " " ")
-
- "** Currency"
- ("curren" "\\textcurrency{}" nil "&curren;" "curr." "¤" "¤")
- ("cent" "\\textcent{}" nil "&cent;" "cent" "¢" "¢")
- ("pound" "\\pounds{}" nil "&pound;" "pound" "£" "£")
- ("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥")
- ("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
- ("EUR" "\\EUR{}" nil "&euro;" "EUR" "EUR" "€")
- ("EURdig" "\\EURdig{}" nil "&euro;" "EUR" "EUR" "€")
- ("EURhv" "\\EURhv{}" nil "&euro;" "EUR" "EUR" "€")
- ("EURcr" "\\EURcr{}" nil "&euro;" "EUR" "EUR" "€")
- ("EURtm" "\\EURtm{}" nil "&euro;" "EUR" "EUR" "€")
-
- "** Property Marks"
- ("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©")
- ("reg" "\\textregistered{}" nil "&reg;" "(r)" "®" "®")
- ("trade" "\\texttrademark{}" nil "&trade;" "TM" "TM" "™")
-
- "** Science et al."
- ("minus" "\\minus" t "&minus;" "-" "-" "−")
- ("pm" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
- ("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
- ("times" "\\texttimes{}" nil "&times;" "*" "×" "×")
- ("frasl" "/" nil "&frasl;" "/" "/" "⁄")
- ("colon" "\\colon" t ":" ":" ":" ":")
- ("div" "\\textdiv{}" nil "&divide;" "/" "÷" "÷")
- ("frac12" "\\textonehalf{}" nil "&frac12;" "1/2" "½" "½")
- ("frac14" "\\textonequarter{}" nil "&frac14;" "1/4" "¼" "¼")
- ("frac34" "\\textthreequarters{}" nil "&frac34;" "3/4" "¾" "¾")
- ("permil" "\\textperthousand{}" nil "&permil;" "per thousand" "per thousand" "‰")
- ("sup1" "\\textonesuperior{}" nil "&sup1;" "^1" "¹" "¹")
- ("sup2" "\\texttwosuperior{}" nil "&sup2;" "^2" "²" "²")
- ("sup3" "\\textthreesuperior{}" nil "&sup3;" "^3" "³" "³")
- ("radic" "\\sqrt{\\,}" t "&radic;" "[square root]" "[square root]" "√")
- ("sum" "\\sum" t "&sum;" "[sum]" "[sum]" "∑")
- ("prod" "\\prod" t "&prod;" "[product]" "[n-ary product]" "∏")
- ("micro" "\\textmu{}" nil "&micro;" "micro" "µ" "µ")
- ("macr" "\\textasciimacron{}" nil "&macr;" "[macron]" "¯" "¯")
- ("deg" "\\textdegree{}" nil "&deg;" "degree" "°" "°")
- ("prime" "\\prime" t "&prime;" "'" "'" "′")
- ("Prime" "\\prime{}\\prime" t "&Prime;" "''" "''" "″")
- ("infin" "\\propto" t "&infin;" "[infinity]" "[infinity]" "∞")
- ("infty" "\\infty" t "&infin;" "[infinity]" "[infinity]" "∞")
- ("prop" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
- ("propto" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
- ("not" "\\textlnot{}" nil "&not;" "[angled dash]" "¬" "¬")
- ("neg" "\\neg{}" t "&not;" "[angled dash]" "¬" "¬")
- ("land" "\\land" t "&and;" "[logical and]" "[logical and]" "∧")
- ("wedge" "\\wedge" t "&and;" "[logical and]" "[logical and]" "∧")
- ("lor" "\\lor" t "&or;" "[logical or]" "[logical or]" "∨")
- ("vee" "\\vee" t "&or;" "[logical or]" "[logical or]" "∨")
- ("cap" "\\cap" t "&cap;" "[intersection]" "[intersection]" "∩")
- ("cup" "\\cup" t "&cup;" "[union]" "[union]" "∪")
- ("int" "\\int" t "&int;" "[integral]" "[integral]" "∫")
- ("therefore" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
- ("there4" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
- ("because" "\\because" t "&because;" "[because]" "[because]" "∵")
- ("sim" "\\sim" t "&sim;" "~" "~" "∼")
- ("cong" "\\cong" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
- ("simeq" "\\simeq" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
- ("asymp" "\\asymp" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
- ("approx" "\\approx" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
- ("ne" "\\ne" t "&ne;" "[not equal to]" "[not equal to]" "≠")
- ("neq" "\\neq" t "&ne;" "[not equal to]" "[not equal to]" "≠")
- ("equiv" "\\equiv" t "&equiv;" "[identical to]" "[identical to]" "≡")
-
- ("triangleq" "\\triangleq" t "&triangleq;" "[defined to]" "[defined to]" "≜")
- ("le" "\\le" t "&le;" "<=" "<=" "≤")
- ("leq" "\\le" t "&le;" "<=" "<=" "≤")
- ("ge" "\\ge" t "&ge;" ">=" ">=" "≥")
- ("geq" "\\ge" t "&ge;" ">=" ">=" "≥")
- ("lessgtr" "\\lessgtr" t "&lessgtr;" "[less than or greater than]" "[less than or greater than]" "≶")
- ("lesseqgtr" "\\lesseqgtr" t "&lesseqgtr;" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚")
- ("ll" "\\ll" t "&Lt;" "<<" "<<" "≪")
- ("Ll" "\lll" t "&Ll;" "<<<" "<<<" "⋘")
- ("lll" "\lll" t "&Ll;" "<<<" "<<<" "⋘")
- ("gg" "\\gg" t "&Gt;" ">>" ">>" "≫")
- ("Gg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
- ("ggg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
- ("prec" "\\prec" t "&pr;" "[precedes]" "[precedes]" "≺")
- ("preceq" "\\preceq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
- ("preccurlyeq" "\\preccurlyeq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
- ("succ" "\\succ" t "&sc;" "[succeeds]" "[succeeds]" "≻")
- ("succeq" "\\succeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
- ("succcurlyeq" "\\succcurlyeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
- ("sub" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
- ("subset" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
- ("sup" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
- ("supset" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
- ("nsub" "\\not\\subset" t "&nsub;" "[not a subset of]" "[not a subset of" "⊄")
- ("sube" "\\subseteq" t "&sube;" "[subset of or equal to]" "[subset of or equal to]" "⊆")
- ("nsup" "\\not\\supset" t "&nsup;" "[not a superset of]" "[not a superset of]" "⊅")
- ("supe" "\\supseteq" t "&supe;" "[superset of or equal to]" "[superset of or equal to]" "⊇")
- ("setminus" "\\setminus" t "&setminus;" "\" "\" "⧵")
- ("forall" "\\forall" t "&forall;" "[for all]" "[for all]" "∀")
- ("exist" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
- ("exists" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
- ("nexist" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
- ("nexists" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
- ("empty" "\\empty" t "&empty;" "[empty set]" "[empty set]" "∅")
- ("emptyset" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
- ("isin" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
- ("in" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
- ("notin" "\\notin" t "&notin;" "[not an element of]" "[not an element of]" "∉")
- ("ni" "\\ni" t "&ni;" "[contains as member]" "[contains as member]" "∋")
- ("nabla" "\\nabla" t "&nabla;" "[nabla]" "[nabla]" "∇")
- ("ang" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
- ("angle" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
- ("perp" "\\perp" t "&perp;" "[up tack]" "[up tack]" "⊥")
- ("sdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
- ("cdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
- ("lceil" "\\lceil" t "&lceil;" "[left ceiling]" "[left ceiling]" "⌈")
- ("rceil" "\\rceil" t "&rceil;" "[right ceiling]" "[right ceiling]" "⌉")
- ("lfloor" "\\lfloor" t "&lfloor;" "[left floor]" "[left floor]" "⌊")
- ("rfloor" "\\rfloor" t "&rfloor;" "[right floor]" "[right floor]" "⌋")
- ("lang" "\\langle" t "&lang;" "<" "<" "⟨")
- ("rang" "\\rangle" t "&rang;" ">" ">" "⟩")
- ("hbar" "\\hbar" t "&hbar;" "hbar" "hbar" "ℏ")
- ("mho" "\\mho" t "&mho;" "mho" "mho" "℧")
-
- "** Arrows"
- ("larr" "\\leftarrow" t "&larr;" "<-" "<-" "←")
- ("leftarrow" "\\leftarrow" t "&larr;" "<-" "<-" "←")
- ("gets" "\\gets" t "&larr;" "<-" "<-" "←")
- ("lArr" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
- ("Leftarrow" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
- ("uarr" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
- ("uparrow" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
- ("uArr" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
- ("Uparrow" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
- ("rarr" "\\rightarrow" t "&rarr;" "->" "->" "→")
- ("to" "\\to" t "&rarr;" "->" "->" "→")
- ("rightarrow" "\\rightarrow" t "&rarr;" "->" "->" "→")
- ("rArr" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
- ("Rightarrow" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
- ("darr" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
- ("downarrow" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
- ("dArr" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
- ("Downarrow" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
- ("harr" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
- ("leftrightarrow" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
- ("hArr" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
- ("Leftrightarrow" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
- ("crarr" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
- ("hookleftarrow" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
-
- "** Function names"
- ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos")
- ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin")
- ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan")
- ("arg" "\\arg" t "arg" "arg" "arg" "arg")
- ("cos" "\\cos" t "cos" "cos" "cos" "cos")
- ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh")
- ("cot" "\\cot" t "cot" "cot" "cot" "cot")
- ("coth" "\\coth" t "coth" "coth" "coth" "coth")
- ("csc" "\\csc" t "csc" "csc" "csc" "csc")
- ("deg" "\\deg" t "&deg;" "deg" "deg" "deg")
- ("det" "\\det" t "det" "det" "det" "det")
- ("dim" "\\dim" t "dim" "dim" "dim" "dim")
- ("exp" "\\exp" t "exp" "exp" "exp" "exp")
- ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd")
- ("hom" "\\hom" t "hom" "hom" "hom" "hom")
- ("inf" "\\inf" t "inf" "inf" "inf" "inf")
- ("ker" "\\ker" t "ker" "ker" "ker" "ker")
- ("lg" "\\lg" t "lg" "lg" "lg" "lg")
- ("lim" "\\lim" t "lim" "lim" "lim" "lim")
- ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf")
- ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup")
- ("ln" "\\ln" t "ln" "ln" "ln" "ln")
- ("log" "\\log" t "log" "log" "log" "log")
- ("max" "\\max" t "max" "max" "max" "max")
- ("min" "\\min" t "min" "min" "min" "min")
- ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr")
- ("sec" "\\sec" t "sec" "sec" "sec" "sec")
- ("sin" "\\sin" t "sin" "sin" "sin" "sin")
- ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh")
- ("sup" "\\sup" t "&sup;" "sup" "sup" "sup")
- ("tan" "\\tan" t "tan" "tan" "tan" "tan")
- ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh")
-
- "** Signs & Symbols"
- ("bull" "\\textbullet{}" nil "&bull;" "*" "*" "•")
- ("bullet" "\\textbullet{}" nil "&bull;" "*" "*" "•")
- ("star" "\\star" t "*" "*" "*" "⋆")
- ("lowast" "\\ast" t "&lowast;" "*" "*" "∗")
- ("ast" "\\ast" t "&lowast;" "*" "*" "*")
- ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ")
- ("oplus" "\\oplus" t "&oplus;" "[circled plus]" "[circled plus]" "⊕")
- ("otimes" "\\otimes" t "&otimes;" "[circled times]" "[circled times]" "⊗")
- ("check" "\\checkmark" t "&checkmark;" "[checkmark]" "[checkmark]" "✓")
- ("checkmark" "\\checkmark" t "&check;" "[checkmark]" "[checkmark]" "✓")
-
- "** Miscellaneous (seldom used)"
- ("para" "\\P{}" nil "&para;" "[pilcrow]" "¶" "¶")
- ("ordf" "\\textordfeminine{}" nil "&ordf;" "_a_" "ª" "ª")
- ("ordm" "\\textordmasculine{}" nil "&ordm;" "_o_" "º" "º")
- ("cedil" "\\c{}" nil "&cedil;" "[cedilla]" "¸" "¸")
- ("oline" "\\overline{~}" t "&oline;" "[overline]" "¯" "‾")
- ("uml" "\\textasciidieresis{}" nil "&uml;" "[diaeresis]" "¨" "¨")
- ("zwnj" "\\/{}" nil "&zwnj;" "" "" "‌")
- ("zwj" "" nil "&zwj;" "" "" "‍")
- ("lrm" "" nil "&lrm;" "" "" "‎")
- ("rlm" "" nil "&rlm;" "" "" "‏")
-
- "** Smilies"
- ("smile" "\\smile" t "&smile;" ":-)" ":-)" "⌣")
- ("frown" "\\frown" t "&frown;" ":-(" ":-(" "⌢")
- ("smiley" "\\smiley{}" nil "&#9786;" ":-)" ":-)" "☺")
- ("blacksmile" "\\blacksmiley{}" nil "&#9787;" ":-)" ":-)" "☻")
- ("sad" "\\frownie{}" nil "&#9785;" ":-(" ":-(" "☹")
-
- "** Suits"
- ("clubs" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
- ("clubsuit" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
- ("spades" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
- ("spadesuit" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
- ("hearts" "\\heartsuit" t "&hearts;" "[hearts]" "[hearts]" "♥")
- ("heartsuit" "\\heartsuit" t "&heartsuit;" "[hearts]" "[hearts]" "♥")
- ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
- ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
- ("diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
- ("Diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
- ("loz" "\\lozenge" t "&loz;" "[lozenge]" "[lozenge]" "⧫")
- )
- "Default entities used in Org-mode to produce special characters.
+ (append
+ '("* Letters"
+ "** Latin"
+ ("Agrave" "\\`{A}" nil "&Agrave;" "A" "À" "À")
+ ("agrave" "\\`{a}" nil "&agrave;" "a" "à" "à")
+ ("Aacute" "\\'{A}" nil "&Aacute;" "A" "Á" "Á")
+ ("aacute" "\\'{a}" nil "&aacute;" "a" "á" "á")
+ ("Acirc" "\\^{A}" nil "&Acirc;" "A" "Â" "Â")
+ ("acirc" "\\^{a}" nil "&acirc;" "a" "â" "â")
+ ("Atilde" "\\~{A}" nil "&Atilde;" "A" "Ã" "Ã")
+ ("atilde" "\\~{a}" nil "&atilde;" "a" "ã" "ã")
+ ("Auml" "\\\"{A}" nil "&Auml;" "Ae" "Ä" "Ä")
+ ("auml" "\\\"{a}" nil "&auml;" "ae" "ä" "ä")
+ ("Aring" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
+ ("AA" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
+ ("aring" "\\aa{}" nil "&aring;" "a" "å" "å")
+ ("AElig" "\\AE{}" nil "&AElig;" "AE" "Æ" "Æ")
+ ("aelig" "\\ae{}" nil "&aelig;" "ae" "æ" "æ")
+ ("Ccedil" "\\c{C}" nil "&Ccedil;" "C" "Ç" "Ç")
+ ("ccedil" "\\c{c}" nil "&ccedil;" "c" "ç" "ç")
+ ("Egrave" "\\`{E}" nil "&Egrave;" "E" "È" "È")
+ ("egrave" "\\`{e}" nil "&egrave;" "e" "è" "è")
+ ("Eacute" "\\'{E}" nil "&Eacute;" "E" "É" "É")
+ ("eacute" "\\'{e}" nil "&eacute;" "e" "é" "é")
+ ("Ecirc" "\\^{E}" nil "&Ecirc;" "E" "Ê" "Ê")
+ ("ecirc" "\\^{e}" nil "&ecirc;" "e" "ê" "ê")
+ ("Euml" "\\\"{E}" nil "&Euml;" "E" "Ë" "Ë")
+ ("euml" "\\\"{e}" nil "&euml;" "e" "ë" "ë")
+ ("Igrave" "\\`{I}" nil "&Igrave;" "I" "Ì" "Ì")
+ ("igrave" "\\`{i}" nil "&igrave;" "i" "ì" "ì")
+ ("Iacute" "\\'{I}" nil "&Iacute;" "I" "Í" "Í")
+ ("iacute" "\\'{i}" nil "&iacute;" "i" "í" "í")
+ ("Icirc" "\\^{I}" nil "&Icirc;" "I" "Î" "Î")
+ ("icirc" "\\^{i}" nil "&icirc;" "i" "î" "î")
+ ("Iuml" "\\\"{I}" nil "&Iuml;" "I" "Ï" "Ï")
+ ("iuml" "\\\"{i}" nil "&iuml;" "i" "ï" "ï")
+ ("Ntilde" "\\~{N}" nil "&Ntilde;" "N" "Ñ" "Ñ")
+ ("ntilde" "\\~{n}" nil "&ntilde;" "n" "ñ" "ñ")
+ ("Ograve" "\\`{O}" nil "&Ograve;" "O" "Ò" "Ò")
+ ("ograve" "\\`{o}" nil "&ograve;" "o" "ò" "ò")
+ ("Oacute" "\\'{O}" nil "&Oacute;" "O" "Ó" "Ó")
+ ("oacute" "\\'{o}" nil "&oacute;" "o" "ó" "ó")
+ ("Ocirc" "\\^{O}" nil "&Ocirc;" "O" "Ô" "Ô")
+ ("ocirc" "\\^{o}" nil "&ocirc;" "o" "ô" "ô")
+ ("Otilde" "\\~{O}" nil "&Otilde;" "O" "Õ" "Õ")
+ ("otilde" "\\~{o}" nil "&otilde;" "o" "õ" "õ")
+ ("Ouml" "\\\"{O}" nil "&Ouml;" "Oe" "Ö" "Ö")
+ ("ouml" "\\\"{o}" nil "&ouml;" "oe" "ö" "ö")
+ ("Oslash" "\\O" nil "&Oslash;" "O" "Ø" "Ø")
+ ("oslash" "\\o{}" nil "&oslash;" "o" "ø" "ø")
+ ("OElig" "\\OE{}" nil "&OElig;" "OE" "OE" "Œ")
+ ("oelig" "\\oe{}" nil "&oelig;" "oe" "oe" "œ")
+ ("Scaron" "\\v{S}" nil "&Scaron;" "S" "S" "Š")
+ ("scaron" "\\v{s}" nil "&scaron;" "s" "s" "š")
+ ("szlig" "\\ss{}" nil "&szlig;" "ss" "ß" "ß")
+ ("Ugrave" "\\`{U}" nil "&Ugrave;" "U" "Ù" "Ù")
+ ("ugrave" "\\`{u}" nil "&ugrave;" "u" "ù" "ù")
+ ("Uacute" "\\'{U}" nil "&Uacute;" "U" "Ú" "Ú")
+ ("uacute" "\\'{u}" nil "&uacute;" "u" "ú" "ú")
+ ("Ucirc" "\\^{U}" nil "&Ucirc;" "U" "Û" "Û")
+ ("ucirc" "\\^{u}" nil "&ucirc;" "u" "û" "û")
+ ("Uuml" "\\\"{U}" nil "&Uuml;" "Ue" "Ü" "Ü")
+ ("uuml" "\\\"{u}" nil "&uuml;" "ue" "ü" "ü")
+ ("Yacute" "\\'{Y}" nil "&Yacute;" "Y" "Ý" "Ý")
+ ("yacute" "\\'{y}" nil "&yacute;" "y" "ý" "ý")
+ ("Yuml" "\\\"{Y}" nil "&Yuml;" "Y" "Y" "Ÿ")
+ ("yuml" "\\\"{y}" nil "&yuml;" "y" "ÿ" "ÿ")
+
+ "** Latin (special face)"
+ ("fnof" "\\textit{f}" nil "&fnof;" "f" "f" "ƒ")
+ ("real" "\\Re" t "&real;" "R" "R" "ℜ")
+ ("image" "\\Im" t "&image;" "I" "I" "ℑ")
+ ("weierp" "\\wp" t "&weierp;" "P" "P" "℘")
+ ("ell" "\\ell" t "&ell;" "ell" "ell" "ℓ")
+ ("imath" "\\imath" t "&imath;" "[dotless i]" "dotless i" "ı")
+ ("jmath" "\\jmath" t "&jmath;" "[dotless j]" "dotless j" "ȷ")
+
+ "** Greek"
+ ("Alpha" "A" nil "&Alpha;" "Alpha" "Alpha" "Α")
+ ("alpha" "\\alpha" t "&alpha;" "alpha" "alpha" "α")
+ ("Beta" "B" nil "&Beta;" "Beta" "Beta" "Β")
+ ("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" "δ")
+ ("Epsilon" "E" nil "&Epsilon;" "Epsilon" "Epsilon" "Ε")
+ ("epsilon" "\\epsilon" t "&epsilon;" "epsilon" "epsilon" "ε")
+ ("varepsilon" "\\varepsilon" t "&epsilon;" "varepsilon" "varepsilon" "ε")
+ ("Zeta" "Z" nil "&Zeta;" "Zeta" "Zeta" "Ζ")
+ ("zeta" "\\zeta" t "&zeta;" "zeta" "zeta" "ζ")
+ ("Eta" "H" nil "&Eta;" "Eta" "Eta" "Η")
+ ("eta" "\\eta" t "&eta;" "eta" "eta" "η")
+ ("Theta" "\\Theta" t "&Theta;" "Theta" "Theta" "Θ")
+ ("theta" "\\theta" t "&theta;" "theta" "theta" "θ")
+ ("thetasym" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
+ ("vartheta" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
+ ("Iota" "I" nil "&Iota;" "Iota" "Iota" "Ι")
+ ("iota" "\\iota" t "&iota;" "iota" "iota" "ι")
+ ("Kappa" "K" nil "&Kappa;" "Kappa" "Kappa" "Κ")
+ ("kappa" "\\kappa" t "&kappa;" "kappa" "kappa" "κ")
+ ("Lambda" "\\Lambda" t "&Lambda;" "Lambda" "Lambda" "Λ")
+ ("lambda" "\\lambda" t "&lambda;" "lambda" "lambda" "λ")
+ ("Mu" "M" nil "&Mu;" "Mu" "Mu" "Μ")
+ ("mu" "\\mu" t "&mu;" "mu" "mu" "μ")
+ ("nu" "\\nu" t "&nu;" "nu" "nu" "ν")
+ ("Nu" "N" nil "&Nu;" "Nu" "Nu" "Ν")
+ ("Xi" "\\Xi" t "&Xi;" "Xi" "Xi" "Ξ")
+ ("xi" "\\xi" t "&xi;" "xi" "xi" "ξ")
+ ("Omicron" "O" nil "&Omicron;" "Omicron" "Omicron" "Ο")
+ ("omicron" "\\textit{o}" nil "&omicron;" "omicron" "omicron" "ο")
+ ("Pi" "\\Pi" t "&Pi;" "Pi" "Pi" "Π")
+ ("pi" "\\pi" t "&pi;" "pi" "pi" "π")
+ ("Rho" "P" nil "&Rho;" "Rho" "Rho" "Ρ")
+ ("rho" "\\rho" t "&rho;" "rho" "rho" "ρ")
+ ("Sigma" "\\Sigma" t "&Sigma;" "Sigma" "Sigma" "Σ")
+ ("sigma" "\\sigma" t "&sigma;" "sigma" "sigma" "σ")
+ ("sigmaf" "\\varsigma" t "&sigmaf;" "sigmaf" "sigmaf" "ς")
+ ("varsigma" "\\varsigma" t "&sigmaf;" "varsigma" "varsigma" "ς")
+ ("Tau" "T" nil "&Tau;" "Tau" "Tau" "Τ")
+ ("Upsilon" "\\Upsilon" t "&Upsilon;" "Upsilon" "Upsilon" "Υ")
+ ("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" "ɸ")
+ ("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
+ ("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
+ ("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
+ ("Psi" "\\Psi" t "&Psi;" "Psi" "Psi" "Ψ")
+ ("psi" "\\psi" t "&psi;" "psi" "psi" "ψ")
+ ("tau" "\\tau" t "&tau;" "tau" "tau" "τ")
+ ("Omega" "\\Omega" t "&Omega;" "Omega" "Omega" "Ω")
+ ("omega" "\\omega" t "&omega;" "omega" "omega" "ω")
+ ("piv" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
+ ("varpi" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
+ ("partial" "\\partial" t "&part;" "[partial differential]" "[partial differential]" "∂")
+
+ "** Hebrew"
+ ("alefsym" "\\aleph" t "&alefsym;" "aleph" "aleph" "ℵ")
+ ("aleph" "\\aleph" t "&aleph;" "aleph" "aleph" "ℵ")
+ ("gimel" "\\gimel" t "&gimel;" "gimel" "gimel" "ℷ")
+ ("beth" "\\beth" t "&beth;" "beth" "beth" "ב")
+ ("dalet" "\\daleth" t "&daleth;" "dalet" "dalet" "ד")
+
+ "** Dead languages"
+ ("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
+ ("eth" "\\dh{}" nil "&eth;" "dh" "ð" "ð")
+ ("THORN" "\\TH{}" nil "&THORN;" "TH" "Þ" "Þ")
+ ("thorn" "\\th{}" nil "&thorn;" "th" "þ" "þ")
+
+ "* Punctuation"
+ "** Dots and Marks"
+ ("dots" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("cdots" "\\cdots{}" t "&ctdot;" "..." "..." "⋯")
+ ("hellip" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("middot" "\\textperiodcentered{}" nil "&middot;" "." "·" "·")
+ ("iexcl" "!`" nil "&iexcl;" "!" "¡" "¡")
+ ("iquest" "?`" nil "&iquest;" "?" "¿" "¿")
+
+ "** Dash-like"
+ ("shy" "\\-" nil "&shy;" "" "" "")
+ ("ndash" "--" nil "&ndash;" "-" "-" "–")
+ ("mdash" "---" nil "&mdash;" "--" "--" "—")
+
+ "** Quotations"
+ ("quot" "\\textquotedbl{}" nil "&quot;" "\"" "\"" "\"")
+ ("acute" "\\textasciiacute{}" nil "&acute;" "'" "´" "´")
+ ("ldquo" "\\textquotedblleft{}" nil "&ldquo;" "\"" "\"" "“")
+ ("rdquo" "\\textquotedblright{}" nil "&rdquo;" "\"" "\"" "”")
+ ("bdquo" "\\quotedblbase{}" nil "&bdquo;" "\"" "\"" "„")
+ ("lsquo" "\\textquoteleft{}" nil "&lsquo;" "`" "`" "‘")
+ ("rsquo" "\\textquoteright{}" nil "&rsquo;" "'" "'" "’")
+ ("sbquo" "\\quotesinglbase{}" nil "&sbquo;" "," "," "‚")
+ ("laquo" "\\guillemotleft{}" nil "&laquo;" "<<" "«" "«")
+ ("raquo" "\\guillemotright{}" nil "&raquo;" ">>" "»" "»")
+ ("lsaquo" "\\guilsinglleft{}" nil "&lsaquo;" "<" "<" "‹")
+ ("rsaquo" "\\guilsinglright{}" nil "&rsaquo;" ">" ">" "›")
+
+ "* Other"
+ "** Misc. (often used)"
+ ("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
+ ("vert" "\\vert{}" t "&vert;" "|" "|" "|")
+ ("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
+ ("S" "\\S" nil "&sect;" "paragraph" "§" "§")
+ ("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
+ ("amp" "\\&" nil "&amp;" "&" "&" "&")
+ ("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
+ ("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
+ ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~")
+ ("slash" "/" nil "/" "/" "/" "/")
+ ("plus" "+" nil "+" "+" "+" "+")
+ ("under" "\\_" nil "_" "_" "_" "_")
+ ("equal" "=" nil "=" "=" "=" "=")
+ ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
+ ("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
+ ("dag" "\\dag{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
+ ("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
+ ("ddag" "\\ddag{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
+
+ "** Whitespace"
+ ("nbsp" "~" nil "&nbsp;" " " " " " ")
+ ("ensp" "\\hspace*{.5em}" nil "&ensp;" " " " " " ")
+ ("emsp" "\\hspace*{1em}" nil "&emsp;" " " " " " ")
+ ("thinsp" "\\hspace*{.2em}" nil "&thinsp;" " " " " " ")
+
+ "** Currency"
+ ("curren" "\\textcurrency{}" nil "&curren;" "curr." "¤" "¤")
+ ("cent" "\\textcent{}" nil "&cent;" "cent" "¢" "¢")
+ ("pound" "\\pounds{}" nil "&pound;" "pound" "£" "£")
+ ("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥")
+ ("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
+ ("EUR" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
+
+ "** Property Marks"
+ ("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©")
+ ("reg" "\\textregistered{}" nil "&reg;" "(r)" "®" "®")
+ ("trade" "\\texttrademark{}" nil "&trade;" "TM" "TM" "™")
+
+ "** Science et al."
+ ("minus" "\\minus" t "&minus;" "-" "-" "−")
+ ("pm" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
+ ("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
+ ("times" "\\texttimes{}" nil "&times;" "*" "×" "×")
+ ("frasl" "/" nil "&frasl;" "/" "/" "⁄")
+ ("colon" "\\colon" t ":" ":" ":" ":")
+ ("div" "\\textdiv{}" nil "&divide;" "/" "÷" "÷")
+ ("frac12" "\\textonehalf{}" nil "&frac12;" "1/2" "½" "½")
+ ("frac14" "\\textonequarter{}" nil "&frac14;" "1/4" "¼" "¼")
+ ("frac34" "\\textthreequarters{}" nil "&frac34;" "3/4" "¾" "¾")
+ ("permil" "\\textperthousand{}" nil "&permil;" "per thousand" "per thousand" "‰")
+ ("sup1" "\\textonesuperior{}" nil "&sup1;" "^1" "¹" "¹")
+ ("sup2" "\\texttwosuperior{}" nil "&sup2;" "^2" "²" "²")
+ ("sup3" "\\textthreesuperior{}" nil "&sup3;" "^3" "³" "³")
+ ("radic" "\\sqrt{\\,}" t "&radic;" "[square root]" "[square root]" "√")
+ ("sum" "\\sum" t "&sum;" "[sum]" "[sum]" "∑")
+ ("prod" "\\prod" t "&prod;" "[product]" "[n-ary product]" "∏")
+ ("micro" "\\textmu{}" nil "&micro;" "micro" "µ" "µ")
+ ("macr" "\\textasciimacron{}" nil "&macr;" "[macron]" "¯" "¯")
+ ("deg" "\\textdegree{}" nil "&deg;" "degree" "°" "°")
+ ("prime" "\\prime" t "&prime;" "'" "'" "′")
+ ("Prime" "\\prime{}\\prime" t "&Prime;" "''" "''" "″")
+ ("infin" "\\propto" t "&infin;" "[infinity]" "[infinity]" "∞")
+ ("infty" "\\infty" t "&infin;" "[infinity]" "[infinity]" "∞")
+ ("prop" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
+ ("propto" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
+ ("not" "\\textlnot{}" nil "&not;" "[angled dash]" "¬" "¬")
+ ("neg" "\\neg{}" t "&not;" "[angled dash]" "¬" "¬")
+ ("land" "\\land" t "&and;" "[logical and]" "[logical and]" "∧")
+ ("wedge" "\\wedge" t "&and;" "[logical and]" "[logical and]" "∧")
+ ("lor" "\\lor" t "&or;" "[logical or]" "[logical or]" "∨")
+ ("vee" "\\vee" t "&or;" "[logical or]" "[logical or]" "∨")
+ ("cap" "\\cap" t "&cap;" "[intersection]" "[intersection]" "∩")
+ ("cup" "\\cup" t "&cup;" "[union]" "[union]" "∪")
+ ("smile" "\\smile" t "&smile;" "[cup product]" "[cup product]" "⌣")
+ ("frown" "\\frown" t "&frown;" "[Cap product]" "[cap product]" "⌢")
+ ("int" "\\int" t "&int;" "[integral]" "[integral]" "∫")
+ ("therefore" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
+ ("there4" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
+ ("because" "\\because" t "&because;" "[because]" "[because]" "∵")
+ ("sim" "\\sim" t "&sim;" "~" "~" "∼")
+ ("cong" "\\cong" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
+ ("simeq" "\\simeq" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
+ ("asymp" "\\asymp" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
+ ("approx" "\\approx" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
+ ("ne" "\\ne" t "&ne;" "[not equal to]" "[not equal to]" "≠")
+ ("neq" "\\neq" t "&ne;" "[not equal to]" "[not equal to]" "≠")
+ ("equiv" "\\equiv" t "&equiv;" "[identical to]" "[identical to]" "≡")
+
+ ("triangleq" "\\triangleq" t "&triangleq;" "[defined to]" "[defined to]" "≜")
+ ("le" "\\le" t "&le;" "<=" "<=" "≤")
+ ("leq" "\\le" t "&le;" "<=" "<=" "≤")
+ ("ge" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("geq" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("lessgtr" "\\lessgtr" t "&lessgtr;" "[less than or greater than]" "[less than or greater than]" "≶")
+ ("lesseqgtr" "\\lesseqgtr" t "&lesseqgtr;" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚")
+ ("ll" "\\ll" t "&Lt;" "<<" "<<" "≪")
+ ("Ll" "\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("lll" "\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("gg" "\\gg" t "&Gt;" ">>" ">>" "≫")
+ ("Gg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("ggg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("prec" "\\prec" t "&pr;" "[precedes]" "[precedes]" "≺")
+ ("preceq" "\\preceq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("preccurlyeq" "\\preccurlyeq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("succ" "\\succ" t "&sc;" "[succeeds]" "[succeeds]" "≻")
+ ("succeq" "\\succeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
+ ("succcurlyeq" "\\succcurlyeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
+ ("sub" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
+ ("subset" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
+ ("sup" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
+ ("supset" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
+ ("nsub" "\\not\\subset" t "&nsub;" "[not a subset of]" "[not a subset of" "⊄")
+ ("sube" "\\subseteq" t "&sube;" "[subset of or equal to]" "[subset of or equal to]" "⊆")
+ ("nsup" "\\not\\supset" t "&nsup;" "[not a superset of]" "[not a superset of]" "⊅")
+ ("supe" "\\supseteq" t "&supe;" "[superset of or equal to]" "[superset of or equal to]" "⊇")
+ ("setminus" "\\setminus" t "&setminus;" "\" "\" "⧵")
+ ("forall" "\\forall" t "&forall;" "[for all]" "[for all]" "∀")
+ ("exist" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
+ ("exists" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
+ ("nexist" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
+ ("nexists" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
+ ("empty" "\\empty" t "&empty;" "[empty set]" "[empty set]" "∅")
+ ("emptyset" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
+ ("isin" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
+ ("in" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
+ ("notin" "\\notin" t "&notin;" "[not an element of]" "[not an element of]" "∉")
+ ("ni" "\\ni" t "&ni;" "[contains as member]" "[contains as member]" "∋")
+ ("nabla" "\\nabla" t "&nabla;" "[nabla]" "[nabla]" "∇")
+ ("ang" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
+ ("angle" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
+ ("perp" "\\perp" t "&perp;" "[up tack]" "[up tack]" "⊥")
+ ("parallel" "\\parallel" t "&parallel;" "||" "||" "∥")
+ ("sdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
+ ("cdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
+ ("lceil" "\\lceil" t "&lceil;" "[left ceiling]" "[left ceiling]" "⌈")
+ ("rceil" "\\rceil" t "&rceil;" "[right ceiling]" "[right ceiling]" "⌉")
+ ("lfloor" "\\lfloor" t "&lfloor;" "[left floor]" "[left floor]" "⌊")
+ ("rfloor" "\\rfloor" t "&rfloor;" "[right floor]" "[right floor]" "⌋")
+ ("lang" "\\langle" t "&lang;" "<" "<" "⟨")
+ ("rang" "\\rangle" t "&rang;" ">" ">" "⟩")
+ ("langle" "\\langle" t "&lang;" "<" "<" "⟨")
+ ("rangle" "\\rangle" t "&rang;" ">" ">" "⟩")
+ ("hbar" "\\hbar" t "&hbar;" "hbar" "hbar" "ℏ")
+ ("mho" "\\mho" t "&mho;" "mho" "mho" "℧")
+
+ "** Arrows"
+ ("larr" "\\leftarrow" t "&larr;" "<-" "<-" "←")
+ ("leftarrow" "\\leftarrow" t "&larr;" "<-" "<-" "←")
+ ("gets" "\\gets" t "&larr;" "<-" "<-" "←")
+ ("lArr" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
+ ("Leftarrow" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
+ ("uarr" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
+ ("uparrow" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
+ ("uArr" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
+ ("Uparrow" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
+ ("rarr" "\\rightarrow" t "&rarr;" "->" "->" "→")
+ ("to" "\\to" t "&rarr;" "->" "->" "→")
+ ("rightarrow" "\\rightarrow" t "&rarr;" "->" "->" "→")
+ ("rArr" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
+ ("Rightarrow" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
+ ("darr" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
+ ("downarrow" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
+ ("dArr" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
+ ("Downarrow" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
+ ("harr" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
+ ("leftrightarrow" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
+ ("hArr" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
+ ("Leftrightarrow" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
+ ("crarr" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
+ ("hookleftarrow" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
+
+ "** Function names"
+ ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos")
+ ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin")
+ ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan")
+ ("arg" "\\arg" t "arg" "arg" "arg" "arg")
+ ("cos" "\\cos" t "cos" "cos" "cos" "cos")
+ ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh")
+ ("cot" "\\cot" t "cot" "cot" "cot" "cot")
+ ("coth" "\\coth" t "coth" "coth" "coth" "coth")
+ ("csc" "\\csc" t "csc" "csc" "csc" "csc")
+ ("deg" "\\deg" t "&deg;" "deg" "deg" "deg")
+ ("det" "\\det" t "det" "det" "det" "det")
+ ("dim" "\\dim" t "dim" "dim" "dim" "dim")
+ ("exp" "\\exp" t "exp" "exp" "exp" "exp")
+ ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd")
+ ("hom" "\\hom" t "hom" "hom" "hom" "hom")
+ ("inf" "\\inf" t "inf" "inf" "inf" "inf")
+ ("ker" "\\ker" t "ker" "ker" "ker" "ker")
+ ("lg" "\\lg" t "lg" "lg" "lg" "lg")
+ ("lim" "\\lim" t "lim" "lim" "lim" "lim")
+ ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf")
+ ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup")
+ ("ln" "\\ln" t "ln" "ln" "ln" "ln")
+ ("log" "\\log" t "log" "log" "log" "log")
+ ("max" "\\max" t "max" "max" "max" "max")
+ ("min" "\\min" t "min" "min" "min" "min")
+ ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr")
+ ("sec" "\\sec" t "sec" "sec" "sec" "sec")
+ ("sin" "\\sin" t "sin" "sin" "sin" "sin")
+ ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh")
+ ("sup" "\\sup" t "&sup;" "sup" "sup" "sup")
+ ("tan" "\\tan" t "tan" "tan" "tan" "tan")
+ ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh")
+
+ "** Signs & Symbols"
+ ("bull" "\\textbullet{}" nil "&bull;" "*" "*" "•")
+ ("bullet" "\\textbullet{}" nil "&bull;" "*" "*" "•")
+ ("star" "\\star" t "*" "*" "*" "⋆")
+ ("lowast" "\\ast" t "&lowast;" "*" "*" "∗")
+ ("ast" "\\ast" t "&lowast;" "*" "*" "*")
+ ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ")
+ ("oplus" "\\oplus" t "&oplus;" "[circled plus]" "[circled plus]" "⊕")
+ ("otimes" "\\otimes" t "&otimes;" "[circled times]" "[circled times]" "⊗")
+ ("check" "\\checkmark" t "&checkmark;" "[checkmark]" "[checkmark]" "✓")
+ ("checkmark" "\\checkmark" t "&check;" "[checkmark]" "[checkmark]" "✓")
+
+ "** Miscellaneous (seldom used)"
+ ("para" "\\P{}" nil "&para;" "[pilcrow]" "¶" "¶")
+ ("ordf" "\\textordfeminine{}" nil "&ordf;" "_a_" "ª" "ª")
+ ("ordm" "\\textordmasculine{}" nil "&ordm;" "_o_" "º" "º")
+ ("cedil" "\\c{}" nil "&cedil;" "[cedilla]" "¸" "¸")
+ ("oline" "\\overline{~}" t "&oline;" "[overline]" "¯" "‾")
+ ("uml" "\\textasciidieresis{}" nil "&uml;" "[diaeresis]" "¨" "¨")
+ ("zwnj" "\\/{}" nil "&zwnj;" "" "" "‌")
+ ("zwj" "" nil "&zwj;" "" "" "‍")
+ ("lrm" "" nil "&lrm;" "" "" "‎")
+ ("rlm" "" nil "&rlm;" "" "" "‏")
+
+ "** Smilies"
+ ("smiley" "\\ddot\\smile" t "&#9786;" ":-)" ":-)" "☺")
+ ("blacksmile" "\\ddot\\smile" t "&#9787;" ":-)" ":-)" "☻")
+ ("sad" "\\ddot\\frown" t "&#9785;" ":-(" ":-(" "☹")
+ ("frowny" "\\ddot\\frown" t "&#9785;" ":-(" ":-(" "☹")
+
+ "** Suits"
+ ("clubs" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
+ ("clubsuit" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
+ ("spades" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
+ ("spadesuit" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
+ ("hearts" "\\heartsuit" t "&hearts;" "[hearts]" "[hearts]" "♥")
+ ("heartsuit" "\\heartsuit" t "&heartsuit;" "[hearts]" "[hearts]" "♥")
+ ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("Diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("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)))
+ (push (list (setq entity (concat entity " "))
+ (format "\\hspace*{%sem}" (* n .5))
+ nil
+ (setq html-spaces (concat "&ensp;" html-spaces))
+ spaces
+ spaces
+ (make-string n ?\x2002))
+ space-entities)))))
+ "Default entities used in Org mode to produce special characters.
For details see `org-entities-user'.")
(defsubst org-entity-get (name)
@@ -518,24 +534,6 @@ This first checks the user list, then the built-in list."
(or (assoc name org-entities-user)
(assoc name org-entities)))
-(defun org-entity-get-representation (name kind)
- "Get the correct representation of entity NAME for export type KIND.
-Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
- (let* ((e (org-entity-get name))
- (n (cdr (assq kind '((latex . 1) (html . 3) (ascii . 4)
- (latin1 . 5) (utf8 . 6)))))
- (r (and e n (nth n e))))
- (if (and e r
- (not org-entities-ascii-explanatory)
- (memq kind '(ascii latin1 utf8))
- (= (string-to-char r) ?\[))
- (concat "\\" name)
- r)))
-
-(defsubst org-entity-latex-math-p (name)
- "Does entity NAME require math mode in LaTeX?"
- (nth 2 (org-entity-get name)))
-
;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org
(defun org-entities-create-table ()
@@ -604,12 +602,6 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
(select-window (get-buffer-window "*Org Entity Help*")))
-(defun replace-amp ()
- "Postprocess HTML file to unescape the ampersand."
- (interactive)
- (while (re-search-forward "<td>&amp;\\([^<;]+;\\)" nil t)
- (replace-match (concat "<td>&" (match-string 1)) t t)))
-
(provide 'org-entities)
;; Local variables:
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
index f8625f1..36f810e 100644
--- a/lisp/org-faces.el
+++ b/lisp/org-faces.el
@@ -31,19 +31,6 @@
(require 'org-macs)
(require 'org-compat)
-(defun org-copy-face (old-face new-face docstring &rest attributes)
- (unless (facep new-face)
- (if (fboundp 'set-face-attribute)
- (progn
- (make-face new-face)
- (set-face-attribute new-face nil :inherit old-face)
- (apply 'set-face-attribute new-face nil attributes)
- (set-face-doc-string new-face docstring))
- (copy-face old-face new-face)
- (if (fboundp 'set-face-doc-string)
- (set-face-doc-string new-face docstring)))))
-(put 'org-copy-face 'lisp-indent-function 2)
-
(when (featurep 'xemacs)
(put 'mode-line 'face-alias 'modeline))
@@ -427,12 +414,15 @@ determines if it is a foreground or a background color."
"Face for checkboxes."
:group 'org-faces)
+(defface org-checkbox-statistics-todo
+ '((t (:inherit org-todo)))
+ "Face used for unfinished checkbox statistics."
+ :group 'org-faces)
-(org-copy-face 'org-todo 'org-checkbox-statistics-todo
- "Face used for unfinished checkbox statistics.")
-
-(org-copy-face 'org-done 'org-checkbox-statistics-done
- "Face used for finished checkbox statistics.")
+(defface org-checkbox-statistics-done
+ '((t (:inherit org-done)))
+ "Face used for finished checkbox statistics."
+ :group 'org-faces)
(defcustom org-tag-faces nil
"Faces for specific tags.
@@ -491,7 +481,7 @@ changes."
(defface org-meta-line
(org-compatible-face 'font-lock-comment-face nil)
- "Face for meta lines startin with \"#+\"."
+ "Face for meta lines starting with \"#+\"."
:group 'org-faces
:version "22.1")
@@ -537,14 +527,15 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
:group 'org-faces
:version "22.1")
-(defface org-block-background '((t ()))
- "Face used for the source block background.")
-
-(org-copy-face 'org-meta-line 'org-block-begin-line
- "Face used for the line delimiting the begin of source blocks.")
+(defface org-block-begin-line
+ '((t (:inherit org-meta-line)))
+ "Face used for the line delimiting the begin of source blocks."
+ :group 'org-faces)
-(org-copy-face 'org-meta-line 'org-block-end-line
- "Face used for the line delimiting the end of source blocks.")
+(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
@@ -560,10 +551,15 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
:group 'org-faces
:version "22.1")
-(org-copy-face 'org-block 'org-quote
- "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
-(org-copy-face 'org-block 'org-verse
- "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.")
+(defface org-quote
+ '((t (:inherit org-block)))
+ "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks."
+ :group 'org-faces)
+
+(defface org-verse
+ '((t (:inherit org-block)))
+ "Face for #+BEGIN_VERSE ... #+END_VERSE blocks."
+ :group 'org-faces)
(defcustom org-fontify-quote-and-verse-blocks nil
"Non-nil means, add a special face to #+begin_quote and #+begin_verse block.
@@ -576,13 +572,13 @@ content of these blocks will still be treated as Org syntax."
(defface org-clock-overlay ;; copied from secondary-selection
(org-compatible-face nil
'((((class color) (min-colors 88) (background light))
- (:background "yellow1"))
+ (:background "LightGray" :foreground "black"))
(((class color) (min-colors 88) (background dark))
- (:background "SkyBlue4"))
+ (:background "SkyBlue4" :foreground "white"))
(((class color) (min-colors 16) (background light))
- (:background "yellow"))
+ (:background "gray" :foreground "black"))
(((class color) (min-colors 16) (background dark))
- (:background "SkyBlue4"))
+ (:background "SkyBlue4" :foreground "white"))
(((class color) (min-colors 8))
(:background "cyan" :foreground "black"))
(t (:inverse-video t))))
@@ -600,21 +596,28 @@ content of these blocks will still be treated as Org syntax."
"Face used in agenda for captions and dates."
:group 'org-faces)
-(org-copy-face 'org-agenda-structure 'org-agenda-date
- "Face used in agenda for normal days.")
+(defface org-agenda-date
+ '((t (:inherit org-agenda-structure)))
+ "Face used in agenda for normal days."
+ :group 'org-faces)
-(org-copy-face 'org-agenda-date 'org-agenda-date-today
+(defface org-agenda-date-today
+ '((t (:inherit org-agenda-date :weight bold :italic t)))
"Face used in agenda for today."
- :weight 'bold :italic 't)
+ :group 'org-faces)
-(org-copy-face 'secondary-selection 'org-agenda-clocking
- "Face marking the current clock item in the agenda.")
+(defface org-agenda-clocking
+ '((t (:inherit secondary-selection)))
+ "Face marking the current clock item in the agenda."
+ :group 'org-faces)
-(org-copy-face 'org-agenda-date 'org-agenda-date-weekend
+(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 which days
-belong to the weekend."
- :weight 'bold)
+
+See the variable `org-agenda-weekend-days' for a definition of
+which days belong to the weekend."
+ :group 'org-faces)
(defface org-scheduled
(org-compatible-face nil
@@ -719,8 +722,10 @@ month and 365.24 days for a year)."
"Face used for time grids."
:group 'org-faces)
-(org-copy-face 'org-time-grid 'org-agenda-current-time
- "Face used to show the current time in the 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)
@@ -791,11 +796,15 @@ level org-n-level-faces"
:version "24.4"
:package-version '(Org . "8.0"))
-(org-copy-face 'mode-line 'org-mode-line-clock
- "Face used for clock display in mode line.")
-(org-copy-face 'mode-line 'org-mode-line-clock-overrun
+(defface org-mode-line-clock
+ '((t (:inherit mode-line)))
+ "Face used for clock display in mode line."
+ :group 'org-faces)
+
+(defface org-mode-line-clock-overrun
+ '((t (:inherit mode-line :background "red")))
"Face used for clock display for overrun tasks in mode line."
- :background "red")
+ :group 'org-faces)
(provide 'org-faces)
diff --git a/lisp/org-feed.el b/lisp/org-feed.el
index 6e68071..71a424f 100644
--- a/lisp/org-feed.el
+++ b/lisp/org-feed.el
@@ -116,7 +116,9 @@ to create inbox items in Org. Each entry is a list with the following items:
name a custom name for this feed
URL the Feed URL
-file the target Org file where entries should be listed
+file the target Org file where entries should be listed, when
+ nil the target becomes the current buffer (may be an
+ indirect buffer) each time the feed update is invoked
headline the headline under which entries should be listed
Additional arguments can be given using keyword-value pairs. Many of these
@@ -215,10 +217,7 @@ Here are the keyword-value pair allows in `org-feed-alist'.
(defcustom org-feed-drawer "FEEDSTATUS"
"The name of the drawer for feed status information.
Each feed may also specify its own drawer name using the `:drawer'
-parameter in `org-feed-alist'.
-Note that in order to make these drawers behave like drawers, they must
-be added to the variable `org-drawers' or configured with a #+DRAWERS
-line."
+parameter in `org-feed-alist'."
:group 'org-feed
:type '(string :tag "Drawer Name"))
@@ -299,7 +298,8 @@ it can be a list structured like an entry in `org-feed-alist'."
(catch 'exit
(let ((name (car feed))
(url (nth 1 feed))
- (file (nth 2 feed))
+ (file (or (nth 2 feed) (buffer-file-name (or (buffer-base-buffer)
+ (current-buffer)))))
(headline (nth 3 feed))
(filter (nth 1 (memq :filter feed)))
(formatter (nth 1 (memq :formatter feed)))
diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el
index c8b8c2e..7396609 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -1,6 +1,6 @@
;;; org-footnote.el --- Footnote support in Org and elsewhere
;;
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -38,32 +38,39 @@
(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-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-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-commented-line "org" ())
-(declare-function org-in-indented-comment-line "org" ())
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-in-verbatim-emphasis "org" ())
(declare-function org-inside-LaTeX-fragment-p "org" ())
(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-trim "org" (s))
(declare-function org-skip-whitespace "org" ())
-(declare-function outline-next-heading "outline")
(declare-function org-skip-whitespace "org" ())
+(declare-function org-trim "org" (s))
+(declare-function outline-next-heading "outline")
-(defvar org-outline-regexp-bol) ; defined in org.el
-(defvar org-odd-levels-only) ; defined in org.el
-(defvar org-bracket-link-regexp) ; defined in org.el
(defvar message-cite-prefix-regexp) ; defined in message.el
(defvar message-signature-separator) ; defined in message.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-bol) ; defined in org.el
(defconst org-footnote-re
;; Only [1]-like footnotes are closed in this regexp, as footnotes
@@ -106,8 +113,18 @@ the notes. However, by hand you may place definitions
*anywhere*.
If this is a string, during export, all subtrees starting with
-this heading will be ignored."
+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]"
:group 'org-footnote
+ :initialize 'custom-initialize-default
+ :set (lambda (var val)
+ (set var val)
+ (when (fboundp 'org-element-cache-reset)
+ (org-element-cache-reset 'all)))
:type '(choice
(string :tag "Collect footnotes under heading")
(const :tag "Define footnotes locally" nil)))
@@ -182,8 +199,7 @@ extracted will be filled again."
(defun org-footnote-in-valid-context-p ()
"Is point in a context where footnotes are allowed?"
(save-match-data
- (not (or (org-in-commented-line)
- (org-in-indented-comment-line)
+ (not (or (org-at-comment-p)
(org-inside-LaTeX-fragment-p)
;; Avoid literal example.
(org-in-verbatim-emphasis)
@@ -330,36 +346,56 @@ If no footnote is found, return nil."
(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))
- pos)
- (save-excursion
- (save-restriction
- (when (or (re-search-forward re nil t)
- (and (goto-char (point-min))
- (re-search-forward re nil t))
- (and (progn (widen) t)
- (goto-char (point-min))
- (re-search-forward re nil t)))
- (let ((refp (org-footnote-at-reference-p)))
- (cond
- ((and (nth 3 refp) refp))
- ((org-footnote-at-definition-p)))))))))
-
-(defun org-footnote-goto-definition (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))))
+
+(defun org-footnote-goto-definition (label &optional location)
"Move point to the definition of the footnote LABEL.
-Return a non-nil value when a definition has been found."
+
+LOCATION, when non-nil specifies the buffer position of the
+definition.
+
+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: ")
- (org-mark-ring-push)
- (let ((def (org-footnote-get-definition label)))
- (if (not def)
- (error "Cannot find definition of footnote %s" label)
- (goto-char (nth 1 def))
- (looking-at (format "\\[%s\\]\\|\\[%s:" label label))
- (goto-char (match-end 0))
- (org-show-context 'link-search)
- (when (derived-mode-p 'org-mode)
- (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))
- t)))
+ (let ((def-start (or location (nth 1 (org-footnote-get-definition label)))))
+ (cond
+ ((not def-start)
+ (user-error "Cannot find definition of footnote %s" label))
+ ((or (> def-start (point-max)) (< def-start (point-min)))
+ (user-error "Definition is outside narrowed part of buffer")))
+ (org-mark-ring-push)
+ (goto-char def-start)
+ (looking-at (format "\\[%s[]:]" 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]'.")))
+ t))
(defun org-footnote-goto-previous-reference (label)
"Find the first closest (to point) reference of footnote with label LABEL."
@@ -436,79 +472,131 @@ buffer."
(incf cnt))
(format fmt cnt)))
+(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))))))))
+
(defun org-footnote-new ()
"Insert a new footnote.
This command prompts for a label. If this is a label referencing an
existing label, only insert the label. If the footnote label is empty
or new, let the user edit the definition of the footnote."
(interactive)
- (unless (org-footnote-in-valid-context-p)
- (error "Cannot insert a footnote here"))
- (let* ((lbls (and (not (equal org-footnote-auto-label 'random))
- (org-footnote-all-labels)))
- (propose (and (not (equal org-footnote-auto-label 'random))
- (org-footnote-unique-label lbls)))
+ (unless (org-footnote--allow-reference-p)
+ (user-error "Cannot insert a footnote here"))
+ (let* ((all (org-footnote-all-labels))
(label
(org-footnote-normalize-label
- (cond
- ((member org-footnote-auto-label '(t plain))
- propose)
- ((equal org-footnote-auto-label 'random)
- (require 'org-id)
- (substring (org-id-uuid) 0 8))
- (t
- (org-icompleting-read
- "Label (leave empty for anonymous): "
- (mapcar 'list lbls) nil nil
- (if (eq org-footnote-auto-label 'confirm) propose nil)))))))
- (cond
- ((bolp) (error "Cannot create a footnote reference at left margin"))
- ((not label)
- (insert "[fn:: ]")
- (backward-char 1))
- ((member label lbls)
- (insert "[" label "]")
- (message "New reference to existing note"))
- (org-footnote-define-inline
- (insert "[" label ": ]")
- (backward-char 1)
- (org-footnote-auto-adjust-maybe))
- (t
- (insert "[" label "]")
- (org-footnote-create-definition label)
- (org-footnote-auto-adjust-maybe)))))
-
-(defvar org-blank-before-new-entry) ; silence byte-compiler
+ (if (eq org-footnote-auto-label 'random)
+ (format "fn:%x" (random #x100000000))
+ (let ((propose (org-footnote-unique-label all)))
+ (if (memq org-footnote-auto-label '(t plain)) propose
+ (org-icompleting-read
+ "Label (leave empty for anonymous): "
+ (mapcar #'list all) nil nil
+ (and (eq org-footnote-auto-label 'confirm) propose))))))))
+ (cond ((not label)
+ (insert "[fn::]")
+ (backward-char 1))
+ ((member label all)
+ (insert "[" label "]")
+ (message "New reference to existing note"))
+ (org-footnote-define-inline
+ (insert "[" label ":]")
+ (backward-char 1)
+ (org-footnote-auto-adjust-maybe))
+ (t
+ (insert "[" label "]")
+ (let ((l (copy-marker (org-footnote-create-definition label))))
+ (org-footnote-auto-adjust-maybe)
+ (or (ignore-errors (org-footnote-goto-definition label l))
+ ;; Since definition was created outside current
+ ;; scope, edit it remotely.
+ (progn (set-marker l nil)
+ (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."
- (interactive "sLabel: ")
+ "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."
(let ((label (org-footnote-normalize-label label))
- electric-indent-mode) ;; Prevent wrong indentation
+ electric-indent-mode) ; Prevent wrong indentation.
(cond
- ;; In an Org file.
+ ;; 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.
- (when org-footnote-section
- (goto-char (point-min))
- (let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$")))
- (unless (or (re-search-forward re nil t)
- (and (progn (widen) t)
- (re-search-forward re nil t)))
- (goto-char (point-max))
- (skip-chars-backward " \t\r\n")
- (unless (bolp) (newline))
- ;; 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"))))
- ;; Move to the end of this entry (which may be
- ;; `org-footnote-section' or the current one).
- (org-footnote-goto-local-insertion-point)
- (org-show-context 'link-search))
+ (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
@@ -543,16 +631,11 @@ or new, let the user edit the definition of the footnote."
(skip-chars-backward " \t\r\n")
(delete-region (point) max)
(unless (bolp) (newline))
- (set-marker max nil))))
- ;; Insert footnote label.
- (when (zerop (org-back-over-empty-lines)) (newline))
- (insert "[" label "] \n")
- (backward-char)
- ;; Only notify user about next possible action when in an Org
- ;; buffer, as the bindings may have different meanings otherwise.
- (when (derived-mode-p 'org-mode)
- (message
- "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
+ (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)
@@ -564,38 +647,47 @@ 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.
+interactively if possible.
-With prefix arg SPECIAL, offer additional commands in a menu."
+With prefix arg SPECIAL, or when no footnote can be created,
+offer additional commands in a menu."
(interactive "P")
- (let (tmp c)
+ (let* ((context (and (not special) (org-element-context)))
+ (type (org-element-type context)))
(cond
- (special
- (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete")
- (setq 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))))
- ((setq tmp (org-footnote-at-reference-p))
- (cond
- ;; Anonymous footnote: move point at the beginning of its
- ;; definition.
- ((not (car tmp))
- (goto-char (nth 1 tmp))
- (forward-char 5))
- ;; A definition exists: move to it.
- ((ignore-errors (org-footnote-goto-definition (car tmp))))
- ;; No definition exists: offer to create it.
- ((yes-or-no-p (format "No definition for %s. Create one? " (car tmp)))
- (org-footnote-create-definition (car tmp)))))
- ((setq tmp (org-footnote-at-definition-p))
- (org-footnote-goto-previous-reference (car tmp)))
+ ((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
@@ -622,163 +714,162 @@ referenced sequence."
(concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))
(count 0)
ins-point ref ref-table)
- (save-excursion
- ;; 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")
- (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.
- (mapc (lambda (x)
- (unless (nth 3 x) (org-footnote-delete-definitions (car x))))
- ref-table)
- ;; 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
- (mapc
+ (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")
+ (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)
- (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"
- (if sort-only (car x) (nth 1 x))
- (nth 2 x))))
- ref-table))))))
-
-(defun org-footnote-goto-local-insertion-point ()
- "Find insertion point for footnote, just before next outline heading."
+ ;; 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))
- (or (bolp) (newline))
- (beginning-of-line 0)
- (while (and (not (bobp)) (= (char-after) ?#))
- (beginning-of-line 0))
- (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2))
- (end-of-line 1)
- (skip-chars-backward "\n\r\t ")
- (forward-line))
+ ;; 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")))
(defun org-footnote-delete-references (label)
"Delete every reference to footnote LABEL.
diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el
index 785b577..c0087a1 100644
--- a/lisp/org-gnus.el
+++ b/lisp/org-gnus.el
@@ -36,11 +36,13 @@
(eval-when-compile (require 'gnus-sum))
;; Declare external functions and variables
+
(declare-function message-fetch-field "message" (header &optional not-all))
(declare-function message-narrow-to-head-1 "message" nil)
(declare-function nnimap-group-overview-filename "nnimap" (group server))
-;; The following line suppresses a compiler warning stemming from gnus-sum.el
(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)
@@ -60,7 +62,7 @@ Normally, this translation is done by querying the IMAP server,
which is usually very fast. Unfortunately, some (maybe badly
configured) IMAP servers don't support this operation quickly.
So if following a link to a Gnus article takes ages, try setting
-this variable to `t'."
+this variable to t."
:group 'org-link-store
:version "24.1"
:type 'boolean)
@@ -170,6 +172,10 @@ If `org-store-link' was called with a prefix arg the meaning of
(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)))))
;; Remove text properties of subject string to avoid Emacs bug
;; #3506
(set-text-properties 0 (length subject) nil subject)
@@ -249,10 +255,8 @@ If `org-store-link' was called with a prefix arg the meaning of
(require 'gnus)
(funcall (cdr (assq 'gnus org-link-frame-setup)))
(if gnus-other-frame-object (select-frame gnus-other-frame-object))
- (when group
- (setq group (org-no-properties group)))
- (when article
- (setq article (org-no-properties article)))
+ (setq group (org-no-properties group))
+ (setq article (org-no-properties article))
(cond ((and group article)
(gnus-activate-group group)
(condition-case nil
diff --git a/lisp/org-habit.el b/lisp/org-habit.el
index 6013756..338aabc 100644
--- a/lisp/org-habit.el
+++ b/lisp/org-habit.el
@@ -1,6 +1,6 @@
;;; org-habit.el --- The habit tracking code for Org-mode
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -165,6 +165,7 @@ Returns a list with the following elements:
2: Optional deadline (nil if not present)
3: If deadline, the repeater for the deadline, otherwise nil
4: A list of all the past dates this todo was mark closed
+ 5: Repeater type as a string
This list represents a \"habit\" for the rest of this module."
(save-excursion
@@ -174,7 +175,7 @@ This list represents a \"habit\" for the rest of this module."
(scheduled-repeat (org-get-repeat org-scheduled-string))
(end (org-entry-end-position))
(habit-entry (org-no-properties (nth 4 (org-heading-components))))
- closed-dates deadline dr-days sr-days)
+ closed-dates deadline dr-days sr-days sr-type)
(if scheduled
(setq scheduled (time-to-days scheduled))
(error "Habit %s has no scheduled date" habit-entry))
@@ -182,7 +183,9 @@ This list represents a \"habit\" for the rest of this module."
(error
"Habit '%s' has no scheduled repeat period or has an incorrect one"
habit-entry))
- (setq sr-days (org-habit-duration-to-days scheduled-repeat))
+ (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)))
(unless (> sr-days 0)
(error "Habit %s scheduled repeat period is less than 1d" habit-entry))
(when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)
@@ -197,17 +200,33 @@ This list represents a \"habit\" for the rest of this module."
(reversed org-log-states-order-reversed)
(search (if reversed 're-search-forward 're-search-backward))
(limit (if reversed end (point)))
- (count 0))
+ (count 0)
+ (re (format
+ "^[ \t]*-[ \t]+\\(?:State \"%s\".*%s%s\\)"
+ (regexp-opt org-done-keywords)
+ org-ts-regexp-inactive
+ (let ((value (cdr (assq 'done org-log-note-headings))))
+ (if (not value) ""
+ (concat "\\|"
+ (org-replace-escapes
+ (regexp-quote value)
+ `(("%d" . ,org-ts-regexp-inactive)
+ ("%D" . ,org-ts-regexp)
+ ("%s" . "\"\\S-+\"")
+ ("%S" . "\"\\S-+\"")
+ ("%t" . ,org-ts-regexp-inactive)
+ ("%T" . ,org-ts-regexp)
+ ("%u" . ".*?")
+ ("%U" . ".*?")))))))))
(unless reversed (goto-char end))
- (while (and (< count maxdays)
- (funcall search (format "- State \"%s\".*\\[\\([^]]+\\)\\]"
- (regexp-opt org-done-keywords))
- limit t))
+ (while (and (< count maxdays) (funcall search re limit t))
(push (time-to-days
- (org-time-string-to-time (match-string-no-properties 1)))
+ (org-time-string-to-time
+ (or (org-match-string-no-properties 1)
+ (org-match-string-no-properties 2))))
closed-dates)
(setq count (1+ count))))
- (list scheduled sr-days deadline dr-days closed-dates))))
+ (list scheduled sr-days deadline dr-days closed-dates sr-type))))
(defsubst org-habit-scheduled (habit)
(nth 0 habit))
@@ -225,6 +244,8 @@ This list represents a \"habit\" for the rest of this module."
(org-habit-scheduled-repeat habit)))
(defsubst org-habit-done-dates (habit)
(nth 4 habit))
+(defsubst org-habit-repeat-type (habit)
+ (nth 5 habit))
(defsubst org-habit-get-priority (habit &optional moment)
"Determine the relative priority of a habit.
@@ -311,10 +332,27 @@ current time."
(not (< scheduled now)))
'(org-habit-clear-face . org-habit-clear-future-face)
(org-habit-get-faces
- habit start (and in-the-past-p
- (if last-done-date
- (+ last-done-date s-repeat)
- scheduled))
+ 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)))
markedp face)
(if donep
diff --git a/lisp/org-info.el b/lisp/org-info.el
index 8a2d717..b7c9466 100644
--- a/lisp/org-info.el
+++ b/lisp/org-info.el
@@ -40,7 +40,7 @@
(defvar Info-current-node)
;; Install the link type
-(org-add-link-type "info" 'org-info-open)
+(org-add-link-type "info" 'org-info-open 'org-info-export)
(add-hook 'org-store-link-functions 'org-info-store-link)
;; Implementation
@@ -67,12 +67,32 @@
"Follow an Info file and node link specified by NAME."
(if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name)
(string-match "\\(.*\\)" name))
- (progn
+ (let ((filename (match-string 1 name))
+ (nodename-or-index (or (match-string 2 name) "Top")))
(require 'info)
- (if (match-string 2 name) ; If there isn't a node, choose "Top"
- (Info-find-node (match-string 1 name) (match-string 2 name))
- (Info-find-node (match-string 1 name) "Top")))
- (message "Could not open: %s" name)))
+ ;; If nodename-or-index is invalid node name, then look it up
+ ;; in the index.
+ (condition-case nil
+ (Info-find-node filename nodename-or-index)
+ (user-error (Info-find-node filename "Top")
+ (condition-case nil
+ (Info-index nodename-or-index)
+ (user-error "Could not find '%s' node or index entry"
+ nodename-or-index)))))
+ (user-error "Could not open: %s" name)))
+
+(defun org-info-export (path desc format)
+ "Export an info link.
+See `org-add-link-type' 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
+ (replace-regexp-in-string " " "-" node)
+ (or desc path)))))
(provide 'org-info)
diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el
index de4267c..75654b4 100644
--- a/lisp/org-inlinetask.el
+++ b/lisp/org-inlinetask.el
@@ -108,7 +108,6 @@ When nil, the first star is not shown."
(defvar org-odd-levels-only)
(defvar org-keyword-time-regexp)
-(defvar org-drawer-regexp)
(defvar org-complex-heading-regexp)
(defvar org-property-end-re)
@@ -315,19 +314,36 @@ If the task has an end part, also demote it."
;; Nothing to show/hide.
((= end start))
;; Inlinetask was folded: expand it.
- ((get-char-property (1+ start) 'invisible)
+ ((eq (get-char-property (1+ start) 'invisible) 'outline)
(outline-flag-region start end nil)
(org-cycle-hide-drawers 'children))
(t (outline-flag-region start end t)))))
+(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
+ (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
+ (save-excursion
+ (while (and (outline-next-heading) (org-inlinetask-at-task-p))
+ (org-inlinetask-toggle-visibility)
+ (org-inlinetask-goto-end))))))
+
(defun org-inlinetask-remove-END-maybe ()
"Remove an END line when present."
(when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$"
org-inlinetask-min-level))
(replace-match "")))
-(eval-after-load "org"
- '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
+(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)
+(add-hook 'org-cycle-hook 'org-inlinetask-hide-tasks)
(provide 'org-inlinetask)
diff --git a/lisp/org-list.el b/lisp/org-list.el
index a00e557..b23f49b 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -1,6 +1,6 @@
;;; org-list.el --- Plain lists for Org-mode
;;
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Bastien Guerry <bzg@gnu.org>
@@ -88,36 +88,43 @@
(defvar org-closed-string)
(defvar org-deadline-string)
(defvar org-description-max-indent)
-(defvar org-drawers)
(defvar org-odd-levels-only)
(defvar org-scheduled-string)
(defvar org-ts-regexp)
(defvar org-ts-regexp-both)
+(defvar org-drawer-regexp)
-(declare-function outline-invisible-p "outline" (&optional pos))
-(declare-function outline-flag-region "outline" (from to flag))
-(declare-function outline-next-heading "outline" ())
-(declare-function outline-previous-heading "outline" ())
-
-(declare-function org-at-heading-p "org" (&optional ignored))
-(declare-function org-before-first-heading-p "org" ())
+(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-property "org-element" (property element))
+(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-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-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
+(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
+(declare-function org-inlinetask-goto-end "org-inlinetask" ())
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-at-heading-p "org" (&optional invisible-ok))
(declare-function org-previous-line-empty-p "org" ())
-(declare-function org-remove-if "org" (predicate seq))
(declare-function org-reduced-level "org" (L))
+(declare-function org-remove-if "org" (predicate seq))
(declare-function org-show-subtree "org" ())
(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
@@ -125,15 +132,10 @@
(declare-function org-timer-item "org-timer" (&optional arg))
(declare-function org-trim "org" (s))
(declare-function org-uniquify "org" (list))
-
-(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
-(declare-function org-inlinetask-goto-end "org-inlinetask" ())
-(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
-(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
-
-(declare-function org-export-string-as "ox"
- (string backend &optional body-only ext-plist))
-
+(declare-function outline-flag-region "outline" (from to flag))
+(declare-function outline-invisible-p "outline" (&optional pos))
+(declare-function outline-next-heading "outline" ())
+(declare-function outline-previous-heading "outline" ())
@@ -211,11 +213,19 @@ into
(defcustom org-plain-list-ordered-item-terminator t
"The character that makes a line with leading number an ordered list item.
-Valid values are ?. and ?\). To get both terminators, use t."
+Valid values are ?. and ?\). To get both terminators, use t.
+
+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]"
:group 'org-plain-lists
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
- (const :tag "both" t)))
+ (const :tag "both" t))
+ :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
@@ -230,13 +240,12 @@ 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:
- \(when (featurep 'org-element) (load \"org-element\" t t))"
+ \\[org-element-update-syntax]"
:group 'org-plain-lists
:version "24.1"
:type 'boolean
- :set (lambda (var val)
- (when (featurep 'org-element) (load "org-element" t t))
- (set var val)))
+ :set (lambda (var val) (set var val)
+ (when (featurep 'org-element) (org-element-update-syntax))))
(defcustom org-list-two-spaces-after-bullet-regexp nil
"A regular expression matching bullets that should have 2 spaces after them.
@@ -430,9 +439,6 @@ group 4: description tag")
(let* ((case-fold-search t)
(context (org-list-context))
(lim-up (car context))
- (drawers-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(item-re (org-item-re))
@@ -476,7 +482,7 @@ group 4: description tag")
((and (looking-at "^[ \t]*#\\+end_")
(re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
((and (looking-at "^[ \t]*:END:")
- (re-search-backward drawers-re lim-up t))
+ (re-search-backward org-drawer-regexp lim-up t))
(beginning-of-line))
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning)
@@ -547,11 +553,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'."
(lim-down (or (save-excursion (outline-next-heading)) (point-max))))
;; Is point inside a drawer?
(let ((end-re "^[ \t]*:END:")
- ;; Can't use org-drawers-regexp as this function might
- ;; be called in buffers not in Org mode.
- (beg-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$")))
+ (beg-re org-drawer-regexp))
(when (save-excursion
(and (not (looking-at beg-re))
(not (looking-at end-re))
@@ -635,13 +637,10 @@ Assume point is at an item."
(lim-down (nth 1 context))
(text-min-ind 10000)
(item-re (org-item-re))
- (drawers-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(beg-cell (cons (point) (org-get-indentation)))
- ind itm-lst itm-lst-2 end-lst end-lst-2 struct
+ itm-lst itm-lst-2 end-lst end-lst-2 struct
(assoc-at-point
(function
;; Return association at point.
@@ -700,7 +699,7 @@ Assume point is at an item."
((and (looking-at "^[ \t]*#\\+end_")
(re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
((and (looking-at "^[ \t]*:END:")
- (re-search-backward drawers-re lim-up t))
+ (re-search-backward org-drawer-regexp lim-up t))
(beginning-of-line))
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning)
@@ -766,7 +765,7 @@ Assume point is at an item."
(cond
((and (looking-at "^[ \t]*#\\+begin_")
(re-search-forward "^[ \t]*#\\+end_" lim-down t)))
- ((and (looking-at drawers-re)
+ ((and (looking-at org-drawer-regexp)
(re-search-forward "^[ \t]*:END:" lim-down t))))
(forward-line 1))))))
(setq struct (append itm-lst (cdr (nreverse itm-lst-2)))
@@ -926,13 +925,13 @@ Value returned is the position of the first child of ITEM."
(< ind (org-list-get-ind child-maybe struct)))
child-maybe)))
-(defun org-list-get-next-item (item struct prevs)
+(defun org-list-get-next-item (item _struct prevs)
"Return next item in same sub-list as ITEM, or nil.
STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'."
(car (rassq item prevs)))
-(defun org-list-get-prev-item (item struct prevs)
+(defun org-list-get-prev-item (item _struct prevs)
"Return previous item in same sub-list as ITEM, or nil.
STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'."
@@ -964,7 +963,7 @@ items, as returned by `org-list-prevs-alist'."
(push next-item after-item))
(append before-item (list item) (nreverse after-item))))
-(defun org-list-get-children (item struct parents)
+(defun org-list-get-children (item _struct parents)
"List all children of ITEM, or nil.
STRUCT is the list structure. PARENTS is the alist of parents,
as returned by `org-list-parents-alist'."
@@ -982,7 +981,7 @@ STRUCT is the list structure."
(defun org-list-get-bottom-point (struct)
"Return point at bottom of list.
STRUCT is the list structure."
- (apply 'max
+ (apply #'max
(mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct)))
(defun org-list-get-list-begin (item struct prevs)
@@ -1137,13 +1136,20 @@ This function modifies STRUCT."
;; Store overlays responsible for visibility status. We
;; also need to store their boundaries as they will be
;; removed from buffer.
- (overlays (cons
- (mapcar (lambda (ov)
- (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-A end-A))
- (mapcar (lambda (ov)
- (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-B end-B)))))
+ (overlays
+ (cons
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-A)
+ (<= (overlay-end o) end-A)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-A end-A)))
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-B)
+ (<= (overlay-end o) end-B)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-B end-B))))))
;; 1. Move effectively items in buffer.
(goto-char beg-A)
(delete-region beg-A end-B-no-blank)
@@ -1154,42 +1160,39 @@ This function modifies STRUCT."
;; as empty spaces are not moved there. In others words,
;; item BEG-A will end with whitespaces that were at the end
;; of BEG-B and the same applies to BEG-B.
- (mapc (lambda (e)
- (let ((pos (car e)))
- (cond
- ((< pos beg-A))
- ((memq pos sub-A)
- (let ((end-e (nth 6 e)))
- (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
- (setcar (nthcdr 6 e)
- (+ end-e (- end-B-no-blank end-A-no-blank)))
- (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
- ((memq pos sub-B)
- (let ((end-e (nth 6 e)))
- (setcar e (- (+ pos beg-A) beg-B))
- (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
- (when (= end-e end-B)
- (setcar (nthcdr 6 e)
- (+ beg-A size-B (- end-A end-A-no-blank))))))
- ((< pos beg-B)
- (let ((end-e (nth 6 e)))
- (setcar e (+ pos (- size-B size-A)))
- (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
- struct)
- (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))
+ (dolist (e struct)
+ (let ((pos (car e)))
+ (cond
+ ((< pos beg-A))
+ ((memq pos sub-A)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
+ (setcar (nthcdr 6 e)
+ (+ end-e (- end-B-no-blank end-A-no-blank)))
+ (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
+ ((memq pos sub-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (- (+ pos beg-A) beg-B))
+ (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
+ (when (= end-e end-B)
+ (setcar (nthcdr 6 e)
+ (+ beg-A size-B (- end-A end-A-no-blank))))))
+ ((< pos beg-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- size-B size-A)))
+ (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
+ (setq struct (sort struct #'car-less-than-car))
;; Restore visibility status, by moving overlays to their new
;; position.
- (mapc (lambda (ov)
- (move-overlay
- (car ov)
- (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
- (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
- (car overlays))
- (mapc (lambda (ov)
- (move-overlay (car ov)
- (+ (nth 1 ov) (- beg-A beg-B))
- (+ (nth 2 ov) (- beg-A beg-B))))
- (cdr overlays))
+ (dolist (ov (car overlays))
+ (move-overlay
+ (car ov)
+ (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
+ (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
+ (dolist (ov (cdr overlays))
+ (move-overlay (car ov)
+ (+ (nth 1 ov) (- beg-A beg-B))
+ (+ (nth 2 ov) (- beg-A beg-B))))
;; Return structure.
struct)))
@@ -1272,12 +1275,16 @@ This function modifies STRUCT."
(beforep
(progn
(looking-at org-list-full-item-re)
- ;; Do not count tag in a non-descriptive list.
- (<= pos (if (and (match-beginning 4)
- (save-match-data
- (string-match "[.)]" (match-string 1))))
- (match-beginning 4)
- (match-end 0)))))
+ (<= pos
+ (cond
+ ((not (match-beginning 4)) (match-end 0))
+ ;; Ignore tag in a non-descriptive list.
+ ((save-match-data (string-match "[.)]" (match-string 1)))
+ (match-beginning 4))
+ (t (save-excursion
+ (goto-char (match-end 4))
+ (skip-chars-forward " \t")
+ (point)))))))
(split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
(blank-nb (org-list-separating-blank-lines-number
pos struct prevs))
@@ -1473,8 +1480,10 @@ This function returns, destructively, the new list structure."
(point-at-eol)))))
(t dest)))
(org-M-RET-may-split-line nil)
- ;; Store visibility.
- (visibility (overlays-in item item-end)))
+ ;; Store inner overlays (to preserve visibility).
+ (overlays (org-remove-if (lambda (o) (or (< (overlay-start o) item)
+ (> (overlay-end o) item)))
+ (overlays-in item item-end))))
(cond
((eq dest 'delete) (org-list-delete-item item struct))
((eq dest 'kill)
@@ -1509,13 +1518,12 @@ This function returns, destructively, the new list structure."
new-end
(+ end shift)))))))
moved-items))
- (lambda (e1 e2) (< (car e1) (car e2))))))
- ;; 2. Restore visibility.
- (mapc (lambda (ov)
- (move-overlay ov
- (+ (overlay-start ov) (- (point) item))
- (+ (overlay-end ov) (- (point) item))))
- visibility)
+ #'car-less-than-car)))
+ ;; 2. Restore inner overlays.
+ (dolist (o overlays)
+ (move-overlay o
+ (+ (overlay-start o) (- (point) item))
+ (+ (overlay-end o) (- (point) item))))
;; 3. Eventually delete extra copy of the item and clean marker.
(prog1 (org-list-delete-item (marker-position item) struct)
(move-marker item nil)))
@@ -1630,8 +1638,7 @@ as returned by `org-list-prevs-alist'."
;; Pretend that bullets are uppercase and check if alphabet
;; is sufficient, taking counters into account.
(while item
- (let ((bul (org-list-get-bullet item struct))
- (count (org-list-get-counter item struct)))
+ (let ((count (org-list-get-counter item struct)))
;; Virtually determine current bullet
(if (and count (string-match "[a-zA-Z]" count))
;; Counters are not case-sensitive.
@@ -1728,7 +1735,7 @@ This function modifies STRUCT."
(replace-match "1" nil nil bullet))
;; Not an ordered list: keep bullet.
(t bullet)))))))))
- (mapc fix-bul (mapcar 'car struct))))
+ (mapc fix-bul (mapcar #'car struct))))
(defun org-list-struct-fix-ind (struct parents &optional bullet-size)
"Verify and correct indentation in STRUCT.
@@ -1756,7 +1763,7 @@ This function modifies STRUCT."
org-list-indent-offset))
;; If no parent, indent like top-point.
(org-list-set-ind item struct top-ind))))))
- (mapc new-ind (mapcar 'car (cdr struct)))))
+ (mapc new-ind (mapcar #'car (cdr struct)))))
(defun org-list-struct-fix-box (struct parents prevs &optional ordered)
"Verify and correct checkboxes in STRUCT.
@@ -1771,7 +1778,7 @@ break this rule, the function will return the blocking item. In
all others cases, the return value will be nil.
This function modifies STRUCT."
- (let ((all-items (mapcar 'car struct))
+ (let ((all-items (mapcar #'car struct))
(set-parent-box
(function
(lambda (item)
@@ -1862,10 +1869,9 @@ Initial position of cursor is restored after the changes."
(item-re (org-item-re))
(shift-body-ind
(function
- ;; Shift the indentation between END and BEG by DELTA. If
- ;; MAX-IND is non-nil, ensure that no line will be indented
- ;; more than that number. Start from the line before END.
- (lambda (end beg delta max-ind)
+ ;; Shift the indentation between END and BEG by DELTA.
+ ;; Start from the line before END.
+ (lambda (end beg delta)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
@@ -1878,9 +1884,7 @@ Initial position of cursor is restored after the changes."
(org-inlinetask-goto-beginning))
;; Shift only non-empty lines.
((org-looking-at-p "^[ \t]*\\S-")
- (let ((i (org-get-indentation)))
- (org-indent-line-to
- (if max-ind (min (+ i delta) max-ind) (+ i delta))))))
+ (org-indent-line-to (+ (org-get-indentation) delta))))
(forward-line -1)))))
(modify-item
(function
@@ -1935,37 +1939,53 @@ Initial position of cursor is restored after the changes."
;; belongs to: it is the last item (ITEM-UP), whose
;; ending is further than the position we're
;; interested in.
- (let ((item-up (assoc-default end-pos acc-end '>)))
+ (let ((item-up (assoc-default end-pos acc-end #'>)))
(push (cons end-pos item-up) end-list)))
(push (cons end-pos pos) acc-end)))
;; 2. Slice the items into parts that should be shifted by the
;; same amount of indentation. Each slice follow the pattern
- ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in
- ;; reverse order.
- (setq all-ends (sort (append (mapcar 'car itm-shift)
- (org-uniquify (mapcar 'car end-list)))
- '<))
+ ;; (END BEG DELTA). Slices are returned in reverse order.
+ (setq all-ends (sort (append (mapcar #'car itm-shift)
+ (org-uniquify (mapcar #'car end-list)))
+ #'<)
+ acc-end (nreverse acc-end))
(while (cdr all-ends)
(let* ((up (pop all-ends))
(down (car all-ends))
(itemp (assq up struct))
- (item (if itemp up (cdr (assq up end-list))))
- (ind (cdr (assq item itm-shift)))
- ;; If we're not at an item, there's a child of the item
- ;; point belongs to above. Make sure this slice isn't
- ;; moved within that child by specifying a maximum
- ;; indentation.
- (max-ind (and (not itemp)
- (+ (org-list-get-ind item struct)
- (length (org-list-get-bullet item struct))
- org-list-indent-offset))))
- (push (list down up ind max-ind) sliced-struct)))
+ (delta
+ (if itemp (cdr (assq up itm-shift))
+ ;; If we're not at an item, there's a child of the
+ ;; item point belongs to above. Make sure the less
+ ;; indented line in this slice has the same column
+ ;; as that child.
+ (let* ((child (cdr (assq up acc-end)))
+ (ind (org-list-get-ind child struct))
+ (min-ind most-positive-fixnum))
+ (save-excursion
+ (goto-char up)
+ (while (< (point) down)
+ ;; Ignore empty lines. Also ignore blocks and
+ ;; drawers contents.
+ (unless (org-looking-at-p "[ \t]*$")
+ (setq min-ind (min (org-get-indentation) min-ind))
+ (cond
+ ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
+ (re-search-forward
+ (format "^[ \t]*#\\+END%s[ \t]*$"
+ (match-string 1))
+ down t)))
+ ((and (looking-at org-drawer-regexp)
+ (re-search-forward "^[ \t]*:END:[ \t]*$"
+ down t)))))
+ (forward-line)))
+ (- ind min-ind)))))
+ (push (list down up delta) sliced-struct)))
;; 3. Shift each slice in buffer, provided delta isn't 0, from
;; end to beginning. Take a special action when beginning is
;; at item bullet.
(dolist (e sliced-struct)
- (unless (and (zerop (nth 2 e)) (not (nth 3 e)))
- (apply shift-body-ind e))
+ (unless (zerop (nth 2 e)) (apply shift-body-ind e))
(let* ((beg (nth 1 e))
(cell (assq beg struct)))
(unless (or (not cell) (equal cell (assq beg old-struct)))
@@ -2061,16 +2081,19 @@ Possible values are: `folded', `children' or `subtree'. See
(defun org-list-item-body-column (item)
"Return column at which body of ITEM should start."
- (let (bpos bcol tpos tcol)
- (save-excursion
- (goto-char item)
- (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)")
- (setq bpos (match-beginning 1) tpos (match-end 0)
- bcol (progn (goto-char bpos) (current-column))
- tcol (progn (goto-char tpos) (current-column)))
- (when (> tcol (+ bcol org-description-max-indent))
- (setq tcol (+ bcol 5))))
- tcol))
+ (save-excursion
+ (goto-char item)
+ (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)")
+ (if (match-beginning 2)
+ (let ((start (1+ (match-end 2)))
+ (ind (org-get-indentation)))
+ (if (> start (+ ind org-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)))
+ 2
+ 1)))))
@@ -2326,16 +2349,13 @@ in subtree, ignoring drawers."
block-item
lim-up
lim-down
- (drawer-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$"))
(keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string
"\\|" org-deadline-string
"\\|" org-closed-string
"\\|" org-clock-string "\\)"
" *[[<]\\([^]>]+\\)[]>]"))
(orderedp (org-entry-get nil "ORDERED"))
- (bounds
+ (_bounds
;; In a region, start at first item in region.
(cond
((org-region-active-p)
@@ -2350,7 +2370,8 @@ in subtree, ignoring drawers."
;; time-stamps (scheduled, etc.).
(let ((limit (save-excursion (outline-next-heading) (point))))
(forward-line 1)
- (while (or (looking-at drawer-re) (looking-at keyword-re))
+ (while (or (looking-at org-drawer-regexp)
+ (looking-at keyword-re))
(if (looking-at keyword-re)
(forward-line 1)
(re-search-forward "^[ \t]*:END:" limit nil)))
@@ -2391,7 +2412,7 @@ in subtree, ignoring drawers."
(bottom (copy-marker (org-list-get-bottom-point struct)))
(items-to-toggle (org-remove-if
(lambda (e) (or (< e lim-up) (> e lim-down)))
- (mapcar 'car struct))))
+ (mapcar #'car struct))))
(mapc (lambda (e) (org-list-set-checkbox
e struct
;; If there is no box at item, leave as-is
@@ -2440,130 +2461,123 @@ in subtree, ignoring drawers."
(defun org-update-checkbox-count (&optional all)
"Update the checkbox statistics in the current section.
+
This will find all statistic cookies like [57%] and [6/12] and
update them with the current numbers.
With optional prefix argument ALL, do this for the whole buffer."
(interactive "P")
- (save-excursion
- (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
- (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
+ (org-with-wide-buffer
+ (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
+ (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\
+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
(recursivep
(or (not org-checkbox-hierarchical-statistics)
(string-match "\\<recursive\\>"
(or (org-entry-get nil "COOKIE_DATA") ""))))
- (bounds (if all
- (cons (point-min) (point-max))
- (cons (or (ignore-errors (org-back-to-heading t) (point))
- (point-min))
- (save-excursion (outline-next-heading) (point)))))
+ (within-inlinetask (and (not all)
+ (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p)))
+ (end (cond (all (point-max))
+ (within-inlinetask
+ (save-excursion (outline-next-heading) (point)))
+ (t (save-excursion
+ (org-with-limited-levels (outline-next-heading))
+ (point)))))
(count-boxes
- (function
- ;; Return number of checked boxes and boxes of all types
- ;; in all structures in STRUCTS. If RECURSIVEP is
- ;; non-nil, also count boxes in sub-lists. If ITEM is
- ;; nil, count across the whole structure, else count only
- ;; across subtree whose ancestor is ITEM.
- (lambda (item structs recursivep)
- (let ((c-on 0) (c-all 0))
- (mapc
- (lambda (s)
- (let* ((pre (org-list-prevs-alist s))
- (par (org-list-parents-alist s))
- (items
- (cond
- ((and recursivep item) (org-list-get-subtree item s))
- (recursivep (mapcar 'car s))
- (item (org-list-get-children item s par))
- (t (org-list-get-all-items
- (org-list-get-top-point s) s pre))))
- (cookies (delq nil (mapcar
- (lambda (e)
- (org-list-get-checkbox e s))
- items))))
- (setq c-all (+ (length cookies) c-all)
- c-on (+ (org-count "[X]" cookies) c-on))))
- structs)
- (cons c-on c-all)))))
- (backup-end 1)
- cookies-list structs-bak box-num)
- (goto-char (car bounds))
- ;; 1. Build an alist for each cookie found within BOUNDS. The
- ;; key will be position at beginning of cookie and values
- ;; ending position, format of cookie, and a cell whose car is
- ;; number of checked boxes to report, and cdr total number of
- ;; boxes.
- (while (re-search-forward cookie-re (cdr bounds) t)
- (catch 'skip
- (save-excursion
- (push
- (list
- (match-beginning 1) ; cookie start
- (match-end 1) ; cookie end
- (match-string 2) ; percent?
- (cond ; boxes count
- ;; Cookie is at an heading, but specifically for todo,
- ;; not for checkboxes: skip it.
- ((and (org-at-heading-p)
- (string-match "\\<todo\\>"
- (downcase
- (or (org-entry-get nil "COOKIE_DATA") ""))))
- (throw 'skip nil))
- ;; Cookie is at an heading, but all lists before next
- ;; heading already have been read. Use data collected
- ;; in STRUCTS-BAK. This should only happen when
- ;; heading has more than one cookie on it.
- ((and (org-at-heading-p)
- (<= (save-excursion (outline-next-heading) (point))
- backup-end))
- (funcall count-boxes nil structs-bak recursivep))
- ;; Cookie is at a fresh heading. Grab structure of
- ;; every list containing a checkbox between point and
- ;; next headline, and save them in STRUCTS-BAK.
- ((org-at-heading-p)
- (setq backup-end (save-excursion
- (outline-next-heading) (point))
- structs-bak nil)
- (while (org-list-search-forward box-re backup-end 'move)
- (let* ((struct (org-list-struct))
- (bottom (org-list-get-bottom-point struct)))
- (push struct structs-bak)
- (goto-char bottom)))
- (funcall count-boxes nil structs-bak recursivep))
- ;; Cookie is at an item, and we already have list
- ;; structure stored in STRUCTS-BAK.
- ((and (org-at-item-p)
- (< (point-at-bol) backup-end)
- ;; Only lists in no special context are stored.
- (not (nth 2 (org-list-context))))
- (funcall count-boxes (point-at-bol) structs-bak recursivep))
- ;; Cookie is at an item, but we need to compute list
- ;; structure.
- ((org-at-item-p)
- (let ((struct (org-list-struct)))
- (setq backup-end (org-list-get-bottom-point struct)
- structs-bak (list struct)))
- (funcall count-boxes (point-at-bol) structs-bak recursivep))
- ;; Else, cookie found is at a wrong place. Skip it.
- (t (throw 'skip nil))))
- cookies-list))))
- ;; 2. Apply alist to buffer, in reverse order so positions stay
- ;; unchanged after cookie modifications.
- (mapc (lambda (cookie)
- (let* ((beg (car cookie))
- (end (nth 1 cookie))
- (percentp (nth 2 cookie))
- (checked (car (nth 3 cookie)))
- (total (cdr (nth 3 cookie)))
- (new (if percentp
- (format "[%d%%]" (/ (* 100 checked)
- (max 1 total)))
- (format "[%d/%d]" checked total))))
- (goto-char beg)
- (insert new)
- (delete-region (point) (+ (point) (- end beg)))
- (when org-auto-align-tags (org-fix-tags-on-the-fly))))
+ (lambda (item structs recursivep)
+ ;; Return number of checked boxes and boxes of all types
+ ;; in all structures in STRUCTS. If RECURSIVEP is
+ ;; non-nil, also count boxes in sub-lists. If ITEM is
+ ;; nil, count across the whole structure, else count only
+ ;; across subtree whose ancestor is ITEM.
+ (let ((c-on 0) (c-all 0))
+ (dolist (s structs (list c-on c-all))
+ (let* ((pre (org-list-prevs-alist s))
+ (par (org-list-parents-alist s))
+ (items
+ (cond
+ ((and recursivep item) (org-list-get-subtree item s))
+ (recursivep (mapcar #'car s))
+ (item (org-list-get-children item s par))
+ (t (org-list-get-all-items
+ (org-list-get-top-point s) s pre))))
+ (cookies (delq nil (mapcar
+ (lambda (e)
+ (org-list-get-checkbox e s))
+ items))))
+ (incf c-all (length cookies))
+ (incf c-on (org-count "[X]" cookies)))))))
+ cookies-list cache)
+ ;; Move to start.
+ (cond (all (goto-char (point-min)))
+ (within-inlinetask (org-back-to-heading t))
+ (t (org-with-limited-levels (outline-previous-heading))))
+ ;; Build an alist for each cookie found. The key is the position
+ ;; at beginning of cookie and values ending position, format of
+ ;; cookie, number of checked boxes to report and total number of
+ ;; boxes.
+ (while (re-search-forward cookie-re end t)
+ (let ((context (save-excursion (backward-char)
+ (save-match-data (org-element-context)))))
+ (when (eq (org-element-type context) 'statistics-cookie)
+ (push
+ (append
+ (list (match-beginning 1) (match-end 1) (match-end 2))
+ (let* ((container
+ (org-element-lineage
+ context
+ '(drawer center-block dynamic-block inlinetask plain-list
+ quote-block special-block verse-block)))
+ (beg (if container (org-element-property :begin container)
+ (save-excursion
+ (org-with-limited-levels (outline-previous-heading))
+ (point)))))
+ (or (cdr (assq beg cache))
+ (save-excursion
+ (goto-char beg)
+ (let ((end
+ (if container (org-element-property :end container)
+ (save-excursion
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ structs)
+ (while (re-search-forward box-re end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'item)
+ (push (org-element-property :structure element)
+ structs)
+ (goto-char (org-element-property
+ :end
+ (org-element-property :parent
+ element))))))
+ ;; Cache count for cookies applying to the same
+ ;; area. Then return it.
+ (let ((count
+ (funcall count-boxes
+ (and (eq (org-element-type container)
+ 'plain-list)
+ (org-element-property
+ :contents-begin container))
+ structs
+ recursivep)))
+ (push (cons beg count) cache)
+ count))))))
cookies-list))))
+ ;; Apply alist to buffer.
+ (dolist (cookie cookies-list)
+ (let* ((beg (car cookie))
+ (end (nth 1 cookie))
+ (percent (nth 2 cookie))
+ (checked (nth 3 cookie))
+ (total (nth 4 cookie)))
+ (goto-char beg)
+ (insert
+ (if percent (format "[%d%%]" (floor (* 100.0 checked)
+ (max 1 total)))
+ (format "[%d/%d]" checked total)))
+ (delete-region (point) (+ (point) (- end beg)))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly)))))))
(defun org-get-checkbox-statistics-face ()
"Select the face for checkbox statistics.
@@ -2749,6 +2763,7 @@ If a region is active, all items inside will be moved."
(t (error "Not at an item")))))
(defvar org-tab-ind-state)
+(defvar org-adapt-indentation)
(defun org-cycle-item-indentation ()
"Cycle levels of indentation of an empty item.
The first run indents the item, if applicable. Subsequent runs
@@ -2940,13 +2955,13 @@ will be parsed as:
\(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
- parse-item ; for byte-compiler
(get-text
(function
;; Return text between BEG and END, trimmed, with
@@ -3056,7 +3071,7 @@ for this list."
(unless (org-at-item-p) (error "Not at a list item"))
(save-excursion
(re-search-backward "#\\+ORGLST" nil t)
- (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)")
+ (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))
@@ -3072,7 +3087,7 @@ for this list."
(re-search-forward (org-item-beginning-re) bottom-point t)
(match-beginning 0)))
(plain-list (buffer-substring-no-properties top-point bottom-point))
- beg txt)
+ beg)
(unless (fboundp transform)
(error "No such transformation function %s" transform))
(let ((txt (funcall transform plain-list)))
@@ -3082,7 +3097,8 @@ for this list."
(unless (re-search-forward
(concat "BEGIN RECEIVE ORGLST +"
name
- "\\([ \t]\\|$\\)") nil t)
+ "\\([ \t]\\|$\\)")
+ nil t)
(error "Don't know where to insert translated list"))
(goto-char (match-beginning 0))
(beginning-of-line 2)
@@ -3195,13 +3211,13 @@ items."
(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]+::" first))
+ (let* ((complete
+ (string-match "^\\(.*\\)[ \t]+::[ \t]*" first))
(term (if complete
(save-match-data
(org-trim (match-string 1 first)))
"???"))
- (desc (if complete
- (org-trim (substring first (match-end 0)))
+ (desc (if complete (substring first (match-end 0))
first)))
(setq first (concat (eval dtstart) term (eval dtend)
(eval ddstart) desc))))
@@ -3230,7 +3246,7 @@ items."
items (or (eval isep) ""))))))))
(concat (funcall export-sublist list 0) "\n")))
-(defun org-list-to-latex (list &optional params)
+(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."
@@ -3244,7 +3260,7 @@ syntax. Return converted list as a string."
(require 'ox-html)
(org-export-string-as list 'html t))
-(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."
@@ -3255,14 +3271,15 @@ syntax. Return converted list as a string."
"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)))
(level (org-reduced-level (or (org-current-level) 0)))
- (blankp (or (eq rule t)
+ (org--blankp (or (eq rule t)
(and (eq rule 'auto)
(save-excursion
(outline-previous-heading)
(org-previous-line-empty-p)))))
- (get-stars
+ (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.
@@ -3277,12 +3294,12 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice t
- :dtstart " " :dtend " "
- :istart (funcall get-stars depth)
- :icount (funcall get-stars depth)
- :isep (if blankp "\n\n" "\n")
- :csep (if blankp "\n\n" "\n")
- :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
+ :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")
params))))
(provide 'org-list)
diff --git a/lisp/org-loaddefs.el b/lisp/org-loaddefs.el
index 4f937cc..a05f6ed 100644
--- a/lisp/org-loaddefs.el
+++ b/lisp/org-loaddefs.el
@@ -8,13 +8,13 @@
;;;;;; 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-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" "81e011c3c1419cbf51b1656694bf42f8")
+;;;;;; 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" "27b1718c5a3754547f6de3163c7729c5")
;;; Generated autoloads from ob-core.el
(autoload 'org-babel-execute-safely-maybe "ob-core" "\
@@ -88,7 +88,7 @@ Check for misspelled header arguments in the current code block.
(autoload 'org-babel-insert-header-arg "ob-core" "\
Insert a header argument selecting from lists of common args and values.
-\(fn)" t nil)
+\(fn &optional HEADER-ARG VALUE)" t nil)
(autoload 'org-babel-load-in-session "ob-core" "\
Load the body of the current source-code block.
@@ -119,6 +119,12 @@ Switch to code buffer and display session.
\(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))
+
(autoload 'org-babel-open-src-block-result "ob-core" "\
If `point' is on a src block then open the results of the
source code block, otherwise return nil. With optional prefix
@@ -229,7 +235,7 @@ Mark current src block.
;;;***
;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "ob-keys.el"
-;;;;;; "25a1e7a65f088c34d9576789abaaebc6")
+;;;;;; "1fce4dfc8c9bc9770247390ec93adcef")
;;; Generated autoloads from ob-keys.el
(autoload 'org-babel-describe-bindings "ob-keys" "\
@@ -240,7 +246,7 @@ Describe all keybindings behind `org-babel-key-prefix'.
;;;***
;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe)
-;;;;;; "ob-lob" "ob-lob.el" "6452edf7fff14c5ebb5c1cece08ba833")
+;;;;;; "ob-lob" "ob-lob.el" "dc5eea39f8ebcd4f8965f663f02abfa9")
;;; Generated autoloads from ob-lob.el
(autoload 'org-babel-lob-execute-maybe "ob-lob" "\
@@ -258,7 +264,7 @@ Return a Library of Babel function call as a string.
;;;***
;;;### (autoloads (org-babel-tangle org-babel-tangle-file) "ob-tangle"
-;;;;;; "ob-tangle.el" "1fc39a5a416a66ab63a506ccc0a122ff")
+;;;;;; "ob-tangle.el" "c9a4c888ee47a00c4b16e7c06a9da2fb")
;;; Generated autoloads from ob-tangle.el
(autoload 'org-babel-tangle-file "ob-tangle" "\
@@ -292,7 +298,7 @@ used to limit the exported source code blocks by language.
;;;;;; 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"
-;;;;;; (21562 65218))
+;;;;;; (21953 39595))
;;; Generated autoloads from org-agenda.el
(autoload 'org-toggle-sticky-agenda "org-agenda" "\
@@ -568,7 +574,7 @@ to override `appt-message-warning-time'.
;;;### (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" "9a54b246691497eb10c911c2c12f9742")
+;;;;;; "org-archive.el" "dd008794802cf282283f2eaea0be6472")
;;; Generated autoloads from org-archive.el
(autoload 'org-add-archive-files "org-archive" "\
@@ -584,9 +590,11 @@ The archive can be a certain top-level heading in the current file, or in
a different file. The tree will be moved to that location, the subtree
heading be marked DONE, and the current time will be added.
-When called with prefix argument FIND-DONE, find whole trees without any
+When called with a single prefix argument FIND-DONE, find whole trees without any
open TODO items and archive them (after getting confirmation from the user).
-If the cursor is not at a headline when this command is called, try all level
+When called with a double prefix argument, find whole trees with timestamps before
+today and archive them (after getting confirmation from the user).
+If the cursor is not at a headline when these commands are called, try all level
1 trees. If the cursor is on a headline, only try the direct children of
this heading.
@@ -621,7 +629,7 @@ This command is set with the variable `org-archive-default-command'.
;;;***
-;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "5ca6eaa6ba7fa7c7eddc8d339f2a2170")
+;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "87e6c32edc4111854e92b00480f6c067")
;;; Generated autoloads from org-attach.el
(autoload 'org-attach "org-attach" "\
@@ -633,7 +641,7 @@ Shows a list of commands and prompts for another key to execute a command.
;;;***
;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org-bbdb.el"
-;;;;;; "5fed335fd36cec704d37da4b5f5d54a7")
+;;;;;; "9c763cddfbb993fadd3201dfb83142cc")
;;; Generated autoloads from org-bbdb.el
(autoload 'org-bbdb-anniversaries "org-bbdb" "\
@@ -644,8 +652,8 @@ Extract anniversaries from BBDB for display in the agenda.
;;;***
;;;### (autoloads (org-capture-import-remember-templates org-capture
-;;;;;; org-capture-string) "org-capture" "org-capture.el" (21562
-;;;;;; 3391))
+;;;;;; org-capture-string) "org-capture" "org-capture.el" (21953
+;;;;;; 39595))
;;; Generated autoloads from org-capture.el
(autoload 'org-capture-string "org-capture" "\
@@ -692,7 +700,7 @@ Set `org-capture-templates' to be similar to `org-remember-templates'.
;;;;;; 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"
-;;;;;; "32564b628bbb84d0342715e3d7097a29")
+;;;;;; "31fb247d73be8ef0f10b058807e0f204")
;;; Generated autoloads from org-clock.el
(autoload 'org-resolve-clocks "org-clock" "\
@@ -756,16 +764,19 @@ each headline in the time range with point at the headline. Headlines for
which HEADLINE-FILTER returns nil are excluded from the clock summation.
PROPNAME lets you set a custom text property instead of :org-clock-minutes.
-\(fn &optional TSTART TEND HEADLINE-FILTER PROPNAME)" t nil)
+\(fn &optional TSTART TEND HEADLINE-FILTER PROPNAME)" nil nil)
(autoload 'org-clock-display "org-clock" "\
Show subtree times in the entire buffer.
-If TOTAL-ONLY is non-nil, only show the total time for the entire file
-in the echo area.
+
+With one universal prefix argument, show the total time for
+today. With two universal prefix arguments, show the total time
+for a custom range, entered at the prompt. With three universal
+prefix arguments, show the total time in the echo area.
Use \\[org-clock-remove-overlays] to remove the subtree times.
-\(fn &optional TOTAL-ONLY)" t nil)
+\(fn &optional ARG)" t nil)
(autoload 'org-clock-remove-overlays "org-clock" "\
Remove the occur highlights from the buffer.
@@ -821,7 +832,7 @@ Otherwise, return nil.
;;;### (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" (21562 3391))
+;;;;;; "org-colview" "org-colview.el" (21953 39608))
;;; Generated autoloads from org-colview.el
(autoload 'org-columns-remove-overlays "org-colview" "\
@@ -885,7 +896,7 @@ Turn on or update column view in the agenda.
;;;***
;;;### (autoloads (org-check-version) "org-compat" "org-compat.el"
-;;;;;; (21562 3391))
+;;;;;; (21953 39595))
;;; Generated autoloads from org-compat.el
(autoload 'org-check-version "org-compat" "\
@@ -909,22 +920,34 @@ tree can be found.
;;;***
-;;;### (autoloads (org-element-context org-element-at-point org-element-interpret-data)
-;;;;;; "org-element" "org-element.el" "40b84110bb3b104027a4d7ca4fda8d30")
+;;;### (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" "fb24e830f6df86a96975959e67d14086")
;;; Generated autoloads from org-element.el
+(autoload 'org-element-update-syntax "org-element" "\
+Update parser internals.
+
+\(fn)" t nil)
+
(autoload 'org-element-interpret-data "org-element" "\
Interpret DATA as Org syntax.
-
DATA is a parse tree, an element, an object or a secondary string
-to interpret.
+to interpret. Return Org syntax as a string.
+
+\(fn DATA)" nil nil)
-Optional argument PARENT is used for recursive calls. It contains
-the element or object containing data, or nil.
+(autoload 'org-element-cache-reset "org-element" "\
+Reset cache in current buffer.
+When optional argument ALL is non-nil, reset cache in all Org
+buffers.
-Return Org syntax as a string.
+\(fn &optional ALL)" t nil)
-\(fn DATA &optional PARENT)" nil nil)
+(autoload 'org-element-cache-refresh "org-element" "\
+Refresh cache at position POS.
+
+\(fn POS)" nil nil)
(autoload 'org-element-at-point "org-element" "\
Determine closest element around point.
@@ -937,22 +960,19 @@ Possible types are defined in `org-element-all-elements'.
Properties depend on element or object type, but always include
`:begin', `:end', `:parent' and `:post-blank' properties.
-As a special case, if point is at the very beginning of a list or
-sub-list, returned element will be that list instead of the first
-item. In the same way, if point is at the beginning of the first
-row of a table, returned element will be the table instead of the
-first row.
+As a special case, if point is at the very beginning of the first
+item in a list or sub-list, returned element will be that list
+instead of the item. Likewise, if point is at the beginning of
+the first row of a table, returned element will be the table
+instead of the first row.
-If optional argument KEEP-TRAIL is non-nil, the function returns
-a list of elements leading to element at point. The list's CAR
-is always the element at point. The following positions contain
-element's siblings, then parents, siblings of parents, until the
-first element of current section.
+When point is at the end of the buffer, return the innermost
+element ending there.
-\(fn &optional KEEP-TRAIL)" nil nil)
+\(fn)" nil nil)
(autoload 'org-element-context "org-element" "\
-Return closest element or object around point.
+Return smallest element or object around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element or object and PROPS a plist of properties
@@ -963,6 +983,9 @@ Possible types are defined in `org-element-all-elements' and
object type, but always include `:begin', `:end', `:parent' and
`:post-blank'.
+As a special case, if point is right after an object and not at
+the beginning of any other object, return that object.
+
Optional argument ELEMENT, when non-nil, is the closest element
containing point, as returned by `org-element-at-point'.
Providing it allows for quicker computation.
@@ -972,7 +995,7 @@ Providing it allows for quicker computation.
;;;***
;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update
-;;;;;; org-feed-update-all) "org-feed" "org-feed.el" "d29a33e181e81cddc70543c0ba8fdbe4")
+;;;;;; org-feed-update-all) "org-feed" "org-feed.el" "7276e68d6993fe39cd340cbd5af3faed")
;;; Generated autoloads from org-feed.el
(autoload 'org-feed-update-all "org-feed" "\
@@ -1000,7 +1023,7 @@ Show the raw feed buffer of a feed.
;;;***
;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote"
-;;;;;; "org-footnote.el" "9906c2a4ea425a7c96d7c1371b2e35f9")
+;;;;;; "org-footnote.el" "8993166fd3c05349a3031b75152b4ae4")
;;; Generated autoloads from org-footnote.el
(autoload 'org-footnote-action "org-footnote" "\
@@ -1012,9 +1035,10 @@ 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.
+interactively if possible.
-With prefix arg SPECIAL, offer additional commands in a menu.
+With prefix arg SPECIAL, or when no footnote can be created,
+offer additional commands in a menu.
\(fn &optional SPECIAL)" t nil)
@@ -1156,7 +1180,7 @@ Dispatch to the appropriate function to store a link to an IRC session.
;;;***
;;;### (autoloads (org-load-noerror-mustsuffix) "org-macs" "org-macs.el"
-;;;;;; (21562 3391))
+;;;;;; (21953 39595))
;;; Generated autoloads from org-macs.el
(autoload 'org-load-noerror-mustsuffix "org-macs" "\
@@ -1167,7 +1191,7 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a
;;;***
;;;### (autoloads (org-mobile-pull org-mobile-push) "org-mobile"
-;;;;;; "org-mobile.el" "c2e770357d2065c4eba6fc96b5c17573")
+;;;;;; "org-mobile.el" "74e62a65b33ac841139cfd3f5e0b2607")
;;; Generated autoloads from org-mobile.el
(autoload 'org-mobile-push "org-mobile" "\
@@ -1186,7 +1210,7 @@ agenda view showing the flagged items.
;;;***
-;;;### (autoloads (org-plot/gnuplot) "org-plot" "org-plot.el" "62748a5b07b07d7afa43d16955d0b294")
+;;;### (autoloads (org-plot/gnuplot) "org-plot" "org-plot.el" "d127faa9ca32ef2814c5542901d23e1b")
;;; Generated autoloads from org-plot.el
(autoload 'org-plot/gnuplot "org-plot" "\
@@ -1198,13 +1222,13 @@ line directly before or after the table.
;;;***
-;;;### (autoloads (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
+;;;### (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-set-constants
-;;;;;; org-table-eval-formula org-table-maybe-recalculate-line org-table-rotate-recalc-marks
+;;;;;; 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
@@ -1219,7 +1243,7 @@ line directly before or after the table.
;;;;;; 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"
-;;;;;; "9b6e8818ec6951cc97eba4e5d0822cef")
+;;;;;; "3c552212688594ce7023f85d4896c1ce")
;;; Generated autoloads from org-table.el
(autoload 'org-table-create-with-table\.el "org-table" "\
@@ -1255,7 +1279,9 @@ following values:
'(4) Use the comma as a field separator
'(16) Use a TAB as field separator
+'(64) Prompt for a regular expression as field separator
integer When a number, use that many spaces as field separator
+regexp When a regular expression, use it to match the separator
nil When nil, the command tries to be smart and figure out the
separator in the following way:
- when each line contains a TAB, assume TAB-separated material
@@ -1296,13 +1322,17 @@ Align the table at point by aligning all vertical bars.
(autoload 'org-table-begin "org-table" "\
Find the beginning of the table and return its position.
-With argument TABLE-TYPE, go to the beginning of a table.el-type table.
+With a non-nil optional argument TABLE-TYPE, return the beginning
+of a table.el-type table. This function assumes point is on
+a table.
\(fn &optional TABLE-TYPE)" nil nil)
(autoload 'org-table-end "org-table" "\
Find the end of the table and return its position.
-With argument TABLE-TYPE, go to the end of a table.el-type table.
+With a non-nil optional argument TABLE-TYPE, return the end of
+a table.el-type table. This function assumes point is on
+a table.
\(fn &optional TABLE-TYPE)" nil nil)
@@ -1331,16 +1361,22 @@ Before doing so, re-align the table if necessary.
\(fn)" t nil)
(autoload 'org-table-copy-down "org-table" "\
-Copy a field down in the current column.
-If the field at the cursor is empty, copy into it the content of
-the nearest non-empty field above. With argument N, use the Nth
-non-empty field. If the current field is not empty, it is copied
-down to the next row, and the cursor is moved with it.
-Therefore, repeating this command causes the column to be filled
-row-by-row.
+Copy the value of the current field one row below.
+
+If the field at the cursor is empty, copy the content of the
+nearest non-empty field above. With argument N, use the Nth
+non-empty field.
+
+If the current field is not empty, it is copied down to the next
+row, and the cursor is moved with it. Therefore, repeating this
+command causes the column to be filled row-by-row.
+
If the variable `org-table-copy-increment' is non-nil and the
field is an integer or a timestamp, it will be incremented while
-copying. In the case of a timestamp, increment by one day.
+copying. By default, increment by the difference between the
+value in the current field and the one in the field above. To
+increment using a fixed integer, set `org-table-copy-increment'
+to a number. In the case of a timestamp, increment by days.
\(fn N)" t nil)
@@ -1444,16 +1480,24 @@ should be in the last line to be included into the sorting.
The command then prompts for the sorting type which can be
alphabetically, numerically, or by time (as given in a time stamp
-in the field). Sorting in reverse order is also possible.
+in the field, or as a HH:MM value). Sorting in reverse order is
+also possible.
With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
If SORTING-TYPE is specified when this function is called from a Lisp
program, no prompting will take place. SORTING-TYPE must be a character,
-any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting
-should be done in reverse order.
+any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that
+sorting should be done in reverse order.
+
+If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
+a function to be called to extract the key. It must return either
+a string or a number that should serve as the sorting key for that
+row. It will then use COMPARE-FUNC to compare entries. If GETKEY-FUNC
+is specified interactively, the comparison will be either a string or
+numeric compare based on the type of the first key in the table.
-\(fn WITH-CASE &optional SORTING-TYPE)" t nil)
+\(fn WITH-CASE &optional SORTING-TYPE GETKEY-FUNC COMPARE-FUNC)" t nil)
(autoload 'org-table-cut-region "org-table" "\
Copy region in table to the clipboard and blank all relevant fields.
@@ -1497,7 +1541,7 @@ lines, in order to keep the table compact.
If there is an active region, and both point and mark are in the same column,
the text in the column is wrapped to minimum width for the given number of
lines. Generally, this makes the table more compact. A prefix ARG may be
-used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]'
+used to change the number of desired lines. For example, `C-2 \\[org-table-wrap-region]'
formats the selected text to two lines. If the region was longer than two
lines, the remaining lines remain empty. A negative prefix argument reduces
the current number of lines by that amount. The wrapped text is pasted back
@@ -1562,6 +1606,23 @@ of the new mark.
\(fn &optional NEWCHAR)" t nil)
+(autoload 'org-table-analyze "org-table" "\
+Analyze table at point and store results.
+
+This function sets up the following dynamically scoped variables:
+
+ `org-table-column-name-regexp',
+ `org-table-column-names',
+ `org-table-current-begin-pos',
+ `org-table-current-line-types',
+ `org-table-current-ncol',
+ `org-table-dlines',
+ `org-table-hlines',
+ `org-table-local-parameters',
+ `org-table-named-field-locations'.
+
+\(fn)" nil nil)
+
(autoload 'org-table-maybe-recalculate-line "org-table" "\
Recompute the current line if marked for it, and if we haven't just done it.
@@ -1606,11 +1667,6 @@ not overwrite the stored one.
\(fn &optional ARG EQUATION SUPPRESS-ALIGN SUPPRESS-CONST SUPPRESS-STORE SUPPRESS-ANALYSIS)" t nil)
-(autoload 'org-table-set-constants "org-table" "\
-Set `org-table-formula-constants-local' in the current buffer.
-
-\(fn)" nil 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.
@@ -1659,6 +1715,9 @@ The `org-mode' table editor as a minor mode for use in other modes.
\(fn &optional ARG)" t nil)
+(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" "\
+Regular expression matching exponentials as produced by calc.")
+
(autoload 'org-table-to-lisp "org-table" "\
Convert the table at point to a Lisp structure.
The structure will be a list. Each item is either the symbol `hline'
@@ -1669,68 +1728,105 @@ The table is taken from the parameter TXT, or from the buffer at point.
(autoload 'orgtbl-to-generic "org-table" "\
Convert the orgtbl-mode TABLE to some other format.
+
This generic routine can be used for many standard cases.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-A third optional argument BACKEND can be used to convert the content of
-the cells using a specific export back-end.
-For the generic converter, some parameters are obligatory: you need to
-specify either :lfmt, or all of (:lstart :lend :sep).
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that
+line. PARAMS is a property list of parameters that can
+influence the conversion.
Valid parameters are:
-:splice When set to t, return only table body lines, don't wrap
- them into :tstart and :tend. Default is nil. When :splice
- is non-nil, this also means that the exporter should not look
- for and interpret header and footer sections.
+:backend, :raw
+
+ Export back-end used as a basis to transcode elements of the
+ table, when no specific parameter applies to it. It is also
+ used to translate cells contents. You can prevent this by
+ setting :raw property to a non-nil value.
+
+:splice
+
+ When non-nil, only convert rows, not the table itself. This is
+ equivalent to setting to the empty string both :tstart
+ and :tend, which see.
-:hline String to be inserted on horizontal separation lines.
- May be nil to ignore hlines.
+:skip
-:sep Separator between two fields
-:remove-nil-lines Do not include lines that evaluate to nil.
+ When set to an integer N, skip the first N lines of the table.
+ Horizontal separation lines do count for this parameter!
+
+:skipcols
+
+ List of columns that should be skipped. If the table has
+ a column with calculation marks, that column is automatically
+ discarded beforehand.
+
+:hline
+
+ String to be inserted on horizontal separation lines. May be
+ nil to ignore these lines altogether.
+
+:sep
+
+ Separator between two fields, as a string.
Each in the following group may be either a string or a function
of no arguments returning a string:
-:tstart String to start the table. Ignored when :splice is t.
-:tend String to end the table. Ignored when :splice is t.
-:lstart String to start a new table line.
-:llstart String to start the last table line, defaults to :lstart.
-:lend String to end a table line
-:llend String to end the last table line, defaults to :lend.
-
-Each in the following group may be a string, a function of one
-argument (the field or line) returning a string, or a plist
-mapping columns to either of the above:
-
-:lfmt Format for entire line, with enough %s to capture all fields.
- If this is present, :lstart, :lend, and :sep are ignored.
-:llfmt Format for the entire last line, defaults to :lfmt.
-:fmt A format to be used to wrap the field, should contain
- %s for the original field value. For example, to wrap
- everything in dollars, you could use :fmt \"$%s$\".
- This may also be a property list with column numbers and
- formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
-:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt
- Same as above, specific for the header lines in the table.
- All lines before the first hline are treated as header.
- If any of these is not present, the data line value is used.
+:tstart, :tend
+
+ Strings to start and end the table. Ignored when :splice is t.
+
+:lstart, :lend
+
+ Strings to start and end a new table line.
+
+:llstart, :llend
+
+ Strings to start and end the last table line. Default,
+ respectively, to :lstart and :lend.
+
+Each in the following group may be a string or a function of one
+argument (either the cells in the current row, as a list of
+strings, or the current cell) returning a string:
+
+:lfmt
+
+ Format string for an entire row, with enough %s to capture all
+ fields. When non-nil, :lstart, :lend, and :sep are ignored.
+
+:llfmt
+
+ Format for the entire last line, defaults to :lfmt.
+
+:fmt
+
+ A format to be used to wrap the field, should contain %s for
+ the original field value. For example, to wrap everything in
+ dollars, you could use :fmt \"$%s$\". This may also be
+ a property list with column numbers and format strings, or
+ functions, e.g.,
+
+ (:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
+
+:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt
+
+ Same as above, specific for the header lines in the table.
+ All lines before the first hline are treated as header. If
+ any of these is not present, the data line value is used.
This may be either a string or a function of two arguments:
-:efmt Use this format to print numbers with exponentials.
- The format should have %s twice for inserting mantissa
- and exponent, for example \"%s\\\\times10^{%s}\". This
- may also be a property list with column numbers and
- formats. :fmt will still be applied after :efmt.
+:efmt
-In addition to this, the parameters :skip and :skipcols are always handled
-directly by `orgtbl-send-table'. See manual.
+ Use this format to print numbers with exponential. The format
+ should have %s twice for inserting mantissa and exponent, for
+ example \"%s\\\\times10^{%s}\". This may also be a property
+ list with column numbers and format strings or functions.
+ :fmt will still be applied after :efmt.
-\(fn TABLE PARAMS &optional BACKEND)" nil nil)
+\(fn TABLE PARAMS)" nil nil)
(autoload 'orgtbl-to-tsv "org-table" "\
Convert the orgtbl-mode table to TAB separated material.
@@ -1745,92 +1841,86 @@ This does take care of the proper quoting of fields with comma or quotes.
(autoload 'orgtbl-to-latex "org-table" "\
Convert the orgtbl-mode TABLE to LaTeX.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Supports all parameters from `orgtbl-to-generic'. Most important for
-LaTeX are:
-:splice When set to t, return only table body lines, don't wrap
- them into a tabular environment. Default is nil.
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following ones:
-:fmt A format to be used to wrap the field, should contain %s for the
- original field value. For example, to wrap everything in dollars,
- use :fmt \"$%s$\". This may also be a property list with column
- numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
- The format may also be a function that formats its one argument.
+:booktabs
-:efmt Format for transforming numbers with exponentials. The format
- should have %s twice for inserting mantissa and exponent, for
- example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\".
- This may also be a property list with column numbers and formats.
- The format may also be a function that formats its two arguments.
+ When non-nil, use formal \"booktabs\" style.
-:llend If you find too much space below the last line of a table,
- pass a value of \"\" for :llend to suppress the final \\\\.
+:environment
-The general parameters :skip and :skipcols have already been applied when
-this function is called.
+ Specify environment to use, as a string. If you use
+ \"longtable\", you may also want to specify :language property,
+ as a string, to get proper continuation strings.
\(fn TABLE PARAMS)" nil nil)
(autoload 'orgtbl-to-html "org-table" "\
Convert the orgtbl-mode TABLE to HTML.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Currently this function recognizes the following parameters:
-:splice When set to t, return only table body lines, don't wrap
- them into a <table> environment. Default is nil.
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following one:
-The general parameters :skip and :skipcols have already been applied when
-this function is called. The function does *not* use `orgtbl-to-generic',
-so you cannot specify parameters for it.
+:attributes
+
+ Attributes and values, as a plist, which will be used in
+ <table> tag.
\(fn TABLE PARAMS)" nil nil)
(autoload 'orgtbl-to-texinfo "org-table" "\
-Convert the orgtbl-mode TABLE to TeXInfo.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Supports all parameters from `orgtbl-to-generic'. Most important for
-TeXInfo are:
-
-:splice nil/t When set to t, return only table body lines, don't wrap
- them into a multitable environment. Default is nil.
-
-:fmt fmt A format to be used to wrap the field, should contain
- %s for the original field value. For example, to wrap
- everything in @kbd{}, you could use :fmt \"@kbd{%s}\".
- This may also be a property list with column numbers and
- formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\").
- Each format also may be a function that formats its one
- argument.
-
-:cf \"f1 f2..\" The column fractions for the table. By default these
- are computed automatically from the width of the columns
- under org-mode.
-
-The general parameters :skip and :skipcols have already been applied when
-this function is called.
+Convert the orgtbl-mode TABLE to Texinfo.
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following one:
+
+:columns
+
+ Column widths, as a string. When providing column fractions,
+ \"@columnfractions\" command can be omitted.
\(fn TABLE PARAMS)" nil nil)
(autoload 'orgtbl-to-orgtbl "org-table" "\
Convert the orgtbl-mode TABLE into another orgtbl-mode table.
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported.
+
Useful when slicing one table into many. The :hline, :sep,
-:lstart, and :lend provide orgtbl framing. The default nil :tstart
-and :tend suppress strings without splicing; they can be set to
-provide ORGTBL directives for the generated table.
+:lstart, and :lend provide orgtbl framing. :tstart and :tend can
+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.
+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.
+
+\(fn &optional ASK)" t nil)
+
;;;***
;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region
-;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "54b0453041fa05a477a9da6054ed8b31")
+;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "9d49e9d50eb1f36a4ab176711617bb7c")
;;; Generated autoloads from org-timer.el
(autoload 'org-timer-start "org-timer" "\
@@ -1870,14 +1960,14 @@ Insert a description-type item with the current timer value.
\(fn &optional ARG)" t nil)
(autoload 'org-timer-set-timer "org-timer" "\
-Prompt for a duration and set a timer.
+Prompt for a duration in minutes or hh:mm:ss and set a timer.
-If `org-timer-default-timer' is not zero, suggest this value as
+If `org-timer-default-timer' is not \"0\", suggest this value as
the default duration for the timer. If a timer is already set,
prompt the user if she wants to replace it.
Called with a numeric prefix argument, use this numeric value as
-the duration of the timer.
+the duration of the timer in minutes.
Called with a `C-u' prefix arguments, use `org-timer-default-timer'
without prompting the user for a duration.
@@ -1886,12 +1976,16 @@ With two `C-u' prefix arguments, use `org-timer-default-timer'
without prompting the user for a duration and automatically
replace any running timer.
+By default, the timer duration will be set to the number of
+minutes in the Effort property, if any. You can ignore this by
+using three `C-u' prefix arguments.
+
\(fn &optional OPT)" t nil)
;;;***
;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el"
-;;;;;; (21562 65320))
+;;;;;; (21953 62521))
;;; Generated autoloads from org-version.el
(autoload 'org-release "org-version" "\
@@ -1917,7 +2011,7 @@ The location of ODT styles.")
;;;;;; 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" (21562 3391))
+;;;;;; "org" "org.el" (21953 39608))
;;; Generated autoloads from org.el
(autoload 'org-babel-do-load-languages "org" "\
@@ -1935,10 +2029,11 @@ file to byte-code before it is loaded.
\(fn FILE &optional COMPILE)" t nil)
(autoload 'org-version "org" "\
-Show the org-mode version in the echo area.
-With prefix argument HERE, insert it at point.
-When FULL is non-nil, use a verbose version string.
-When MESSAGE is non-nil, display a message with the version.
+Show the org-mode 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.
\(fn &optional HERE FULL MESSAGE)" t nil)
@@ -2061,16 +2156,16 @@ call CMD.
(autoload 'org-store-link "org" "\
\\<org-mode-map>Store an org-link to the current location.
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].
-For some link types, a 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'.
+For some link types, a 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
+A double prefix ARG force skipping storing functions that are not
part of Org's core.
-A triple prefix arg force storing a link for each line in the
+A triple prefix ARG force storing a link for each line in the
active region.
\(fn ARG)" t nil)
@@ -2140,7 +2235,7 @@ Call the customize function with org as argument.
;;;### (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" "8bba507846964285c7ecb40e66b6afe3")
+;;;;;; "ox-ascii" "ox-ascii.el" "7009055e46700dbb68151c69c95e7e90")
;;; Generated autoloads from ox-ascii.el
(autoload 'org-ascii-export-as-ascii "ox-ascii" "\
@@ -2241,9 +2336,9 @@ Return output file name.
;;;***
;;;### (autoloads (org-beamer-publish-to-pdf org-beamer-publish-to-latex
-;;;;;; org-beamer-insert-options-template 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" "6e708817388023e1e1df3de8f27188ce")
+;;;;;; 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"
+;;;;;; "fcf86747012a3c93318a8c76d7e6dae8")
;;; Generated autoloads from ox-beamer.el
(autoload 'org-beamer-mode "ox-beamer" "\
@@ -2354,11 +2449,6 @@ aid, but the tag does not have any semantic meaning.
\(fn)" t nil)
-(autoload 'org-beamer-insert-options-template "ox-beamer" "\
-Insert a settings template, to make sure users do this right.
-
-\(fn &optional KIND)" t nil)
-
(autoload 'org-beamer-publish-to-latex "ox-beamer" "\
Publish an Org file to a Beamer presentation (LaTeX).
@@ -2385,7 +2475,7 @@ Return output file name.
;;;### (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" "65604b7a2a80c70979b37eb44119d6f9")
+;;;;;; "ox-html" "ox-html.el" "5fc66ebdbfcdb365f9829aeee3ea9cdf")
;;; Generated autoloads from ox-html.el
(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
@@ -2493,7 +2583,7 @@ Return output file name.
;;;### (autoloads (org-icalendar-combine-agenda-files org-icalendar-export-agenda-files
;;;;;; org-icalendar-export-to-ics) "ox-icalendar" "ox-icalendar.el"
-;;;;;; "74a493ca40404cb8fd648526fd898b6f")
+;;;;;; "19a94da1c24f86d71442d4eddeca7bf6")
;;; Generated autoloads from ox-icalendar.el
(autoload 'org-icalendar-export-to-ics "ox-icalendar" "\
@@ -2545,7 +2635,7 @@ The file is stored under the name chosen in
;;;### (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" "6277aa86c5275b5aae6c2c2d578a04fb")
+;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "a0a2774cca9ba998c2c96498dc9c43e7")
;;; Generated autoloads from ox-latex.el
(autoload 'org-latex-export-as-latex "ox-latex" "\
@@ -2670,8 +2760,9 @@ Return output file name.
;;;***
-;;;### (autoloads (org-md-export-to-markdown org-md-convert-region-to-md
-;;;;;; org-md-export-as-markdown) "ox-md" "ox-md.el" "02d27e093680dff82b16ebedcda8cba8")
+;;;### (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" "aed5f0514558ef19cd7d064500334fd9")
;;; Generated autoloads from ox-md.el
(autoload 'org-md-export-as-markdown "ox-md" "\
@@ -2730,10 +2821,21 @@ Return output file's name.
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY)" t nil)
+(autoload 'org-md-publish-to-md "ox-md" "\
+Publish an org file to Markdown.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name.
+
+\(fn PLIST FILENAME PUB-DIR)" nil nil)
+
;;;***
;;;### (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" "688d009902f7a23ab86bb93a843abdf5")
+;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "dc1cbff3d250945dc07382e984ccd766")
;;; Generated autoloads from ox-odt.el
(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp)
@@ -2796,7 +2898,7 @@ using `org-open-file'.
;;;***
;;;### (autoloads (org-org-publish-to-org org-org-export-to-org org-org-export-as-org)
-;;;;;; "ox-org" "ox-org.el" "952b4282cdf7bddd86e2e7660934888f")
+;;;;;; "ox-org" "ox-org.el" "145aafa32bb230b10f3d751f58667b46")
;;; Generated autoloads from ox-org.el
(autoload 'org-org-export-as-org "ox-org" "\
@@ -2818,6 +2920,9 @@ first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
+When optional argument BODY-ONLY is non-nil, strip document
+keywords from output.
+
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
@@ -2826,7 +2931,7 @@ Export is done in a buffer named \"*Org ORG Export*\", which will
be displayed when `org-export-show-temporary-export-buffer' is
non-nil.
-\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY EXT-PLIST)" t nil)
+\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
(autoload 'org-org-export-to-org "ox-org" "\
Export current buffer to an org file.
@@ -2847,13 +2952,16 @@ first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
+When optional argument BODY-ONLY is non-nil, strip document
+keywords from output.
+
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
Return output file name.
-\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY EXT-PLIST)" t nil)
+\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
(autoload 'org-org-publish-to-org "ox-org" "\
Publish an org file to org.
@@ -2870,7 +2978,7 @@ Return output file name.
;;;### (autoloads (org-publish-current-project org-publish-current-file
;;;;;; org-publish-all org-publish) "ox-publish" "ox-publish.el"
-;;;;;; "e9f7e2ede20ea11ead21108abf19db90")
+;;;;;; "00f9feea8a4428e599e429136e990d7b")
;;; Generated autoloads from ox-publish.el
(defalias 'org-publish-project 'org-publish)
@@ -2914,7 +3022,7 @@ the project.
;;;***
;;;### (autoloads (org-texinfo-convert-region-to-texinfo org-texinfo-publish-to-texinfo)
-;;;;;; "ox-texinfo" "ox-texinfo.el" "ae3f8dd17715c8093138512ae3c347cc")
+;;;;;; "ox-texinfo" "ox-texinfo.el" "1648d91d4d39e779443c416e4680fc24")
;;; Generated autoloads from ox-texinfo.el
(autoload 'org-texinfo-publish-to-texinfo "ox-texinfo" "\
@@ -2940,7 +3048,7 @@ this command to convert it.
;;;### (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" "abbaf953c164e76b9957d5ea22f805c8")
+;;;;;; org-export-string-as org-export-as) "ox" "ox.el" "cfe1d1e32456aaf6f81d882d87ef49fc")
;;; Generated autoloads from ox.el
(autoload 'org-export-as "ox" "\
diff --git a/lisp/org-macro.el b/lisp/org-macro.el
index 5b89034..65795f6 100644
--- a/lisp/org-macro.el
+++ b/lisp/org-macro.el
@@ -1,6 +1,6 @@
;;; org-macro.el --- Macro Replacement Code for Org Mode
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -30,6 +30,10 @@
;; `org-macro-initialize-templates', which recursively calls
;; `org-macro--collect-macros' in order to read setup files.
+;; Argument in macros are separated with commas. Proper escaping rules
+;; are implemented in `org-macro-escape-arguments' and arguments can
+;; be extracted from a string with `org-macro-extract-arguments'.
+
;; Along with macros defined through #+MACRO: keyword, default
;; templates include the following hard-coded macros:
;; {{{time(format-string)}}}, {{{property(node-property)}}},
@@ -40,14 +44,20 @@
;;; Code:
(require 'org-macs)
+(require 'org-compat)
-(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-map "org-element"
+ (data types fun &optional info first-match no-recursion
+ with-affiliated))
+(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-type "org-element" (element))
-(declare-function org-remove-double-quotes "org" (s))
-(declare-function org-mode "org" ())
(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))
;;; Variables
@@ -118,12 +128,22 @@ function installs the following ones: \"property\",
(if old-template (setcdr old-template (cdr cell))
(push cell templates))))))
;; Install hard-coded macros.
- (mapc (lambda (cell) (funcall update-templates cell))
- (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))")
+ (mapc update-templates
+ (list (cons "property"
+ "(eval (save-excursion
+ (let ((l \"$2\"))
+ (when (org-string-nw-p l)
+ (condition-case _
+ (let ((org-link-search-must-match-exact-headline t))
+ (org-link-search l nil t))
+ (error
+ (error \"Macro property failed: cannot find location %s\"
+ l)))))
+ (org-entry-get nil \"$1\" 'selective)))")
(cons "time" "(eval (format-time-string \"$1\"))")))
(let ((visited-file (buffer-file-name (buffer-base-buffer))))
(when (and visited-file (file-exists-p visited-file))
- (mapc (lambda (cell) (funcall update-templates cell))
+ (mapc update-templates
(list (cons "input-file" (file-name-nondirectory visited-file))
(cons "modification-time"
(format "(eval (format-time-string \"$1\" '%s))"
@@ -155,38 +175,107 @@ default value. Return nil if no template was found."
;; Return string.
(format "%s" (or value ""))))))
-(defun org-macro-replace-all (templates)
+(defun org-macro-replace-all (templates &optional finalize keywords)
"Replace all macros in current buffer by their expansion.
+
TEMPLATES is an alist of templates used for expansion. See
-`org-macro-templates' for a buffer-local default value."
+`org-macro-templates' for a buffer-local default value.
+
+If optional arg FINALIZE is non-nil, raise an error if a macro is
+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."
(save-excursion
(goto-char (point-min))
- (let (record)
+ (let ((properties-regexp
+ (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords)))
+ record)
(while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
- (let ((object (org-element-context)))
- (when (eq (org-element-type object) 'macro)
- (let* ((value (org-macro-expand object templates))
- (begin (org-element-property :begin object))
+ (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
- object
- (org-element-property :args object))))
+ 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.
- (if (member signature record)
- (error "Circular macro expansion: %s"
- (org-element-property :key object))
- (when value
- (push signature record)
- (delete-region
- begin
- ;; Preserve white spaces after the macro.
- (progn (goto-char (org-element-property :end object))
- (skip-chars-backward " \t")
- (point)))
- ;; Leave point before replacement in case of recursive
- ;; expansions.
- (save-excursion (insert value)))))))))))
+ (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.
+ARGS are strings. Return value is a string with arguments
+properly escaped and separated with commas. This is the opposite
+of `org-macro-extract-arguments'."
+ (let ((s ""))
+ (dolist (arg (reverse args) (substring s 1))
+ (setq s
+ (concat
+ ","
+ (replace-regexp-in-string
+ "\\(\\\\*\\),"
+ (lambda (m)
+ (concat (make-string (1+ (* 2 (length (match-string 1 m)))) ?\\)
+ ","))
+ ;; If a non-terminal argument ends on backslashes, make
+ ;; sure to also escape them as they will be followed by
+ ;; a comma.
+ (concat arg (and (not (equal s ""))
+ (string-match "\\\\+\\'" arg)
+ (match-string 0 arg)))
+ nil t)
+ s)))))
+
+(defun org-macro-extract-arguments (s)
+ "Extract macro arguments from string S.
+S is a string containing comma separated values properly escaped.
+Return a list of arguments, as strings. This is the opposite of
+`org-macro-escape-arguments'."
+ ;; Do not use `org-split-string' since empty strings are
+ ;; meaningful here.
+ (split-string
+ (replace-regexp-in-string
+ "\\(\\\\*\\),"
+ (lambda (str)
+ (let ((len (length (match-string 1 str))))
+ (concat (make-string (/ len 2) ?\\)
+ (if (zerop (mod len 2)) "\000" ","))))
+ s nil t)
+ "\000"))
(provide 'org-macro)
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 96265ec..a4af386 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -33,7 +33,7 @@
(eval-and-compile
(unless (fboundp 'declare-function)
- (defmacro declare-function (fn file &optional arglist fileonly)
+ (defmacro declare-function (fn file &optional _arglist _fileonly)
`(autoload ',fn ,file)))
(if (>= emacs-major-version 23)
@@ -48,13 +48,14 @@
(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)
- `(,s (make-symbol (concat "--" (symbol-name ',s))))) symbols)
+ `(,s (make-symbol (concat "--" (symbol-name ',s)))))
+ symbols)
,@body))
-(def-edebug-spec org-with-gensyms (sexp body))
-(put 'org-with-gensyms 'lisp-indent-function 1)
(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)
@@ -63,17 +64,17 @@
;; defined with no argument in <=23.1
`(with-no-warnings (called-interactively-p ,kind))
`(interactive-p))))
-(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp)))
(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))
-(def-edebug-spec org-bound-and-true-p (symbolp))
(defun org-string-nw-p (s)
- "Is S a string with a non-white character?"
+ "Return S if S is a string containing a non-blank character.
+Otherwise, return nil."
(and (stringp s)
- (org-string-match-p "\\S-" s)
+ (org-string-match-p "[^ \r\t\n]" s)
s))
(defun org-not-nil (v)
@@ -97,10 +98,11 @@ Otherwise return nil."
(defmacro org-re (s)
"Replace posix classes in regular expression."
+ (declare (debug (form)))
(if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s))
-(def-edebug-spec org-re (form))
(defmacro org-preserve-lc (&rest body)
+ (declare (debug (body)))
(org-with-gensyms (line col)
`(let ((,line (org-current-line))
(,col (current-column)))
@@ -108,12 +110,12 @@ Otherwise return nil."
(progn ,@body)
(org-goto-line ,line)
(org-move-to-column ,col)))))
-(def-edebug-spec org-preserve-lc (body))
;; Use `org-with-silent-modifications' to ignore cosmetic changes and
;; `org-unmodified' to ignore real text modifications
(defmacro org-unmodified (&rest body)
"Run BODY while preserving the buffer's `buffer-modified-p' state."
+ (declare (debug (body)))
(org-with-gensyms (was-modified)
`(let ((,was-modified (buffer-modified-p)))
(unwind-protect
@@ -121,9 +123,9 @@ Otherwise return nil."
(inhibit-modification-hooks t))
,@body)
(set-buffer-modified-p ,was-modified)))))
-(def-edebug-spec org-unmodified (body))
(defmacro org-without-partial-completion (&rest body)
+ (declare (debug (body)))
`(if (and (boundp 'partial-completion-mode)
partial-completion-mode
(fboundp 'partial-completion-mode))
@@ -133,7 +135,6 @@ Otherwise return nil."
,@body)
(partial-completion-mode 1))
,@body))
-(def-edebug-spec org-without-partial-completion (body))
;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
(defmacro org-maybe-intangible (props)
@@ -150,6 +151,7 @@ We use a macro so that the test can happen at compilation time."
(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))
(org-with-gensyms (mpom)
`(let ((,mpom ,pom))
(save-excursion
@@ -157,15 +159,14 @@ We use a macro so that the test can happen at compilation time."
(org-with-wide-buffer
(goto-char (or ,mpom (point)))
,@body)))))
-(def-edebug-spec org-with-point-at (form body))
-(put 'org-with-point-at 'lisp-indent-function 1)
(defmacro org-no-warnings (&rest body)
+ (declare (debug (body)))
(cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
-(def-edebug-spec org-no-warnings (body))
(defmacro org-with-remote-undo (buffer &rest body)
"Execute BODY while recording undo information in two buffers."
+ (declare (debug (form body)) (indent 1))
(org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
`(let ((,cline (org-current-line))
(,cmd this-command)
@@ -187,13 +188,11 @@ We use a macro so that the test can happen at compilation time."
;; remember which buffer to undo
(push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2)
org-agenda-undo-list))))))
-(def-edebug-spec org-with-remote-undo (form body))
-(put 'org-with-remote-undo 'lisp-indent-function 1)
(defmacro org-no-read-only (&rest body)
"Inhibit read-only for BODY."
+ (declare (debug (body)))
`(let ((inhibit-read-only t)) ,@body))
-(def-edebug-spec org-no-read-only (body))
(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
rear-nonsticky t mouse-map t fontified t
@@ -313,7 +312,7 @@ This means that the buffer may change while running BODY,
but it also means that the buffer should stay alive
during the operation, because otherwise all these markers will
point nowhere."
- (declare (indent 1))
+ (declare (debug (form body)) (indent 1))
(org-with-gensyms (data rtn)
`(let ((,data (org-outline-overlay-data ,use-markers))
,rtn)
@@ -327,24 +326,28 @@ point nowhere."
(and (markerp (cdr c)) (move-marker (cdr c) nil)))
,data)))
,rtn)))
-(def-edebug-spec org-save-outline-visibility (form body))
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
+ (declare (debug (body)))
`(save-excursion
(save-restriction
(widen)
,@body)))
-(def-edebug-spec org-with-wide-buffer (body))
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
- `(let* ((org-called-with-limited-levels t)
- (org-outline-regexp (org-get-limited-outline-regexp))
- (outline-regexp org-outline-regexp)
- (org-outline-regexp-bol (concat "^" org-outline-regexp)))
- ,@body))
-(def-edebug-spec org-with-limited-levels (body))
+ (declare (debug (body)))
+ `(progn
+ (defvar org-called-with-limited-levels)
+ (defvar org-outline-regexp)
+ (defvar outline-regexp)
+ (defvar org-outline-regexp-bol)
+ (let* ((org-called-with-limited-levels t)
+ (org-outline-regexp (org-get-limited-outline-regexp))
+ (outline-regexp org-outline-regexp)
+ (org-outline-regexp-bol (concat "^" org-outline-regexp)))
+ ,@body)))
(defvar org-outline-regexp) ; defined in org.el
(defvar org-odd-levels-only) ; defined in org.el
@@ -352,11 +355,16 @@ point nowhere."
(defun org-get-limited-outline-regexp ()
"Return outline-regexp with limited number of levels.
The number of levels is controlled by `org-inlinetask-min-level'"
- (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask)))
- org-outline-regexp
- (let* ((limit-level (1- org-inlinetask-min-level))
- (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
- (format "\\*\\{1,%d\\} " nstars))))
+ (cond ((not (derived-mode-p 'org-mode))
+ outline-regexp)
+ ((not (featurep 'org-inlinetask))
+ org-outline-regexp)
+ (t
+ (let* ((limit-level (1- org-inlinetask-min-level))
+ (nstars (if org-odd-levels-only
+ (1- (* limit-level 2))
+ limit-level)))
+ (format "\\*\\{1,%d\\} " nstars)))))
(defun org-format-seconds (string seconds)
"Compatibility function replacing format-seconds."
@@ -365,9 +373,8 @@ The number of levels is controlled by `org-inlinetask-min-level'"
(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)))
-(def-edebug-spec org-eval-in-environment (form form))
-(put 'org-eval-in-environment 'lisp-indent-function 1)
(defun org-make-parameter-alist (flat)
"Return alist based on FLAT.
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index 41a9958..293de79 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -425,7 +425,7 @@ agenda view showing the flagged items."
(def-tags (default-value 'org-tag-alist))
(target-file (expand-file-name org-mobile-index-file
org-mobile-directory))
- file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds)
+ file link-name todo-kwds done-kwds tags entry kwds dwds twds)
(when (stringp (car def-todo))
(setq def-todo (list (cons 'sequence def-todo))))
(org-agenda-prepare-buffers (mapcar 'car files-alist))
@@ -433,21 +433,20 @@ agenda view showing the flagged items."
(setq todo-kwds (org-delete-all
done-kwds
(org-uniquify org-todo-keywords-for-agenda)))
- (setq drawers (org-uniquify org-drawers-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)
+ (insert "#+READONLY\n")
(while (setq entry (pop def-todo))
- (insert "#+READONLY\n")
(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 (member "|" kwds)
+ (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)))
@@ -469,7 +468,6 @@ agenda view showing the flagged items."
(setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b)))))
(setq tags (append def-tags tags nil))
(insert "#+TAGS: " (mapconcat 'identity tags " ") "\n")
- (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n")
(insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n")
(when (file-exists-p (expand-file-name
org-mobile-directory "agendas.org"))
@@ -501,7 +499,8 @@ agenda view showing the flagged items."
(org-mobile-encrypt-and-move file target-path)
(copy-file file target-path 'ok-if-exists))
(setq check (shell-command-to-string
- (concat org-mobile-checksum-binary " "
+ (concat (shell-quote-argument org-mobile-checksum-binary)
+ " "
(shell-quote-argument (expand-file-name file)))))
(when (string-match "[a-fA-F0-9]\\{30,40\\}" check)
(push (cons link-name (match-string 0 check))
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index 74046c7..42b666d 100644
--- a/lisp/org-mouse.el
+++ b/lisp/org-mouse.el
@@ -191,7 +191,7 @@ 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]+:")
+ (when (org-looking-back ":[A-Za-z]+:" (line-beginning-position))
(skip-chars-backward ":A-Za-z")
(skip-chars-backward "\t ")))
@@ -215,8 +215,7 @@ this function is called. Otherwise, the current major mode menu is used."
(when (not (org-mouse-mark-active))
(goto-char (posn-point (event-start event)))
(when (not (eolp)) (save-excursion (run-hooks 'post-command-hook)))
- (let ((redisplay-dont-pause t))
- (sit-for 0)))
+ (sit-for 0))
(if (functionp org-mouse-context-menu-function)
(funcall org-mouse-context-menu-function event)
(if (fboundp 'mouse-menu-major-mode-map)
@@ -638,14 +637,14 @@ This means, between the beginning of line and the point."
(progn (save-excursion (goto-char (region-beginning)) (insert "[["))
(save-excursion (goto-char (region-end)) (insert "]]")))]
["Insert Link Here" (org-mouse-yank-link ',event)]))))
- ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
+ ((save-excursion (beginning-of-line) (looking-at "[ \t]*#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
- (org-looking-back " \\|\t")))
+ (org-looking-back " \\|\t" (- (point) 2))))
(org-mouse-popup-global-menu))
((funcall get-context :checkbox)
(popup-menu
@@ -1008,7 +1007,7 @@ This means, between the beginning of line and the point."
(let ((endmarker (with-current-buffer buffer
(org-end-of-subtree nil t)
(unless (eobp) (forward-char 1))
- (copy-marker (point)))))
+ (point-marker))))
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
@@ -1018,7 +1017,7 @@ This means, between the beginning of line and the point."
(and (outline-next-heading)
(org-flag-heading nil))) ; show the next heading
(org-back-to-heading)
- (setq marker (copy-marker (point)))
+ (setq marker (point-marker))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
(funcall command)
(message "_cmd: %S" org-mouse-cmd)
diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el
index 32dcaa6..05683fe 100644
--- a/lisp/org-pcomplete.el
+++ b/lisp/org-pcomplete.el
@@ -1,6 +1,6 @@
;;; org-pcomplete.el --- In-buffer completion code
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; John Wiegley <johnw at gnu dot org>
@@ -272,7 +272,7 @@ When completing for #+STARTUP, for example, this function returns
;; OPTION items from registered back-ends.
(let (items)
(dolist (backend (org-bound-and-true-p
- org-export--registered-backends))
+ org-export-registered-backends))
(dolist (option (org-export-backend-options backend))
(let ((item (nth 2 option)))
(when item (push (concat item ":") items)))))
@@ -363,25 +363,6 @@ This needs more work, to handle headings with lots of spaces in them."
lst))
(substring pcomplete-stub 1)))
-(defvar org-drawers)
-
-(defun pcomplete/org-mode/drawer ()
- "Complete a drawer name."
- (let ((spc (save-excursion
- (move-beginning-of-line 1)
- (looking-at "^\\([ \t]*\\):")
- (match-string 1)))
- (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
- (pcomplete-here cpllist
- (substring pcomplete-stub 1)
- (unless (or (not (delq
- nil
- (mapcar (lambda(x)
- (string-match (substring pcomplete-stub 1) x))
- cpllist)))
- (looking-at "[ \t]*\n.*:END:"))
- (save-excursion (insert "\n" spc ":END:"))))))
-
(defun pcomplete/org-mode/block-option/src ()
"Complete the arguments of a begin_src block.
Complete a language in the first field, the header arguments and switches."
diff --git a/lisp/org-plot.el b/lisp/org-plot.el
index 556b9ef..a089f34 100644
--- a/lisp/org-plot.el
+++ b/lisp/org-plot.el
@@ -1,6 +1,6 @@
;;; org-plot.el --- Support for plotting from Org-mode
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;;
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: tables, plotting
@@ -187,9 +187,7 @@ NUM-COLS controls the number of columns plotted in a 2-d plot.
Optional argument PREFACE returns only option parameters in a
manner suitable for prepending to a user-specified script."
(let* ((type (plist-get params :plot-type))
- (with (if (equal type 'grid)
- 'pm3d
- (plist-get params :with)))
+ (with (if (eq type 'grid) 'pm3d (plist-get params :with)))
(sets (plist-get params :set))
(lines (plist-get params :line))
(map (plist-get params :map))
@@ -209,63 +207,66 @@ manner suitable for prepending to a user-specified script."
('3d "splot")
('grid "splot")))
(script "reset")
- ; ats = add-to-script
- (ats (lambda (line) (setf script (format "%s\n%s" script line))))
+ ;; ats = add-to-script
+ (ats (lambda (line) (setf script (concat script "\n" line))))
plot-lines)
- (when file ;; output file
+ (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 (if map (funcall ats "set map")))
- ('grid (if map (funcall ats "set pm3d map")
- (funcall ats "set pm3d"))))
- (when title (funcall ats (format "set title '%s'" title))) ;; title
- (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line
- (when sets ;; set
- (mapc (lambda (el) (funcall ats (format "set %s" el))) sets))
- (when x-labels ;; x labels (xtics)
+ (case type ; type
+ (2d ())
+ (3d (when map (funcall ats "set map")))
+ (grid (if map (funcall ats "set pm3d map") (funcall ats "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)
+ (funcall ats "set datafile separator \"\\t\""))
+ (when x-labels ; x labels (xtics)
(funcall ats
(format "set xtics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
x-labels ", "))))
- (when y-labels ;; y labels (ytics)
+ (when y-labels ; y labels (ytics)
(funcall ats
(format "set ytics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
y-labels ", "))))
- (when time-ind ;; timestamp index
+ (when time-ind ; timestamp index
(funcall ats "set xdata time")
(funcall ats (concat "set timefmt \""
- (or timefmt ;; timefmt passed to gnuplot
+ (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 (equal 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
+ (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
(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
- (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))))
+ (concat plot-cmd " " (mapconcat #'identity
+ (reverse plot-lines)
+ ",\\\n "))))
script))
;;-----------------------------------------------------------------------------
@@ -279,59 +280,58 @@ line directly before or after the table."
(require 'gnuplot)
(save-window-excursion
(delete-other-windows)
- (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running
+ (when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running
(with-current-buffer "*gnuplot*"
- (goto-char (point-max))
- (gnuplot-delchar-or-maybe-eof nil)))
+ (goto-char (point-max))))
(org-plot/goto-nearest-table)
- ;; set default options
- (mapc
- (lambda (pair)
- (unless (plist-member params (car pair))
- (setf params (plist-put params (car pair) (cdr pair)))))
- org-plot/gnuplot-default-options)
+ ;; Set default options.
+ (dolist (pair org-plot/gnuplot-default-options)
+ (unless (plist-member params (car pair))
+ (setf params (plist-put params (car pair) (cdr pair)))))
;; 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)))))
- (while (equal 'hline (first table)) (setf table (cdr table)))
- (when (equal (second table) 'hline)
- (setf params (plist-put params :labels (first table))) ;; headers to labels
- (setf table (delq 'hline (cdr table)))) ;; clean non-data from table
- ;; collect options
+ (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 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)
+ ;; 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)))))
- ;; check for timestamp ind column
- (let ((ind (- (plist-get params :ind) 1)))
- (when (and (>= ind 0) (equal '2d (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)))
(if (= (length
(delq 0 (mapcar
(lambda (el)
- (if (string-match org-ts-regexp3 el)
- 0 1))
- (mapcar (lambda (row) (nth ind row)) table)))) 0)
+ (if (string-match org-ts-regexp3 el) 0 1))
+ (mapcar (lambda (row) (nth ind row)) table))))
+ 0)
(plist-put params :timeind t)
- ;; check for text ind column
+ ;; Check for text ind column.
(if (or (string= (plist-get params :with) "hist")
(> (length
(delq 0 (mapcar
(lambda (el)
(if (string-match org-table-number-regexp el)
0 1))
- (mapcar (lambda (row) (nth ind row)) table)))) 0))
+ (mapcar (lambda (row) (nth ind row)) table))))
+ 0))
(plist-put params :textind t)))))
- ;; write script
+ ;; Write script.
(with-temp-buffer
- (if (plist-get params :script) ;; user script
+ (if (plist-get params :script) ; user script
(progn (insert
(org-plot/gnuplot-script data-file num-cols params t))
(insert "\n")
@@ -339,14 +339,12 @@ line directly before or after the table."
(goto-char (point-min))
(while (re-search-forward "$datafile" nil t)
(replace-match data-file nil nil)))
- (insert
- (org-plot/gnuplot-script data-file num-cols params)))
- ;; graph table
+ (insert (org-plot/gnuplot-script data-file num-cols params)))
+ ;; Graph table.
(gnuplot-mode)
(gnuplot-send-buffer-to-gnuplot))
- ;; cleanup
- (bury-buffer (get-buffer "*gnuplot*"))
- (run-with-idle-timer 0.1 nil (lambda () (delete-file data-file))))))
+ ;; Cleanup.
+ (bury-buffer (get-buffer "*gnuplot*")))))
(provide 'org-plot)
diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el
index 0c6f2de..4dfdb6c 100644
--- a/lisp/org-protocol.el
+++ b/lisp/org-protocol.el
@@ -561,7 +561,7 @@ as filename."
(let ((fname (expand-file-name (car var))))
(setq fname (org-protocol-check-filename-for-protocol
fname (member var flist) client))
- (if (eq fname t) ;; greedy? We need the `t' return value.
+ (if (eq fname t) ;; greedy? We need the t return value.
(progn
(ad-set-arg 0 nil)
(throw 'greedy t))
diff --git a/lisp/org-rmail.el b/lisp/org-rmail.el
index 6859b65..90d2fa1 100644
--- a/lisp/org-rmail.el
+++ b/lisp/org-rmail.el
@@ -36,9 +36,11 @@
(declare-function rmail-show-message "rmail" (&optional n no-summary))
(declare-function rmail-what-message "rmail" (&optional pos))
(declare-function rmail-toggle-header "rmail" (&optional arg))
+(declare-function rmail "rmail" (&optional file-name-arg))
(declare-function rmail-widen "rmail" ())
(defvar rmail-current-message) ; From rmail.el
(defvar rmail-header-style) ; From rmail.el
+(defvar rmail-file-name) ; From rmail.el
;; Install the link type
(org-add-link-type "rmail" 'org-rmail-open)
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 752fa30..8529494 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -1,6 +1,6 @@
;;; org-src.el --- Source code examples in Org
;;
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Bastien Guerry <bzg@gnu.org>
@@ -34,35 +34,26 @@
(require 'org-compat)
(require 'ob-keys)
(require 'ob-comint)
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl))
+(declare-function org-base-buffer "org" (buffer))
(declare-function org-do-remove-indentation "org" (&optional n))
-(declare-function org-at-table.el-p "org" ())
-(declare-function org-in-src-block-p "org" (&optional inside))
-(declare-function org-in-block-p "org" (names))
+(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-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(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-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
-(declare-function org-base-buffer "org" (buffer))
+(declare-function org-trim "org" (s))
-(defcustom org-edit-src-region-extra nil
- "Additional regexps to identify regions for editing with `org-edit-src-code'.
-For examples see the function `org-edit-src-find-region-and-lang'.
-The regular expression identifying the begin marker should end with a newline,
-and the regexp marking the end line should start with a newline, to make sure
-there are kept outside the narrowed region."
- :group 'org-edit-structure
- :type '(repeat
- (list
- (regexp :tag "begin regexp")
- (regexp :tag "end regexp")
- (choice :tag "language"
- (string :tag "specify")
- (integer :tag "from match group")
- (const :tag "from `lang' element")
- (const :tag "from `style' element")))))
+(defvar org-element-all-elements)
(defcustom org-edit-src-turn-on-auto-save nil
"Non-nil means turn `auto-save-mode' on when editing a source block.
@@ -119,11 +110,12 @@ These are the regions where each line starts with a colon."
"If non-nil preserve leading whitespace characters on export.
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. If this variable is nil
-then, 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'."
+buffer and the language mode edit buffer.
+
+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'."
:group 'org-edit-structure
:type 'boolean)
@@ -136,9 +128,6 @@ editing it with \\[org-edit-src-code]. Has no effect if
:group 'org-edit-structure
:type 'integer)
-(defvar org-src-strip-leading-and-trailing-blank-lines nil
- "If non-nil, blank lines are removed when exiting the code edit buffer.")
-
(defcustom org-edit-src-persistent-message t
"Non-nil means show persistent exit help message while editing src examples.
The message is shown in the header-line, which will be created in the
@@ -146,6 +135,17 @@ first line of the window showing the editing buffer."
:group 'org-edit-structure
:type 'boolean)
+(defcustom org-src-ask-before-returning-to-edit-buffer t
+ "Non-nil means ask before switching to an existing edit buffer.
+If nil, when `org-edit-src-code' is used on a block that already
+has an active edit buffer, it will switch to that edit buffer
+immediately; otherwise it will ask whether you want to return to
+the existing edit buffer."
+ :group 'org-edit-structure
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
(defcustom org-src-window-setup 'reorganize-frame
"How the source code edit buffer should be displayed.
Possible values for this option are:
@@ -166,11 +166,11 @@ other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
(const reorganize-frame)))
(defvar org-src-mode-hook nil
- "Hook run after Org switched a source code snippet to its Emacs mode.
-This hook will run
-
-- when editing a source code snippet with \"C-c '\".
-- When formatting a source code snippet for export with htmlize.
+ "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 formatting a source code snippet for export with htmlize.
You may want to use this hook for example to turn off `outline-minor-mode'
or similar things which you want to have when editing a source code file,
@@ -180,7 +180,7 @@ but which mess up the display of a snippet in Org exported files.")
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++)
- ("screen" . shell-script))
+ ("screen" . shell-script) ("shell" . sh) ("bash" . sh))
"Alist mapping languages to their major mode.
The key is the language name, the value is the string that should
be inserted as the name of the major mode. For many languages this is
@@ -194,452 +194,326 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(string "Language name")
(symbol "Major mode"))))
-;;; Editing source examples
-
-(defvar org-src-mode-map (make-sparse-keymap))
-(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
-(define-key org-src-mode-map "\C-c\C-k" 'org-edit-src-abort)
-(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save)
-
-(defvar org-edit-src-force-single-line nil)
-(defvar org-edit-src-from-org-mode nil)
-(defvar org-edit-src-allow-write-back-p t)
-(defvar org-edit-src-picture nil)
-(defvar org-edit-src-beg-marker nil)
-(defvar org-edit-src-end-marker nil)
-(defvar org-edit-src-overlay nil)
-(defvar org-edit-src-block-indentation nil)
-(defvar org-edit-src-saved-temp-window-config nil)
-
-(defcustom org-src-ask-before-returning-to-edit-buffer t
- "If nil, when org-edit-src code is used on a block that already
-has an active edit buffer, it will switch to that edit buffer
-immediately; otherwise it will ask whether you want to return to
-the existing edit buffer."
- :group 'org-edit-structure
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
-
-(defvar org-src-babel-info nil)
+(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."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-babel)
-(define-minor-mode org-src-mode
- "Minor mode for language major mode buffers generated by org.
-This minor mode is turned on in two situations:
-- when editing a source code snippet with \"C-c '\".
-- When formatting a source code snippet for export with htmlize.
-There is a mode hook, and keybindings for `org-edit-src-exit' and
-`org-edit-src-save'")
-
-(defvar org-edit-src-code-timer nil)
-(defun org-edit-src-code (&optional context code edit-buffer-name)
- "Edit the source CODE block at point.
-The code is copied to a separate buffer and the appropriate mode
-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. An optional argument CONTEXT is used by \\[org-edit-src-save]
-when calling this function. See `org-src-window-setup' to configure
-the display of windows containing the Org buffer and the code buffer."
- (interactive)
- (if (not (or (org-in-block-p '("src" "example" "latex" "html"))
- (org-at-table.el-p)))
- (user-error "Not in a source code or example block")
- (unless (eq context 'save)
- (setq org-edit-src-saved-temp-window-config (current-window-configuration)))
- (let* ((mark (and (org-region-active-p) (mark)))
- (case-fold-search t)
- (info
- ;; If the src region consists in no lines, we insert a blank
- ;; line.
- (let* ((temp (org-edit-src-find-region-and-lang))
- (beg (nth 0 temp))
- (end (nth 1 temp)))
- (if (>= end beg) temp
- (goto-char beg)
- (insert "\n")
- (org-edit-src-find-region-and-lang))))
- (full-info (org-babel-get-src-block-info 'light))
- (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive
- (beg (make-marker))
- ;; Move marker with inserted text for case when src block is
- ;; just one empty line, i.e. beg == end.
- (end (copy-marker (make-marker) t))
- (allow-write-back-p (null code))
- block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
- begline markline markcol line col transmitted-variables)
- (setq beg (move-marker beg (nth 0 info))
- end (move-marker end (nth 1 info))
- msg (if allow-write-back-p
- (substitute-command-keys
- "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort")
- "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort")
- code (or code (buffer-substring-no-properties beg end))
- lang (or (cdr (assoc (nth 2 info) org-src-lang-modes))
- (nth 2 info))
- lang (if (symbolp lang) (symbol-name lang) lang)
- single (nth 3 info)
- block-nindent (nth 5 info)
- lang-f (intern (concat lang "-mode"))
- begline (save-excursion (goto-char beg) (org-current-line))
- transmitted-variables
- `((org-edit-src-content-indentation
- ,org-edit-src-content-indentation)
- (org-edit-src-force-single-line ,single)
- (org-edit-src-from-org-mode ,org-mode-p)
- (org-edit-src-allow-write-back-p ,allow-write-back-p)
- (org-src-preserve-indentation ,org-src-preserve-indentation)
- (org-src-babel-info ,(org-babel-get-src-block-info 'light))
- (org-coderef-label-format
- ,(or (nth 4 info) org-coderef-label-format))
- (org-edit-src-beg-marker ,beg)
- (org-edit-src-end-marker ,end)
- (org-edit-src-block-indentation ,block-nindent)))
- (if (and mark (>= mark beg) (<= mark (1+ end)))
- (save-excursion (goto-char (min mark end))
- (setq markline (org-current-line)
- markcol (current-column))))
- (if (equal lang-f 'table.el-mode)
- (setq lang-f (lambda ()
- (text-mode)
- (if (org-bound-and-true-p flyspell-mode)
- (flyspell-mode -1))
- (table-recognize)
- (org-set-local 'org-edit-src-content-indentation 0))))
- (unless (functionp lang-f)
- (error "No such language mode: %s" lang-f))
- (save-excursion
- (if (> (point) end) (goto-char end))
- (setq line (org-current-line)
- col (current-column)))
- (if (and (setq buffer (org-edit-src-find-buffer beg end))
- (or (eq context 'save)
- (if org-src-ask-before-returning-to-edit-buffer
- (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t)))
- (org-src-switch-to-buffer buffer 'return)
- (when buffer
- (with-current-buffer buffer
- (if (boundp 'org-edit-src-overlay)
- (delete-overlay org-edit-src-overlay)))
- (kill-buffer buffer))
- (setq buffer (generate-new-buffer
- (or edit-buffer-name
- (org-src-construct-edit-buffer-name (buffer-name) lang))))
- (setq ovl (make-overlay beg end))
- (overlay-put ovl 'edit-buffer buffer)
- (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
- (overlay-put ovl 'face 'secondary-selection)
- (overlay-put ovl
- 'keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'org-edit-src-continue)
- map))
- (overlay-put ovl :read-only "Leave me alone")
- (setq transmitted-variables
- (append transmitted-variables `((org-edit-src-overlay ,ovl))))
- (org-src-switch-to-buffer buffer 'edit)
- (if (eq single 'macro-definition)
- (setq code (replace-regexp-in-string "\\\\n" "\n" code t t)))
- (insert code)
- (remove-text-properties (point-min) (point-max)
- '(display nil invisible nil intangible nil))
- (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables))
- (setq total-nindent (or (org-do-remove-indentation) 0)))
- (let ((org-inhibit-startup t))
- (condition-case e
- (funcall lang-f)
- (error
- (message "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
- (dolist (pair transmitted-variables)
- (org-set-local (car pair) (cadr pair)))
- ;; Remove protecting commas from visible part of buffer.
- (org-unescape-code-in-region (point-min) (point-max))
- (when markline
- (org-goto-line (1+ (- markline begline)))
- (org-move-to-column
- (if org-src-preserve-indentation markcol
- (max 0 (- markcol total-nindent))))
- (push-mark (point) 'no-message t)
- (setq deactivate-mark nil))
- (org-goto-line (1+ (- line begline)))
- (org-move-to-column
- (if org-src-preserve-indentation col (max 0 (- col total-nindent))))
- (org-src-mode)
- (set-buffer-modified-p nil)
- (setq buffer-file-name nil)
- (when org-edit-src-turn-on-auto-save
- (setq buffer-auto-save-file-name
- (concat (make-temp-name "org-src-")
- (format-time-string "-%Y-%d-%m") ".txt")))
- (and org-edit-src-persistent-message
- (org-set-local 'header-line-format msg))
- (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
- (when (fboundp edit-prep-func)
- (funcall edit-prep-func full-info)))
- (or org-edit-src-code-timer
- (zerop org-edit-src-auto-save-idle-delay)
- (setq org-edit-src-code-timer
- (run-with-idle-timer
- org-edit-src-auto-save-idle-delay t
- (lambda ()
- (cond
- ((org-string-match-p "\\`\\*Org Src" (buffer-name))
- (when (buffer-modified-p) (org-edit-src-save)))
- ((not (org-some (lambda (b)
- (org-string-match-p "\\`\\*Org Src"
- (buffer-name b)))
- (buffer-list)))
- (cancel-timer org-edit-src-code-timer)
- (setq org-edit-src-code-timer nil))))))))
- t)))
-(defun org-edit-src-continue (e)
- "Continue editing source blocks." ;; Fixme: be more accurate
- (interactive "e")
- (mouse-set-point e)
- (let ((buf (get-char-property (point) 'edit-buffer)))
- (if buf (org-src-switch-to-buffer buf 'continue)
- (error "Something is wrong here"))))
+
+;;; Internal functions and variables
-(defun org-src-switch-to-buffer (buffer context)
- (case org-src-window-setup
- ('current-window
- (org-pop-to-buffer-same-window buffer))
- ('other-window
- (switch-to-buffer-other-window buffer))
- ('other-frame
- (case context
- ('exit
- (let ((frame (selected-frame)))
- (switch-to-buffer-other-frame buffer)
- (delete-frame frame)))
- ('save
- (kill-buffer (current-buffer))
- (org-pop-to-buffer-same-window buffer))
- (t
- (switch-to-buffer-other-frame buffer))))
- ('reorganize-frame
- (if (eq context 'edit) (delete-other-windows))
- (org-switch-to-buffer-other-window buffer)
- (if (eq context 'exit) (delete-other-windows)))
- ('switch-invisibly
- (set-buffer buffer))
- (t
- (message "Invalid value %s for org-src-window-setup"
- (symbol-name org-src-window-setup))
- (org-pop-to-buffer-same-window buffer))))
+(defvar org-src--allow-write-back t)
+(defvar org-src--auto-save-timer nil)
+(defvar org-src--babel-info nil)
+(defvar org-src--beg-marker nil)
+(defvar org-src--block-indentation nil)
+(defvar org-src--end-marker nil)
+(defvar org-src--from-org-mode nil)
+(defvar org-src--overlay nil)
+(defvar org-src--preserve-indentation nil)
+(defvar org-src--remote nil)
+(defvar org-src--saved-temp-window-config nil)
-(defun org-src-construct-edit-buffer-name (org-buffer-name lang)
+(defun org-src--construct-edit-buffer-name (org-buffer-name lang)
"Construct the buffer name for a source editing buffer."
(concat "*Org Src " org-buffer-name "[ " lang " ]*"))
-(defun org-src-edit-buffer-p (&optional buffer)
- "Test whether BUFFER (or the current buffer if BUFFER is nil)
-is a source block editing buffer."
- (let ((buffer (org-base-buffer (or buffer (current-buffer)))))
- (and (buffer-name buffer)
- (string-match "\\`*Org Src " (buffer-name buffer))
- (local-variable-p 'org-edit-src-beg-marker buffer)
- (local-variable-p 'org-edit-src-end-marker buffer))))
-
-(defun org-edit-src-find-buffer (beg end)
- "Find a source editing buffer that is already editing the region BEG to END."
+(defun org-src--edit-buffer (beg end)
+ "Return buffer editing area between BEG and END.
+Return nil if there is no such buffer."
(catch 'exit
- (mapc
- (lambda (b)
- (with-current-buffer b
- (if (and (string-match "\\`*Org Src " (buffer-name))
- (local-variable-p 'org-edit-src-beg-marker (current-buffer))
- (local-variable-p 'org-edit-src-end-marker (current-buffer))
- (equal beg org-edit-src-beg-marker)
- (equal end org-edit-src-end-marker))
- (throw 'exit (current-buffer)))))
- (buffer-list))
- nil))
+ (dolist (b (buffer-list))
+ (with-current-buffer b
+ (and (org-src-edit-buffer-p)
+ (= beg org-src--beg-marker)
+ (eq (marker-buffer beg) (marker-buffer org-src--beg-marker))
+ (= end org-src--end-marker)
+ (eq (marker-buffer end) (marker-buffer org-src--end-marker))
+ (throw 'exit b))))))
+
+(defun org-src--source-buffer ()
+ "Return source buffer edited by current buffer."
+ (unless (org-src-edit-buffer-p) (error "Not in a source buffer"))
+ (or (marker-buffer org-src--beg-marker)
+ (error "No source buffer available for current editing session")))
+
+(defun org-src--get-lang-mode (lang)
+ "Return major mode that should be used for LANG.
+LANG is a string, and the returned major mode is a symbol."
+ (intern
+ (concat
+ (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang)))
+ (if (symbolp l) (symbol-name l) l))
+ "-mode")))
-(defun org-edit-fixed-width-region ()
- "Edit the fixed-width ascii drawing at point.
-This must be a region where each line starts with a colon followed by
-a space character.
-An new buffer is created and the fixed-width region is copied into it,
-and the buffer is switched into `artist-mode' for editing. When done,
-exit with \\[org-edit-src-exit]. The edited text will then replace
-the fragment in the Org-mode buffer."
- (interactive)
- (let ((line (org-current-line))
- (col (current-column))
- (case-fold-search t)
- (msg (substitute-command-keys
- "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort"))
- (org-mode-p (derived-mode-p 'org-mode))
- (beg (make-marker))
- (end (make-marker))
- (preserve-indentation org-src-preserve-indentation)
- block-nindent ovl beg1 end1 code begline buffer)
- (beginning-of-line 1)
- (if (looking-at "[ \t]*[^:\n \t]")
- nil
- (if (looking-at "[ \t]*\\(\n\\|\\'\\)")
- (setq beg1 (point) end1 beg1)
- (save-excursion
- (if (re-search-backward "^[ \t]*[^: \t]" nil 'move)
- (setq beg1 (point-at-bol 2))
- (setq beg1 (point))))
- (save-excursion
- (if (re-search-forward "^[ \t]*[^: \t]" nil 'move)
- (setq end1 (1- (match-beginning 0)))
- (setq end1 (point))))
- (org-goto-line line))
- (setq beg (move-marker beg beg1)
- end (move-marker end end1)
- code (buffer-substring-no-properties beg end)
- begline (save-excursion (goto-char beg) (org-current-line)))
- (if (and (setq buffer (org-edit-src-find-buffer beg end))
- (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))
- (org-pop-to-buffer-same-window buffer)
- (when buffer
- (with-current-buffer buffer
- (if (boundp 'org-edit-src-overlay)
- (delete-overlay org-edit-src-overlay)))
- (kill-buffer buffer))
- (setq buffer (generate-new-buffer
- (org-src-construct-edit-buffer-name
- (buffer-name) "Fixed Width")))
- (setq ovl (make-overlay beg end))
- (overlay-put ovl 'face 'secondary-selection)
- (overlay-put ovl 'edit-buffer buffer)
- (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
- (overlay-put ovl 'face 'secondary-selection)
- (overlay-put ovl
- 'keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'org-edit-src-continue)
- map))
- (overlay-put ovl :read-only "Leave me alone")
- (org-pop-to-buffer-same-window buffer)
- (insert code)
+(defun org-src--coordinates (pos beg end)
+ "Return coordinates of POS relatively to BEG and END.
+POS, BEG and END are buffer positions. Return value is either
+a cons cell (LINE . COLUMN) or symbol `end'. See also
+`org-src--goto-coordinates'."
+ (if (>= pos end) 'end
+ (org-with-wide-buffer
+ (goto-char (max beg pos))
+ (cons (count-lines beg (line-beginning-position))
+ ;; Column is relative to the end of line to avoid problems of
+ ;; comma escaping or colons appended in front of the line.
+ (- (current-column)
+ (progn (end-of-line) (current-column)))))))
+
+(defun org-src--goto-coordinates (coord beg end)
+ "Move to coordinates COORD relatively to BEG and END.
+COORD are coordinates, as returned by `org-src--coordinates',
+which see. BEG and END are buffer positions."
+ (goto-char
+ (if (eq coord 'end) (max (1- end) beg)
+ ;; If BEG happens to be located outside of the narrowed part of
+ ;; the buffer, widen it first.
+ (org-with-wide-buffer
+ (goto-char beg)
+ (forward-line (car coord))
+ (end-of-line)
+ (org-move-to-column (max (+ (current-column) (cdr coord)) 0))
+ (point)))))
+
+(defun org-src--contents-area (datum)
+ "Return contents boundaries of DATUM.
+DATUM is an element or object. Return a list (BEG END CONTENTS)
+where BEG and END are buffer positions and CONTENTS is a string."
+ (let ((type (org-element-type datum)))
+ (cond
+ ((eq type 'footnote-definition)
+ (let* ((beg (org-with-wide-buffer
+ (goto-char (org-element-property :post-affiliated datum))
+ (search-forward "]")))
+ (end (or (org-element-property :contents-end datum) beg)))
+ (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)))
+ (list beg end (buffer-substring-no-properties beg end))))
+ ((memq type '(example-block export-block src-block))
+ (list (org-with-wide-buffer
+ (goto-char (org-element-property :post-affiliated datum))
+ (line-beginning-position 2))
+ (org-with-wide-buffer
+ (goto-char (org-element-property :end datum))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 1))
+ (org-element-property :value datum)))
+ ((memq type '(fixed-width table))
+ (let ((beg (org-element-property :post-affiliated datum))
+ (end (org-with-wide-buffer
+ (goto-char (org-element-property :end datum))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
+ (list beg
+ end
+ (if (eq type 'fixed-width) (org-element-property :value datum)
+ (buffer-substring-no-properties beg end)))))
+ (t (error "Unsupported element or object: %s" type)))))
+
+(defun org-src--make-source-overlay (beg end edit-buffer)
+ "Create overlay between BEG and END positions and return it.
+EDIT-BUFFER is the buffer currently editing area between BEG and
+END."
+ (let ((overlay (make-overlay beg end)))
+ (overlay-put overlay 'face 'secondary-selection)
+ (overlay-put overlay 'edit-buffer edit-buffer)
+ (overlay-put overlay 'help-echo
+ "Click with mouse-1 to switch to buffer editing this segment")
+ (overlay-put overlay 'face 'secondary-selection)
+ (overlay-put overlay 'keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'org-edit-src-continue)
+ map))
+ (let ((read-only
+ (list
+ (lambda (&rest _)
+ (user-error
+ "Cannot modify an area being edited in a dedicated buffer")))))
+ (overlay-put overlay 'modification-hooks read-only)
+ (overlay-put overlay 'insert-in-front-hooks read-only)
+ (overlay-put overlay 'insert-behind-hooks read-only))
+ overlay))
+
+(defun org-src--remove-overlay ()
+ "Remove overlay from current source buffer."
+ (when (overlayp org-src--overlay) (delete-overlay org-src--overlay)))
+
+(defun org-src--on-datum-p (datum)
+ "Non-nil when point is on DATUM.
+DATUM is an element or an object. Consider blank lines or white
+spaces after it as being outside."
+ (and (>= (point) (org-element-property :begin datum))
+ (<= (point)
+ (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)
+ (line-end-position)
+ (point))))))
+
+(defun org-src--contents-for-write-back ()
+ "Return buffer contents in a format appropriate for write back.
+Assume point is in the corresponding edit buffer."
+ (let ((indentation (or org-src--block-indentation 0))
+ (preserve-indentation org-src--preserve-indentation)
+ (contents (org-with-wide-buffer (buffer-string)))
+ (write-back org-src--allow-write-back))
+ (with-temp-buffer
+ (insert (org-no-properties contents))
+ (goto-char (point-min))
+ (when (functionp write-back) (funcall write-back))
+ (unless (or preserve-indentation (= indentation 0))
+ (let ((ind (make-string indentation ?\s)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (org-looking-at-p "[ \t]*\\S-") (insert ind))
+ (forward-line))))
+ (buffer-string))))
+
+(defun org-src--edit-element
+ (datum name &optional major write-back contents remote)
+ "Edit DATUM contents in a dedicated buffer NAME.
+
+MAJOR is the major mode used in the edit buffer. A nil value is
+equivalent to `fundamental-mode'.
+
+When WRITE-BACK is non-nil, assume contents will replace original
+region. Moreover, if it is a function, apply it in the edit
+buffer, from point min, before returning the contents.
+
+When CONTENTS is non-nil, display them in the edit buffer.
+Otherwise, show DATUM contents as specified by
+`org-src--contents-area'.
+
+When REMOTE is non-nil, do not try to preserve point or mark when
+moving from the edit area to the source.
+
+Leave point in edit buffer."
+ (setq org-src--saved-temp-window-config (current-window-configuration))
+ (let* ((area (org-src--contents-area datum))
+ (beg (copy-marker (nth 0 area)))
+ (end (copy-marker (nth 1 area) t))
+ (old-edit-buffer (org-src--edit-buffer beg end))
+ (contents (or contents (nth 2 area))))
+ (if (and old-edit-buffer
+ (or (not org-src-ask-before-returning-to-edit-buffer)
+ (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ")))
+ ;; Move to existing buffer.
+ (org-src-switch-to-buffer old-edit-buffer 'return)
+ ;; Discard old edit buffer.
+ (when old-edit-buffer
+ (with-current-buffer old-edit-buffer (org-src--remove-overlay))
+ (kill-buffer old-edit-buffer))
+ (let* ((org-mode-p (derived-mode-p 'org-mode))
+ (type (org-element-type datum))
+ (ind (org-with-wide-buffer
+ (goto-char (org-element-property :begin datum))
+ (org-get-indentation)))
+ (preserve-ind
+ (and (memq type '(example-block src-block))
+ (or (org-element-property :preserve-indent datum)
+ org-src-preserve-indentation)))
+ ;; Store relative positions of mark (if any) and point
+ ;; within the edited area.
+ (point-coordinates (and (not remote)
+ (org-src--coordinates (point) beg end)))
+ (mark-coordinates (and (not remote)
+ (org-region-active-p)
+ (let ((m (mark)))
+ (and (>= m beg) (>= end m)
+ (org-src--coordinates m beg end)))))
+ ;; Generate a new edit buffer.
+ (buffer (generate-new-buffer name))
+ ;; Add an overlay on top of source.
+ (overlay (org-src--make-source-overlay beg end buffer)))
+ ;; Switch to edit buffer.
+ (org-src-switch-to-buffer buffer 'edit)
+ ;; Insert contents.
+ (insert contents)
(remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil))
- (setq block-nindent (or (org-do-remove-indentation) 0))
- (cond
- ((eq org-edit-fixed-width-region-mode 'artist-mode)
- (fundamental-mode)
- (artist-mode 1))
- (t (funcall org-edit-fixed-width-region-mode)))
- (set (make-local-variable 'org-edit-src-force-single-line) nil)
- (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
- (set (make-local-variable 'org-edit-src-picture) t)
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*: ?" nil t)
- (replace-match ""))
- (org-goto-line (1+ (- line begline)))
- (org-move-to-column (max 0 (- col block-nindent 2)))
- (org-set-local 'org-edit-src-beg-marker beg)
- (org-set-local 'org-edit-src-end-marker end)
- (org-set-local 'org-edit-src-overlay ovl)
- (org-set-local 'org-edit-src-block-indentation block-nindent)
- (org-set-local 'org-edit-src-content-indentation 0)
- (org-set-local 'org-src-preserve-indentation nil)
- (org-src-mode)
+ (unless preserve-ind (org-do-remove-indentation))
(set-buffer-modified-p nil)
- (and org-edit-src-persistent-message
- (org-set-local 'header-line-format msg)))
- (message "%s" msg)
- t)))
+ (setq buffer-file-name nil)
+ ;; Start major mode.
+ (if (not major) (fundamental-mode)
+ (let ((org-inhibit-startup t))
+ (condition-case e (funcall major)
+ (error (message "Language mode `%s' fails with: %S"
+ major (nth 1 e))))))
+ ;; 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)
+ ;; Start minor mode.
+ (org-src-mode)
+ ;; Move mark and point in edit buffer to the corresponding
+ ;; location.
+ (if remote
+ (progn
+ ;; Put point at first non read-only character after
+ ;; leading blank.
+ (goto-char
+ (or (text-property-any (point-min) (point-max) 'read-only nil)
+ (point-max)))
+ (skip-chars-forward " \r\t\n"))
+ ;; Set mark and point.
+ (when mark-coordinates
+ (org-src--goto-coordinates mark-coordinates (point-min) (point-max))
+ (push-mark (point) 'no-message t)
+ (setq deactivate-mark nil))
+ (org-src--goto-coordinates
+ point-coordinates (point-min) (point-max)))))))
+
+
+
+;;; Fontification of source blocks
-(defun org-edit-src-find-region-and-lang ()
- "Find the region and language for a local edit.
-Return a list with beginning and end of the region, a string representing
-the language, a switch telling if the content should be in a single line."
- (let ((re-list
- (append
- org-edit-src-region-extra
- '(
- ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang)
- ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style)
- ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental")
- ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp")
- ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl")
- ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python")
- ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby")
- ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2)
- ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental")
- ("^[ \t]*#\\+html:" "\n" "html" single-line)
- ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html")
- ("^[ \t]*#\\+latex:" "\n" "latex" single-line)
- ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex")
- ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line)
- ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental")
- ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)"
- "\n" "fundamental" macro-definition)
- )))
- (pos (point))
- re1 re2 single beg end lang lfmt match-re1 ind entry)
- (catch 'exit
- (while (setq entry (pop re-list))
- (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
- single (nth 3 entry))
- (save-excursion
- (if (or (looking-at re1)
- (re-search-backward re1 nil t))
- (progn
- (setq match-re1 (match-string 0))
- (setq beg (match-end 0)
- lang (org-edit-src-get-lang lang)
- lfmt (org-edit-src-get-label-format match-re1)
- ind (org-edit-src-get-indentation (match-beginning 0)))
- (if (and (re-search-forward re2 nil t)
- (>= (match-end 0) pos))
- (throw 'exit (list beg (match-beginning 0)
- lang single lfmt ind))))
- (if (or (looking-at re2)
- (re-search-forward re2 nil t))
- (progn
- (setq end (match-beginning 0))
- (if (and (re-search-backward re1 nil t)
- (<= (match-beginning 0) pos))
- (progn
- (setq lfmt (org-edit-src-get-label-format
- (match-string 0))
- ind (org-edit-src-get-indentation
- (match-beginning 0)))
- (throw 'exit
- (list (match-end 0) end
- (org-edit-src-get-lang lang)
- single lfmt ind)))))))))
- (when (org-at-table.el-p)
- (re-search-backward "^[\t]*[^ \t|\\+]" nil t)
- (setq beg (1+ (point-at-eol)))
- (goto-char beg)
- (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t)
- (progn (goto-char (point-max)) (newline)))
- (setq end (1- (point-at-bol)))
- (throw 'exit (list beg end 'table.el nil nil 0))))))
-
-(defun org-edit-src-get-lang (lang)
- "Extract the src language."
- (let ((m (match-string 0)))
- (cond
- ((stringp lang) lang)
- ((integerp lang) (match-string lang))
- ((and (eq lang 'lang)
- (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m))
- (match-string 1 m))
- ((and (eq lang 'style)
- (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
- (match-string 1 m))
- (t "fundamental"))))
-
-(defun org-edit-src-get-label-format (s)
- "Extract the label format."
- (save-match-data
- (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s)
- (match-string 1 s))))
-
-(defun org-edit-src-get-indentation (pos)
- "Count leading whitespace characters on line."
- (save-match-data
- (goto-char pos)
- (org-get-indentation)))
+(defun org-src-font-lock-fontify-block (lang start end)
+ "Fontify code block.
+This function is called by emacs automatic fontification, as long
+as `org-src-fontify-natively' is non-nil."
+ (let ((lang-mode (org-src--get-lang-mode lang)))
+ (when (fboundp lang-mode)
+ (let ((string (buffer-substring-no-properties start end))
+ (modified (buffer-modified-p))
+ (org-buffer (current-buffer)) pos next)
+ (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
+ (unless (eq major-mode lang-mode) (funcall lang-mode))
+ ;; Avoid `font-lock-ensure', which does not display fonts in
+ ;; source block.
+ (font-lock-fontify-buffer)
+ (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)))
+ (add-text-properties
+ start end
+ '(font-lock-fontified t fontified t font-lock-multiline t))
+ (set-buffer-modified-p modified)))))
+
+
+
+;;; Escape contents
(defun org-escape-code-in-region (beg end)
"Escape lines between BEG and END.
@@ -647,9 +521,9 @@ Escaping happens when a line starts with \"*\", \"#+\", \",*\" or
\",#+\" by appending a comma to it."
(interactive "r")
(save-excursion
- (goto-char beg)
- (while (re-search-forward "^[ \t]*,?\\(\\*\\|#\\+\\)" end t)
- (replace-match ",\\1" nil nil nil 1))))
+ (goto-char end)
+ (while (re-search-backward "^[ \t]*,?\\(\\*\\|#\\+\\)" beg t)
+ (save-excursion (replace-match ",\\1" nil nil nil 1)))))
(defun org-escape-code-in-string (s)
"Escape lines in string S.
@@ -663,9 +537,9 @@ Un-escaping happens by removing the first comma on lines starting
with \",*\", \",#+\", \",,*\" and \",,#+\"."
(interactive "r")
(save-excursion
- (goto-char beg)
- (while (re-search-forward "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" end t)
- (replace-match "" nil nil nil 1))))
+ (goto-char end)
+ (while (re-search-backward "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" beg t)
+ (save-excursion (replace-match "" nil nil nil 1)))))
(defun org-unescape-code-in-string (s)
"Un-escape lines in string S.
@@ -674,154 +548,68 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(replace-regexp-in-string
"^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1))
-(defun org-edit-src-exit (&optional context)
- "Exit special edit and protect problematic lines."
- (interactive)
- (unless (org-bound-and-true-p org-edit-src-from-org-mode)
- (error "This is not a sub-editing buffer, something is wrong"))
- (widen)
- (let* ((fixed-width-p (string-match "Fixed Width" (buffer-name)))
- (beg org-edit-src-beg-marker)
- (end org-edit-src-end-marker)
- (ovl org-edit-src-overlay)
- (bufstr (buffer-string))
- (buffer (current-buffer))
- (single (org-bound-and-true-p org-edit-src-force-single-line))
- (macro (eq single 'macro-definition))
- (total-nindent (+ (or org-edit-src-block-indentation 0)
- org-edit-src-content-indentation))
- (preserve-indentation org-src-preserve-indentation)
- (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p))
- (delta 0) code line col indent)
- (when allow-write-back-p
- (unless preserve-indentation (untabify (point-min) (point-max)))
- (if org-src-strip-leading-and-trailing-blank-lines
- (save-excursion
- (goto-char (point-min))
- (if (looking-at "[ \t\n]*\n") (replace-match ""))
- (unless macro
- (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))))
- (setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
- 1
- (org-current-line))
- col (current-column))
- (when allow-write-back-p
- (when single
- (goto-char (point-min))
- (if (re-search-forward "\\s-+\\'" nil t) (replace-match ""))
- (goto-char (point-min))
- (let ((cnt 0))
- (while (re-search-forward "\n" nil t)
- (setq cnt (1+ cnt))
- (replace-match (if macro "\\n" " ") t t))
- (when (and macro (> cnt 0))
- (goto-char (point-max)) (insert "\\n")))
- (goto-char (point-min))
- (if (looking-at "\\s-*") (replace-match " ")))
- (when (and (org-bound-and-true-p org-edit-src-from-org-mode)
- (not fixed-width-p))
- (org-escape-code-in-region (point-min) (point-max))
- (setq delta (+ delta
- (save-excursion
- (org-goto-line line)
- (if (looking-at "[ \t]*\\(,,\\)?\\(\\*\\|#+\\)") 1
- 0)))))
- (when (org-bound-and-true-p org-edit-src-picture)
- (setq preserve-indentation nil)
- (untabify (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "^" nil t)
- (replace-match ": ")))
- (unless (or single preserve-indentation (= total-nindent 0))
- (setq indent (make-string total-nindent ?\ ))
- (goto-char (point-min))
- (while (re-search-forward "\\(^\\).+" nil t)
- (replace-match indent nil nil nil 1)))
- (if (org-bound-and-true-p org-edit-src-picture)
- (setq total-nindent (+ total-nindent 2)))
- (setq code (buffer-string))
- (when (eq context 'save)
- (erase-buffer)
- (insert bufstr))
- (set-buffer-modified-p nil))
- (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
- (if (eq context 'save) (save-buffer)
- (with-current-buffer buffer
- (set-buffer-modified-p nil))
- (kill-buffer buffer))
- (goto-char beg)
- (when allow-write-back-p
- (undo-boundary)
- (delete-region beg (max beg end))
- (unless (string-match "\\`[ \t]*\\'" code)
- (insert code))
- ;; Make sure the overlay stays in place
- (when (eq context 'save) (move-overlay ovl beg (point)))
- (goto-char beg)
- (if single (just-one-space)))
- (if (memq t (mapcar (lambda (overlay)
- (eq (overlay-get overlay 'invisible)
- 'org-hide-block))
- (overlays-at (point))))
- ;; Block is hidden; put point at start of block
- (beginning-of-line 0)
- ;; Block is visible, put point where it was in the code buffer
- (when allow-write-back-p
- (org-goto-line (1- (+ (org-current-line) line)))
- (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))))
- (unless (eq context 'save)
- (move-marker beg nil)
- (move-marker end nil)))
- (unless (eq context 'save)
- (when org-edit-src-saved-temp-window-config
- (set-window-configuration org-edit-src-saved-temp-window-config)
- (setq org-edit-src-saved-temp-window-config nil))))
-(defun org-edit-src-abort ()
- "Abort editing of the src code and return to the Org buffer."
- (interactive)
- (let (org-edit-src-allow-write-back-p)
- (org-edit-src-exit 'exit)))
-
-(defmacro org-src-in-org-buffer (&rest body)
- `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg)
- (save-window-excursion
- (org-edit-src-exit 'save)
- ,@body
- (setq msg (current-message))
- (if (eq org-src-window-setup 'other-frame)
- (let ((org-src-window-setup 'current-window))
- (org-edit-src-code 'save))
- (org-edit-src-code 'save)))
- (setq buffer-undo-list ul)
- (push-mark m 'nomessage)
- (goto-char (min p (point-max)))
- (message (or msg ""))))
-(def-edebug-spec org-src-in-org-buffer (body))
+
+;;; Org src minor mode
-(defun org-edit-src-save ()
- "Save parent buffer with current state source-code buffer."
- (interactive)
- (if (string-match "Fixed Width" (buffer-name))
- (user-error "Use C-c ' to save and exit, C-c C-k to abort editing")
- (org-src-in-org-buffer (save-buffer))))
+(defvar org-src-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c'" 'org-edit-src-exit)
+ (define-key map "\C-c\C-k" 'org-edit-src-abort)
+ (define-key map "\C-x\C-s" 'org-edit-src-save)
+ map))
-(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang))
-
-(defun org-src-tangle (arg)
- "Tangle the parent buffer."
- (interactive)
- (org-src-in-org-buffer (org-babel-tangle arg)))
+(define-minor-mode org-src-mode
+ "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 formatting a source code snippet for export with htmlize.
+
+\\{org-src-mode-map}
+
+See also `org-src-mode-hook'."
+ nil " OrgSrc" nil
+ (when org-edit-src-persistent-message
+ (org-set-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]"))))
+ ;; Possibly activate various auto-save features (for the edit buffer
+ ;; or the source buffer).
+ (when org-edit-src-turn-on-auto-save
+ (setq buffer-auto-save-file-name
+ (concat (make-temp-name "org-src-")
+ (format-time-string "-%Y-%d-%m")
+ ".txt")))
+ (unless (or org-src--auto-save-timer (zerop org-edit-src-auto-save-idle-delay))
+ (setq org-src--auto-save-timer
+ (run-with-idle-timer
+ org-edit-src-auto-save-idle-delay t
+ (lambda ()
+ (save-excursion
+ (let (edit-flag)
+ (dolist (b (buffer-list))
+ (with-current-buffer b
+ (when (org-src-edit-buffer-p)
+ (unless edit-flag (setq edit-flag t))
+ (when (buffer-modified-p) (org-edit-src-save)))))
+ (unless edit-flag
+ (cancel-timer org-src--auto-save-timer)
+ (setq org-src--auto-save-timer nil)))))))))
(defun org-src-mode-configure-edit-buffer ()
- (when (org-bound-and-true-p org-edit-src-from-org-mode)
- (org-add-hook 'kill-buffer-hook
- #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
- (if (org-bound-and-true-p org-edit-src-allow-write-back-p)
+ (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)
(progn
(setq buffer-offer-save t)
(setq buffer-file-name
- (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker))
+ (concat (buffer-file-name (marker-buffer org-src--beg-marker))
"[" (buffer-name) "]"))
(if (featurep 'xemacs)
(progn
@@ -830,8 +618,11 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(setq write-contents-functions '(org-edit-src-save))))
(setq buffer-read-only t))))
-(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer)
+(org-add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer)
+
+
+;;; Babel related functions
(defun org-src-associate-babel-session (info)
"Associate edit buffer with comint session."
@@ -844,17 +635,18 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(and (fboundp f) (funcall f session))))))
(defun org-src-babel-configure-edit-buffer ()
- (when org-src-babel-info
- (org-src-associate-babel-session org-src-babel-info)))
+ (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)
-(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer)
(defmacro org-src-do-at-code-block (&rest body)
- "Execute a command from an edit buffer in the Org-mode buffer."
- `(let ((beg-marker org-edit-src-beg-marker))
- (if beg-marker
- (with-current-buffer (marker-buffer beg-marker)
- (goto-char (marker-position beg-marker))
- ,@body))))
+ "Execute a command from an edit buffer in the Org mode buffer."
+ `(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)
@@ -879,79 +671,308 @@ Org-babel commands."
(if (equal key (kbd "C-g")) (keyboard-quit)
(org-edit-src-save)
(org-src-do-at-code-block
- (call-interactively
- (lookup-key org-babel-map key)))))
+ (call-interactively (lookup-key org-babel-map key)))))
-(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."
- :type 'boolean
- :version "24.1"
- :group 'org-babel)
-(defun org-src-native-tab-command-maybe ()
- "Perform language-specific TAB action.
-Alter code block according to what TAB does in the language major mode."
- (and org-src-tab-acts-natively
- (org-in-src-block-p)
- (not (equal this-command 'org-shifttab))
- (let ((org-src-strip-leading-and-trailing-blank-lines nil))
- (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
+
+;;; Public functions
-(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe)
+(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."
+ (let ((buffer (org-base-buffer (or buffer (current-buffer)))))
+ (and (buffer-live-p buffer)
+ (local-variable-p 'org-src--beg-marker buffer)
+ (local-variable-p 'org-src--end-marker buffer))))
-(defun org-src-font-lock-fontify-block (lang start end)
- "Fontify code block.
-This function is called by emacs automatic fontification, as long
-as `org-src-fontify-natively' is non-nil. For manual
-fontification of code blocks see `org-src-fontify-block' and
-`org-src-fontify-buffer'"
- (let ((lang-mode (org-src-get-lang-mode lang)))
- (if (fboundp lang-mode)
- (let ((string (buffer-substring-no-properties start end))
- (modified (buffer-modified-p))
- (org-buffer (current-buffer)) pos next)
- (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
- (unless (eq major-mode lang-mode) (funcall lang-mode))
- (font-lock-fontify-buffer)
- (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)))
- (add-text-properties
- start end
- '(font-lock-fontified t fontified t font-lock-multiline t))
- (set-buffer-modified-p modified)))))
-
-(defun org-src-fontify-block ()
- "Fontify code block at point."
+(defun org-src-switch-to-buffer (buffer context)
+ (case org-src-window-setup
+ (current-window (org-pop-to-buffer-same-window buffer))
+ (other-window
+ (switch-to-buffer-other-window buffer))
+ (other-frame
+ (case context
+ (exit
+ (let ((frame (selected-frame)))
+ (switch-to-buffer-other-frame buffer)
+ (delete-frame frame)))
+ (save
+ (kill-buffer (current-buffer))
+ (org-pop-to-buffer-same-window buffer))
+ (t (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
+ (message "Invalid value %s for `org-src-window-setup'"
+ org-src-window-setup)
+ (org-pop-to-buffer-same-window buffer))))
+
+(defun org-edit-footnote-reference ()
+ "Edit definition of footnote reference at point."
(interactive)
- (save-excursion
- (let ((org-src-fontify-natively t)
- (info (org-edit-src-find-region-and-lang)))
- (font-lock-fontify-region (nth 0 info) (nth 1 info)))))
+ (let* ((context (org-element-context))
+ (label (org-element-property :label context)))
+ (unless (and (eq (org-element-type context) 'footnote-reference)
+ (org-src--on-datum-p context))
+ (user-error "Not on a footnote reference"))
+ (unless label (user-error "Cannot edit remotely anonymous footnotes"))
+ (let* ((definition (org-with-wide-buffer
+ (org-footnote-goto-definition label)
+ (org-element-context)))
+ (inline (eq (org-element-type definition) 'footnote-reference))
+ (contents
+ (let ((c (org-with-wide-buffer
+ (org-trim (buffer-substring-no-properties
+ (org-element-property :begin definition)
+ (org-element-property :end definition))))))
+ (add-text-properties
+ 0
+ (progn (string-match (if inline "\\`\\[fn:.*?:" "\\`.*?\\]") c)
+ (match-end 0))
+ '(read-only "Cannot edit footnote label" front-sticky t
+ rear-nonsticky t)
+ c)
+ (when inline
+ (let ((l (length c)))
+ (add-text-properties
+ (1- l) l
+ '(read-only "Cannot edit past footnote reference"
+ front-sticky nil rear-nonsticky nil)
+ c)))
+ c)))
+ (org-src--edit-element
+ definition
+ (format "*Edit footnote [%s]*" label)
+ #'org-mode
+ `(lambda ()
+ (if ,(not inline) (delete-region (point) (search-forward "]"))
+ (delete-region (point) (search-forward ":" nil t 2))
+ (delete-region (1- (point-max)) (point-max))
+ (when (re-search-forward "\n[ \t]*\n" nil t)
+ (user-error "Inline definitions cannot contain blank lines"))
+ ;; If footnote reference belongs to a table, make sure to
+ ;; remove any newline characters in order to preserve
+ ;; table's structure.
+ (when ,(org-element-lineage definition '(table-cell))
+ (while (search-forward "\n" nil t) (delete-char -1)))))
+ contents
+ 'remote))
+ ;; Report success.
+ t))
+
+(defun org-edit-table.el ()
+ "Edit \"table.el\" table at point.
+
+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.
+
+Throw an error when not at such a table."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (and (eq (org-element-type element) 'table)
+ (eq (org-element-property :type element) 'table.el)
+ (org-src--on-datum-p element))
+ (user-error "Not in a table.el table"))
+ (org-src--edit-element
+ element
+ (org-src--construct-edit-buffer-name (buffer-name) "Table")
+ #'text-mode t)
+ (when (org-bound-and-true-p flyspell-mode) (flyspell-mode -1))
+ (table-recognize)
+ t))
+
+(defun org-edit-export-block ()
+ "Edit export block at point.
+
+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.
+
+Throw an error when not at an export block."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (and (eq (org-element-type element) 'export-block)
+ (org-src--on-datum-p element))
+ (user-error "Not in an export block"))
+ (let* ((type (downcase (org-element-property :type element)))
+ (mode (org-src--get-lang-mode type)))
+ (unless (functionp mode) (error "No such language mode: %s" mode))
+ (org-src--edit-element
+ element
+ (org-src--construct-edit-buffer-name (buffer-name) type)
+ mode
+ (lambda () (org-escape-code-in-region (point-min) (point-max)))))
+ t))
+
+(defun org-edit-src-code (&optional code edit-buffer-name)
+ "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 \
+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
+windows containing the Org buffer and the code buffer.
-(defun org-src-fontify-buffer ()
- "Fontify all code blocks in the current buffer."
+When optional argument CODE is a string, edit it in a dedicated
+buffer instead.
+
+When optional argument EDIT-BUFFER-NAME is non-nil, use it as the
+name of the sub-editing buffer."
(interactive)
- (org-babel-map-src-blocks nil
- (org-src-fontify-block)))
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element)))
+ (unless (and (memq type '(example-block src-block))
+ (org-src--on-datum-p element))
+ (user-error "Not in a source or example block"))
+ (let* ((lang
+ (if (eq type 'src-block) (org-element-property :language element)
+ "example"))
+ (lang-f (and (eq type 'src-block) (org-src--get-lang-mode lang)))
+ (babel-info (and (eq type 'src-block)
+ (org-babel-get-src-block-info 'light)))
+ deactivate-mark)
+ (when (and (eq type 'src-block) (not (functionp lang-f)))
+ (error "No such language mode: %s" lang-f))
+ (org-src--edit-element
+ element
+ (or edit-buffer-name
+ (org-src--construct-edit-buffer-name (buffer-name) lang))
+ lang-f
+ (and (null code)
+ `(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)))))
+ (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))
+ (when (eq type 'src-block)
+ (org-set-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-fixed-width-region ()
+ "Edit the fixed-width ASCII drawing at point.
+
+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
+the area in the Org mode buffer."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (and (eq (org-element-type element) 'fixed-width)
+ (org-src--on-datum-p element))
+ (user-error "Not in a fixed-width area"))
+ (org-src--edit-element
+ element
+ (org-src--construct-edit-buffer-name (buffer-name) "Fixed Width")
+ org-edit-fixed-width-region-mode
+ (lambda () (while (not (eobp)) (insert ": ") (forward-line))))
+ ;; Return success.
+ t))
+
+(defun org-edit-src-abort ()
+ "Abort editing of the src code and return to the Org buffer."
+ (interactive)
+ (let (org-src--allow-write-back) (org-edit-src-exit)))
+
+(defun org-edit-src-continue (e)
+ "Unconditionally return to buffer editing area under point.
+Throw an error if there is no such buffer."
+ (interactive "e")
+ (mouse-set-point e)
+ (let ((buf (get-char-property (point) 'edit-buffer)))
+ (if buf (org-src-switch-to-buffer buf 'continue)
+ (user-error "No sub-editing buffer for area at point"))))
+
+(defun org-edit-src-save ()
+ "Save parent buffer with current state source-code buffer."
+ (interactive)
+ (unless (org-src-edit-buffer-p) (user-error "Not in a sub-editing buffer"))
+ (set-buffer-modified-p nil)
+ (let ((edited-code (org-src--contents-for-write-back))
+ (beg org-src--beg-marker)
+ (end org-src--end-marker)
+ (overlay org-src--overlay))
+ (with-current-buffer (org-src--source-buffer)
+ (undo-boundary)
+ (goto-char beg)
+ ;; Temporarily disable read-only features of OVERLAY in order to
+ ;; insert new contents.
+ (delete-overlay overlay)
+ (delete-region beg end)
+ (let ((expecting-bol (bolp)))
+ (insert edited-code)
+ (when (and expecting-bol (not (bolp))) (insert "\n")))
+ (save-buffer)
+ (move-overlay overlay beg (point)))))
+
+(defun org-edit-src-exit ()
+ "Kill current sub-editing buffer and return to source buffer."
+ (interactive)
+ (unless (org-src-edit-buffer-p) (error "Not in a sub-editing buffer"))
+ (let* ((beg org-src--beg-marker)
+ (end org-src--end-marker)
+ (write-back org-src--allow-write-back)
+ (remote org-src--remote)
+ (coordinates (and (not remote)
+ (org-src--coordinates (point) 1 (point-max))))
+ (code (and write-back (org-src--contents-for-write-back))))
+ (set-buffer-modified-p nil)
+ ;; Switch to source buffer. Kill sub-editing buffer.
+ (let ((edit-buffer (current-buffer)))
+ (org-src-switch-to-buffer (marker-buffer beg) 'exit)
+ (kill-buffer edit-buffer))
+ ;; Insert modified code. Ensure it ends with a newline character.
+ (org-with-wide-buffer
+ (when (and write-back (not (equal (buffer-substring beg end) code)))
+ (undo-boundary)
+ (goto-char beg)
+ (delete-region beg end)
+ (let ((expecting-bol (bolp)))
+ (insert code)
+ (when (and expecting-bol (not (bolp))) (insert "\n")))))
+ ;; If we are to return to source buffer, put point at an
+ ;; appropriate location. In particular, if block is hidden, move
+ ;; to the beginning of the block opening line.
+ (unless remote
+ (goto-char beg)
+ (cond
+ ;; Block is hidden; move at start of block.
+ ((org-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))))
+ ;; Clean up left-over markers and restore window configuration.
+ (set-marker beg nil)
+ (set-marker end nil)
+ (when org-src--saved-temp-window-config
+ (set-window-configuration org-src--saved-temp-window-config)
+ (setq org-src--saved-temp-window-config nil))))
-(defun org-src-get-lang-mode (lang)
- "Return major mode that should be used for LANG.
-LANG is a string, and the returned major mode is a symbol."
- (intern
- (concat
- (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang)))
- (if (symbolp l) (symbol-name l) l))
- "-mode")))
(provide 'org-src)
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 30a66c9..62de402 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -1,6 +1,6 @@
-;;; org-table.el --- The table editor for Org-mode
+;;; org-table.el --- The table editor for Org mode
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -24,10 +24,10 @@
;;
;;; Commentary:
-;; This file contains the table editor and spreadsheet for Org-mode.
+;; This file contains the table editor and spreadsheet for Org mode.
;; Watch out: Here we are talking about two different kind of tables.
-;; Most of the code is for the tables created with the Org-mode table editor.
+;; Most of the code is for the tables created with the Org mode table editor.
;; Sometimes, we talk about tables created and edited with the table.el
;; Emacs package. We call the former org-type tables, and the latter
;; table.el-type tables.
@@ -38,9 +38,24 @@
(require 'cl))
(require 'org)
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-contents "org-element" (element))
+(declare-function org-element-extract-element "org-element" (element))
+(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-map "org-element"
+ (data types fun
+ &optional info first-match no-recursion with-affiliated))
+(declare-function org-element-property "org-element" (property element))
+
(declare-function org-export-string-as "ox"
(string backend &optional body-only ext-plist))
-(declare-function aa2u "ext:ascii-art-to-unicode" ())
+(declare-function org-export-create-backend "ox")
+(declare-function org-export-get-backend "ox" (name))
+
+(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)
@@ -52,7 +67,7 @@ This can be used to add additional functionality after the table is sent
to the receiver position, otherwise, if table is not sent, the functions
are not run.")
-(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ")
+(defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ")
(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
"Non-nil means use the optimized table editor version for `orgtbl-mode'.
@@ -238,7 +253,12 @@ t accept as input and present for editing"
(defcustom org-table-copy-increment t
"Non-nil means increment when copying current field with \\[org-table-copy-down]."
:group 'org-table-calculation
- :type 'boolean)
+ :version "25.1"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "Use the difference between the current and the above fields" t)
+ (integer :tag "Use a number" 1)
+ (const :tag "Don't increment the value when copying a field" nil)))
(defcustom org-calc-default-modes
'(calc-internal-prec 12
@@ -321,11 +341,6 @@ Automatically means when TAB or RET or C-c C-c are pressed in the line."
:group 'org-table-calculation
:type 'boolean)
-(defcustom org-table-error-on-row-ref-crossing-hline t
- "OBSOLETE VARIABLE, please see `org-table-relative-ref-may-cross-hline'."
- :group 'org-table
- :type 'boolean)
-
(defcustom org-table-relative-ref-may-cross-hline t
"Non-nil means relative formula references may cross hlines.
Here are the allowed values:
@@ -345,6 +360,18 @@ portability of tables."
(const :tag "Stick to hline" nil)
(const :tag "Error on attempt to cross" error)))
+(defcustom org-table-formula-create-columns nil
+ "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"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "Setting an out-of-bounds field generates an error (default)" nil)
+ (const :tag "Setting an out-of-bounds field silently adds columns as needed" t)
+ (const :tag "Setting an out-of-bounds field adds columns as needed, but issues a warning message" warn)
+ (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."
:tag "Org Table Import Export"
@@ -359,38 +386,73 @@ available parameters."
:group 'org-table-import-export
:type 'string)
+(defcustom org-table-convert-region-max-lines 999
+ "Max lines that `org-table-convert-region' will attempt to process.
+
+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"
+ :package-version '(Org . "8.3"))
+
(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
- "Detects a table line marked for automatic recalculation.")
+ "Regexp matching a line marked for automatic recalculation.")
+
(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
- "Detects a table line marked for automatic recalculation.")
+ "Regexp matching a line marked for recalculation.")
+
(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)"
- "Detects a table line marked for automatic recalculation.")
+ "Regexp matching a line marked for calculation.")
+
(defconst org-table-border-regexp "^[ \t]*[^| \t]"
- "Searching from within a table (any type) this finds the first line outside the table.")
+ "Regexp matching any line outside an Org table.")
+
(defvar org-table-last-highlighted-reference nil)
+
(defvar org-table-formula-history nil)
(defvar org-table-column-names nil
- "Alist with column names, derived from the `!' line.")
+ "Alist with column names, derived from the `!' line.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-column-name-regexp nil
- "Regular expression matching the current column names.")
+ "Regular expression matching the current column names.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-local-parameters nil
- "Alist with parameter names, derived from the `$' line.")
+ "Alist with parameter names, derived from the `$' line.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-named-field-locations nil
- "Alist with locations of named fields.")
+ "Alist with locations of named fields.
+Associations follow the pattern (NAME LINE COLUMN) where
+ NAME is the name of the field as a string,
+ LINE is the number of lines from the beginning of the table,
+ COLUMN is the column of the field, as an integer.
+This variable is initialized with `org-table-analyze'.")
(defvar org-table-current-line-types nil
- "Table row types, non-nil only for the duration of a command.")
-(defvar org-table-current-begin-line nil
- "Table begin line, non-nil only for the duration of a command.")
+ "Table row types in current table.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-current-begin-pos nil
- "Table begin position, non-nil only for the duration of a command.")
+ "Current table begin position, as a marker.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-current-ncol nil
- "Number of columns in table, non-nil only for the duration of a command.")
+ "Number of columns in current table.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-dlines nil
- "Vector of data line line numbers in the current table.")
+ "Vector of data line line numbers in the current table.
+Line numbers are counted from the beginning of the table. This
+variable is initialized with `org-table-analyze'.")
+
(defvar org-table-hlines nil
- "Vector of hline line numbers in the current table.")
+ "Vector of hline line numbers in the current table.
+Line numbers are counted from the beginning of the table. This
+variable is initialized with `org-table-analyze'.")
(defconst org-table-range-regexp
"@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
@@ -404,75 +466,23 @@ available parameters."
"\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)")
"Match a range for reference display.")
-(defun org-table-colgroup-line-p (line)
- "Is this a table line colgroup information?"
- (save-match-data
- (and (string-match "[<>]\\|&[lg]t;" line)
- (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'"
- line)
- (not (delq
- nil
- (mapcar
- (lambda (s)
- (not (member s '("" "<" ">" "<>" "&lt;" "&gt;" "&lt;&gt;"))))
- (org-split-string (match-string 1 line) "[ \t]*|[ \t]*")))))))
-
-(defun org-table-cookie-line-p (line)
- "Is this a table line with only alignment/width cookies?"
- (save-match-data
- (and (string-match "[<>]\\|&[lg]t;" line)
- (or (string-match
- "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line)
- (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line))
- (not (delq nil (mapcar
- (lambda (s)
- (not (or (equal s "")
- (string-match
- "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s)
- (string-match
- "\\`&lt;\\([lrc]?[0-9]+\\|[lrc]\\)&gt;\\'"
- s))))
- (org-split-string (match-string 1 line)
- "[ \t]*|[ \t]*")))))))
-
-(defvar org-table-clean-did-remove-column nil) ; dynamically scoped
-(defun org-table-clean-before-export (lines &optional maybe-quoted)
- "Check if the table has a marking column.
-If yes remove the column and the special lines."
- (let ((special (if maybe-quoted
- "^[ \t]*| *\\\\?[\#!$*_^/ ] *|"
- "^[ \t]*| *[\#!$*_^/ ] *|"))
- (ignore (if maybe-quoted
- "^[ \t]*| *\\\\?[!$_^/] *|"
- "^[ \t]*| *[!$_^/] *|")))
- (setq org-table-clean-did-remove-column
- (not (memq nil
- (mapcar
- (lambda (line)
- (or (string-match org-table-hline-regexp line)
- (string-match special line)))
- lines))))
- (delq nil
- (mapcar
- (lambda (line)
- (cond
- ((or (org-table-colgroup-line-p line) ;; colgroup info
- (org-table-cookie-line-p line) ;; formatting cookies
- (and org-table-clean-did-remove-column
- (string-match ignore line))) ;; non-exportable data
- nil)
- ((and org-table-clean-did-remove-column
- (or (string-match "^\\([ \t]*\\)|-+\\+" line)
- (string-match "^\\([ \t]*\\)|[^|]*|" line)))
- ;; remove the first column
- (replace-match "\\1|" t nil line))
- (t line)))
- lines))))
-
(defconst org-table-translate-regexp
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
"Match a reference that needs translation, for reference display.")
+(defmacro org-table-save-field (&rest body)
+ "Save current field; execute BODY; restore field.
+Field is restored even in case of abnormal exit."
+ (declare (debug (body)))
+ (org-with-gensyms (line column)
+ `(let ((,line (copy-marker (line-beginning-position)))
+ (,column (org-table-current-column)))
+ (unwind-protect
+ (progn ,@body)
+ (goto-char ,line)
+ (org-table-goto-column ,column)
+ (set-marker ,line nil)))))
+
;;;###autoload
(defun org-table-create-with-table.el ()
"Use the table.el package to insert a new table.
@@ -547,7 +557,9 @@ following values:
'(4) Use the comma as a field separator
'(16) Use a TAB as field separator
+'(64) Prompt for a regular expression as field separator
integer When a number, use that many spaces as field separator
+regexp When a regular expression, use it to match the separator
nil When nil, the command tries to be smart and figure out the
separator in the following way:
- when each line contains a TAB, assume TAB-separated material
@@ -557,45 +569,52 @@ nil When nil, the command tries to be smart and figure out the
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
re)
- (goto-char beg)
- (beginning-of-line 1)
- (setq beg (point-marker))
- (goto-char end)
- (if (bolp) (backward-char 1) (end-of-line 1))
- (setq end (point-marker))
- ;; Get the right field separator
- (unless separator
+ (if (> (count-lines beg end) org-table-convert-region-max-lines)
+ (user-error "Region is longer than `org-table-convert-region-max-lines' (%s) lines; not converting"
+ org-table-convert-region-max-lines)
+ (if (equal separator '(64))
+ (setq separator (read-regexp "Regexp for field separator")))
+ (goto-char beg)
+ (beginning-of-line 1)
+ (setq beg (point-marker))
+ (goto-char end)
+ (if (bolp) (backward-char 1) (end-of-line 1))
+ (setq end (point-marker))
+ ;; Get the right field separator
+ (unless separator
+ (goto-char beg)
+ (setq separator
+ (cond
+ ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
+ ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
+ (t 1))))
(goto-char beg)
- (setq separator
+ (if (equal separator '(4))
+ (while (< (point) end)
+ ;; parse the csv stuff
(cond
- ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
- ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
- (t 1))))
- (goto-char beg)
- (if (equal separator '(4))
- (while (< (point) end)
- ;; parse the csv stuff
- (cond
- ((looking-at "^") (insert "| "))
- ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
- ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
- (replace-match "\\1")
- (if (looking-at "\"") (insert "\"")))
- ((looking-at "[^,\n]+") (goto-char (match-end 0)))
- ((looking-at "[ \t]*,") (replace-match " | "))
- (t (beginning-of-line 2))))
- (setq re (cond
- ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
- ((equal separator '(16)) "^\\|\t")
- ((integerp separator)
- (if (< separator 1)
- (user-error "Number of spaces in separator must be >= 1")
- (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
- (t (error "This should not happen"))))
- (while (re-search-forward re end t)
- (replace-match "| " t t)))
- (goto-char beg)
- (org-table-align)))
+ ((looking-at "^") (insert "| "))
+ ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
+ ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
+ (replace-match "\\1")
+ (if (looking-at "\"") (insert "\"")))
+ ((looking-at "[^,\n]+") (goto-char (match-end 0)))
+ ((looking-at "[ \t]*,") (replace-match " | "))
+ (t (beginning-of-line 2))))
+ (setq re (cond
+ ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
+ ((equal separator '(16)) "^\\|\t")
+ ((integerp separator)
+ (if (< separator 1)
+ (user-error "Number of spaces in separator must be >= 1")
+ (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
+ ((stringp separator)
+ (format "^ *\\|%s" separator))
+ (t (error "This should not happen"))))
+ (while (re-search-forward re end t)
+ (replace-match "| " t t)))
+ (goto-char beg)
+ (org-table-align))))
;;;###autoload
(defun org-table-import (file arg)
@@ -611,8 +630,6 @@ are found, lines will be split on whitespace into fields."
(org-table-convert-region beg (+ (point) (- (point-max) pm)) arg)))
-(defvar org-table-last-alignment)
-(defvar org-table-last-column-widths)
;;;###autoload
(defun org-table-export (&optional file format)
"Export table to a file, with configurable format.
@@ -630,77 +647,61 @@ extension of the given file name, and finally on the variable
`org-table-export-default-format'."
(interactive)
(unless (org-at-table-p) (user-error "No table at point"))
- (org-table-align) ;; make sure we have everything we need
- (let* ((beg (org-table-begin))
- (end (org-table-end))
- (txt (buffer-substring-no-properties beg end))
- (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
- (formats '("orgtbl-to-tsv" "orgtbl-to-csv"
- "orgtbl-to-latex" "orgtbl-to-html"
- "orgtbl-to-generic" "orgtbl-to-texinfo"
- "orgtbl-to-orgtbl"))
- (format (or format
- (org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
- buf deffmt-readable fileext)
+ (org-table-align) ; Make sure we have everything we need.
+ (let ((file (or file (org-entry-get (point) "TABLE_EXPORT_FILE" t))))
(unless file
(setq file (read-file-name "Export table to: "))
(unless (or (not (file-exists-p file))
(y-or-n-p (format "Overwrite file %s? " file)))
(user-error "File not written")))
- (if (file-directory-p file)
- (user-error "This is a directory path, not a file"))
- (if (and (buffer-file-name)
- (equal (file-truename file)
- (file-truename (buffer-file-name))))
- (user-error "Please specify a file name that is different from current"))
- (setq fileext (concat (file-name-extension file) "$"))
- (unless format
- (setq deffmt-readable
- (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats)))
- org-table-export-default-format))
- (while (string-match "\t" deffmt-readable)
- (setq deffmt-readable (replace-match "\\t" t t deffmt-readable)))
- (while (string-match "\n" deffmt-readable)
- (setq deffmt-readable (replace-match "\\n" t t deffmt-readable)))
- (setq format (org-completing-read "Format: " formats nil nil deffmt-readable)))
- (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
- (let* ((transform (intern (match-string 1 format)))
- (params (if (match-end 2)
- (read (concat "(" (match-string 2 format) ")"))))
- (skip (plist-get params :skip))
- (skipcols (plist-get params :skipcols))
- (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*")))
- (lines (org-table-clean-before-export lines))
- (i0 (if org-table-clean-did-remove-column 2 1))
- (table (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-remove-by-index
- (org-split-string (org-trim x) "\\s-*|\\s-*")
- skipcols i0)))
- lines))
- (fun (if (= i0 2) 'cdr 'identity))
- (org-table-last-alignment
- (org-remove-by-index (funcall fun org-table-last-alignment)
- skipcols i0))
- (org-table-last-column-widths
- (org-remove-by-index (funcall fun org-table-last-column-widths)
- skipcols i0)))
-
- (unless (fboundp transform)
- (user-error "No such transformation function %s" transform))
- (setq txt (funcall transform table params))
-
- (with-current-buffer (find-file-noselect file)
- (setq buf (current-buffer))
- (erase-buffer)
- (fundamental-mode)
- (insert txt "\n")
- (save-buffer))
- (kill-buffer buf)
- (message "Export done."))
- (user-error "TABLE_EXPORT_FORMAT invalid"))))
+ (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-truename file)
+ (file-truename (buffer-file-name (buffer-base-buffer)))))
+ (user-error "Please specify a file name that is different from current"))
+ (let ((fileext (concat (file-name-extension file) "$"))
+ (format (or format (org-entry-get (point) "TABLE_EXPORT_FORMAT" t))))
+ (unless format
+ (let* ((formats '("orgtbl-to-tsv" "orgtbl-to-csv" "orgtbl-to-latex"
+ "orgtbl-to-html" "orgtbl-to-generic"
+ "orgtbl-to-texinfo" "orgtbl-to-orgtbl"
+ "orgtbl-to-unicode"))
+ (deffmt-readable
+ (replace-regexp-in-string
+ "\t" "\\t"
+ (replace-regexp-in-string
+ "\n" "\\n"
+ (or (car (delq nil
+ (mapcar
+ (lambda (f)
+ (and (org-string-match-p fileext f) f))
+ formats)))
+ org-table-export-default-format)
+ t t) t t)))
+ (setq format
+ (org-completing-read
+ "Format: " formats nil nil deffmt-readable))))
+ (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
+ (let ((transform (intern (match-string 1 format)))
+ (params (and (match-end 2)
+ (read (concat "(" (match-string 2 format) ")"))))
+ (table (org-table-to-lisp
+ (buffer-substring-no-properties
+ (org-table-begin) (org-table-end)))))
+ (unless (fboundp transform)
+ (user-error "No such transformation function %s" transform))
+ (let (buf)
+ (with-current-buffer (find-file-noselect file)
+ (setq buf (current-buffer))
+ (erase-buffer)
+ (fundamental-mode)
+ (insert (funcall transform table params) "\n")
+ (save-buffer))
+ (kill-buffer buf))
+ (message "Export done."))
+ (user-error "TABLE_EXPORT_FORMAT invalid")))))
(defvar org-table-aligned-begin-marker (make-marker)
"Marker at the beginning of the table last aligned.
@@ -731,216 +732,199 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(defun org-table-align ()
"Align the table at point by aligning all vertical bars."
(interactive)
- (let* (
- ;; Limits of table
- (beg (org-table-begin))
- (end (org-table-end))
- ;; Current cursor position
- (linepos (org-current-line))
- (colpos (org-table-current-column))
- (winstart (window-start))
- (winstartline (org-current-line (min winstart (1- (point-max)))))
- lines (new "") lengths l typenums ty fields maxfields i
- column
- (indent "") cnt frac
- rfmt hfmt
- (spaces '(1 . 1))
- (sp1 (car spaces))
- (sp2 (cdr spaces))
- (rfmt1 (concat
- (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
- (hfmt1 (concat
- (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
- emptystrings links dates emph raise narrow
- falign falign1 fmax f1 len c e space)
- (untabify beg end)
- (remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
- ;; Check if we have links or dates
- (goto-char beg)
- (setq links (re-search-forward org-bracket-link-regexp end t))
- (goto-char beg)
- (setq emph (and org-hide-emphasis-markers
- (re-search-forward org-emph-re end t)))
- (goto-char beg)
- (setq raise (and org-use-sub-superscripts
- (re-search-forward org-match-substring-regexp end t)))
- (goto-char beg)
- (setq dates (and org-display-custom-times
- (re-search-forward org-ts-regexp-both end t)))
- ;; Make sure the link properties are right
- (when links (goto-char beg) (while (org-activate-bracket-links end)))
- ;; Make sure the date properties are right
- (when dates (goto-char beg) (while (org-activate-dates end)))
- (when emph (goto-char beg) (while (org-do-emphasis-faces end)))
- (when raise (goto-char beg) (while (org-raise-scripts end)))
-
- ;; Check if we are narrowing any columns
- (goto-char beg)
- (setq narrow (and org-table-do-narrow
- org-format-transports-properties-p
- (re-search-forward "<[lrc]?[0-9]+>" end t)))
- (goto-char beg)
- (setq falign (re-search-forward "<[lrc][0-9]*>" end t))
- (goto-char beg)
- ;; Get the rows
- (setq lines (org-split-string
- (buffer-substring beg end) "\n"))
- ;; Store the indentation of the first line
- (if (string-match "^ *" (car lines))
- (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
- ;; Mark the hlines by setting the corresponding element to nil
- ;; At the same time, we remove trailing space.
- (setq lines (mapcar (lambda (l)
- (if (string-match "^ *|-" l)
- nil
- (if (string-match "[ \t]+$" l)
- (substring l 0 (match-beginning 0))
- l)))
- lines))
- ;; Get the data fields by splitting the lines.
- (setq fields (mapcar
- (lambda (l)
- (org-split-string l " *| *"))
- (delq nil (copy-sequence lines))))
- ;; How many fields in the longest line?
- (condition-case nil
- (setq maxfields (apply 'max (mapcar 'length fields)))
- (error
- (kill-region beg end)
- (org-table-create org-table-default-size)
- (user-error "Empty table - created default table")))
- ;; A list of empty strings to fill any short rows on output
- (setq emptystrings (make-list maxfields ""))
- ;; Check for special formatting.
- (setq i -1)
- (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
- (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
- ;; Check if there is an explicit width specified
- (setq fmax nil)
- (when (or narrow falign)
- (setq c column fmax nil falign1 nil)
- (while c
- (setq e (pop c))
- (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e))
- (if (match-end 1) (setq falign1 (match-string 1 e)))
- (if (and org-table-do-narrow (match-end 2))
- (setq fmax (string-to-number (match-string 2 e)) c nil))))
- ;; Find fields that are wider than fmax, and shorten them
- (when fmax
- (loop for xx in column do
- (when (and (stringp xx)
- (> (org-string-width xx) fmax))
- (org-add-props xx nil
- 'help-echo
- (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
- (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
- (unless (> f1 1)
- (user-error "Cannot narrow field starting with wide link \"%s\""
- (match-string 0 xx)))
- (add-text-properties f1 (length xx) (list 'org-cwidth t) xx)
- (add-text-properties (- f1 2) f1
- (list 'display org-narrow-column-arrow)
- xx)))))
- ;; Get the maximum width for each column
- (push (apply 'max (or fmax 1) 1 (mapcar 'org-string-width column))
- lengths)
- ;; Get the fraction of numbers, to decide about alignment of the column
- (if falign1
- (push (equal (downcase falign1) "r") typenums)
- (setq cnt 0 frac 0.0)
- (loop for x in column do
- (if (equal x "")
- nil
- (setq frac ( / (+ (* frac cnt)
- (if (string-match org-table-number-regexp x) 1 0))
- (setq cnt (1+ cnt))))))
- (push (>= frac org-table-number-fraction) typenums)))
- (setq lengths (nreverse lengths) typenums (nreverse typenums))
-
- ;; Store the alignment of this table, for later editing of single fields
- (setq org-table-last-alignment typenums
- org-table-last-column-widths lengths)
-
- ;; With invisible characters, `format' does not get the field width right
- ;; So we need to make these fields wide by hand.
- (when (or links emph raise)
- (loop for i from 0 upto (1- maxfields) do
- (setq len (nth i lengths))
- (loop for j from 0 upto (1- (length fields)) do
- (setq c (nthcdr i (car (nthcdr j fields))))
- (if (and (stringp (car c))
- (or (text-property-any 0 (length (car c))
- 'invisible 'org-link (car c))
- (text-property-any 0 (length (car c))
- 'org-dwidth t (car c)))
- (< (org-string-width (car c)) len))
- (progn
- (setq space (make-string (- len (org-string-width (car c))) ?\ ))
- (setcar c (if (nth i typenums)
- (concat space (car c))
- (concat (car c) space))))))))
-
- ;; Compute the formats needed for output of the table
- (setq rfmt (concat indent "|") hfmt (concat indent "|"))
- (while (setq l (pop lengths))
- (setq ty (if (pop typenums) "" "-")) ; number types flushright
- (setq rfmt (concat rfmt (format rfmt1 ty l))
- hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))
- (setq rfmt (concat rfmt "\n")
- hfmt (concat (substring hfmt 0 -1) "|\n"))
-
- (setq new (mapconcat
- (lambda (l)
- (if l (apply 'format rfmt
- (append (pop fields) emptystrings))
- hfmt))
- lines ""))
- (move-marker org-table-aligned-begin-marker (point))
- (insert new)
- ;; Replace the old one
- (delete-region (point) end)
- (move-marker end nil)
- (move-marker org-table-aligned-end-marker (point))
- (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
- (goto-char org-table-aligned-begin-marker)
- (while (org-hide-wide-columns org-table-aligned-end-marker)))
- ;; Try to move to the old location
- (org-goto-line winstartline)
- (setq winstart (point-at-bol))
- (org-goto-line linepos)
- (when (eq (window-buffer (selected-window)) (current-buffer))
- (set-window-start (selected-window) winstart 'noforce))
- (org-table-goto-column colpos)
- (and org-table-overlay-coordinates (org-table-overlay-coordinates))
- (setq org-table-may-need-update nil)
- ))
+ (let* ((beg (org-table-begin))
+ (end (copy-marker (org-table-end))))
+ (org-table-save-field
+ ;; Make sure invisible characters in the table are at the right
+ ;; place since column widths take them into account.
+ (font-lock-fontify-region beg end)
+ (move-marker org-table-aligned-begin-marker beg)
+ (move-marker org-table-aligned-end-marker end)
+ (goto-char beg)
+ (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
+ ;; 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))
+ (let ((l (org-trim l)))
+ (remove-text-properties
+ 0 (length l) '(display t org-cwidth t) l)
+ l)))
+ (org-split-string (buffer-substring beg end) "\n")))
+ ;; Get the data fields by splitting the lines.
+ (fields (mapcar (lambda (l) (org-split-string l " *| *"))
+ (remq nil lines)))
+ ;; Compute number of fields in the longest line. If the
+ ;; table contains no field, create a default table.
+ (maxfields (if fields (apply #'max (mapcar #'length fields))
+ (kill-region beg end)
+ (org-table-create org-table-default-size)
+ (user-error "Empty table - created default table")))
+ ;; A list of empty strings to fill any short rows on output.
+ (emptycells (make-list maxfields ""))
+ lengths typenums)
+ ;; Check for special formatting.
+ (dotimes (i maxfields)
+ (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
+ fmax falign)
+ ;; Look for an explicit width or alignment.
+ (when (save-excursion
+ (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
+ (and org-table-do-narrow
+ (re-search-forward
+ "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
+ (catch :exit
+ (dolist (cell column)
+ (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
+ (when (match-end 1) (setq falign (match-string 1 cell)))
+ (when (and org-table-do-narrow (match-end 2))
+ (setq fmax (string-to-number (match-string 2 cell))))
+ (when (or falign fmax) (throw :exit nil)))))
+ ;; Find fields that are wider than FMAX, and shorten them.
+ (when fmax
+ (dolist (x column)
+ (when (> (org-string-width x) fmax)
+ (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")
+ (substring-no-properties x)))
+ (let ((l (length x))
+ (f1 (min fmax
+ (or (string-match org-bracket-link-regexp x)
+ fmax)))
+ (f2 1))
+ (unless (> f1 1)
+ (user-error
+ "Cannot narrow field starting with wide link \"%s\""
+ (match-string 0 x)))
+ (if (= (org-string-width x) l) (setq f2 f1)
+ (setq f2 1)
+ (while (< (org-string-width (substring x 0 f2)) f1)
+ (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)
+ (- f2 2))
+ f2
+ (list 'display org-narrow-column-arrow)
+ x))))))
+ ;; Get the maximum width for each column
+ (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column))
+ lengths)
+ ;; Get the fraction of numbers among non-empty cells to
+ ;; decide about alignment of the column.
+ (if falign (push (equal (downcase falign) "r") typenums)
+ (let ((cnt 0)
+ (frac 0.0))
+ (dolist (x column)
+ (unless (equal x "")
+ (setq frac
+ (/ (+ (* frac cnt)
+ (if (org-string-match-p org-table-number-regexp x)
+ 1
+ 0))
+ (incf cnt)))))
+ (push (>= frac org-table-number-fraction) typenums)))))
+ (setq lengths (nreverse lengths))
+ (setq typenums (nreverse typenums))
+ ;; Store alignment of this table, for later editing of single
+ ;; fields.
+ (setq org-table-last-alignment typenums)
+ (setq org-table-last-column-widths lengths)
+ ;; With invisible characters, `format' does not get the field
+ ;; width right So we need to make these fields wide by hand.
+ ;; Invisible characters may be introduced by fontified links,
+ ;; emphasis, macros or sub/superscripts.
+ (when (or (text-property-any beg end 'invisible 'org-link)
+ (text-property-any beg end 'invisible t))
+ (dotimes (i maxfields)
+ (let ((len (nth i lengths)))
+ (dotimes (j (length fields))
+ (let* ((c (nthcdr i (nth j fields)))
+ (cell (car c)))
+ (when (and
+ (stringp cell)
+ (let ((l (length cell)))
+ (or (text-property-any 0 l 'invisible 'org-link cell)
+ (text-property-any beg end 'invisible t)))
+ (< (org-string-width cell) len))
+ (let ((s (make-string (- len (org-string-width cell)) ?\s)))
+ (setcar c (if (nth i typenums) (concat s cell)
+ (concat cell s))))))))))
+
+ ;; Compute the formats needed for output of the table.
+ (let ((hfmt (concat indent "|"))
+ (rfmt (concat indent "|"))
+ (rfmt1 " %%%s%ds |")
+ (hfmt1 "-%s-+"))
+ (dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|")))
+ (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
+ (setq rfmt (concat rfmt (format rfmt1 ty l)))
+ (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
+ ;; Replace modified lines only. Check not only contents, but
+ ;; also columns' width.
+ (dolist (l lines)
+ (let ((line
+ (if l (apply #'format rfmt (append (pop fields) emptycells))
+ hfmt))
+ (previous (buffer-substring (point) (line-end-position))))
+ (if (and (equal previous line)
+ (let ((a 0)
+ (b 0))
+ (while (and (progn
+ (setq a (next-single-property-change
+ a 'org-cwidth previous))
+ (setq b (next-single-property-change
+ b 'org-cwidth line)))
+ (eq a b)))
+ (eq a b)))
+ (forward-line)
+ (insert line "\n")
+ (delete-region (point) (line-beginning-position 2))))))
+ (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
+ (goto-char org-table-aligned-begin-marker)
+ (while (org-hide-wide-columns org-table-aligned-end-marker)))
+ (set-marker end nil)
+ (when org-table-overlay-coordinates (org-table-overlay-coordinates))
+ (setq org-table-may-need-update nil)))))
;;;###autoload
(defun org-table-begin (&optional table-type)
"Find the beginning of the table and return its position.
-With argument TABLE-TYPE, go to the beginning of a table.el-type table."
- (save-excursion
- (if (not (re-search-backward
- (if table-type org-table-any-border-regexp
- org-table-border-regexp)
- nil t))
- (progn (goto-char (point-min)) (point))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (point))))
+With a non-nil optional argument TABLE-TYPE, return the beginning
+of a table.el-type table. This function assumes point is on
+a table."
+ (cond (table-type
+ (org-element-property :post-affiliated (org-element-at-point)))
+ ((save-excursion
+ (and (re-search-backward org-table-border-regexp nil t)
+ (line-beginning-position 2))))
+ (t (point-min))))
;;;###autoload
(defun org-table-end (&optional table-type)
"Find the end of the table and return its position.
-With argument TABLE-TYPE, go to the end of a table.el-type table."
+With a non-nil optional argument TABLE-TYPE, return the end of
+a table.el-type table. This function assumes point is on
+a table."
(save-excursion
- (if (not (re-search-forward
- (if table-type org-table-any-border-regexp
- org-table-border-regexp)
- nil t))
- (goto-char (point-max))
- (goto-char (match-beginning 0)))
- (point-marker)))
+ (cond (table-type
+ (goto-char (org-element-property :end (org-element-at-point)))
+ (skip-chars-backward " \t\n")
+ (line-beginning-position 2))
+ ((re-search-forward org-table-border-regexp nil t)
+ (match-beginning 0))
+ ;; When the line right after the table is the last line in
+ ;; the buffer with trailing spaces but no final newline
+ ;; character, trailing spaces, be sure to catch the correct
+ ;; ending at its beginning. In any other case, ending is
+ ;; expected to be at point max.
+ (t (goto-char (point-max))
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position))))))
;;;###autoload
(defun org-table-justify-field-maybe (&optional new)
@@ -967,13 +951,16 @@ Optional argument NEW may specify text to replace the current field content."
(progn
(setq s (match-string 1)
o (match-string 0)
- l (max 1 (- (match-end 0) (match-beginning 0) 3))
+ 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 (<= (length new) l) ;; FIXME: length -> str-width?
+ (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)))
@@ -1036,9 +1023,10 @@ Before doing so, re-align the table if necessary."
(goto-char (match-end 0))))
(defun org-table-beginning-of-field (&optional n)
- "Move to the end of the current table field.
-If already at or after the end, move to the end of the next table field.
-With numeric argument N, move N-1 fields forward first."
+ "Move to the beginning of the current table field.
+If already at or before the beginning, move to the beginning of the
+previous field.
+With numeric argument N, move N-1 fields backward first."
(interactive "p")
(let ((pos (point)))
(while (> n 1)
@@ -1051,10 +1039,9 @@ With numeric argument N, move N-1 fields forward first."
(if (>= (point) pos) (org-table-beginning-of-field 2))))
(defun org-table-end-of-field (&optional n)
- "Move to the beginning of the current table field.
-If already at or before the beginning, move to the beginning of the
-previous field.
-With numeric argument N, move N-1 fields backward first."
+ "Move to the end of the current table field.
+If already at or after the end, move to the end of the next table field.
+With numeric argument N, move N-1 fields forward first."
(interactive "p")
(let ((pos (point)))
(while (> n 1)
@@ -1093,30 +1080,36 @@ Before doing so, re-align the table if necessary."
;;;###autoload
(defun org-table-copy-down (n)
- "Copy a field down in the current column.
-If the field at the cursor is empty, copy into it the content of
-the nearest non-empty field above. With argument N, use the Nth
-non-empty field. If the current field is not empty, it is copied
-down to the next row, and the cursor is moved with it.
-Therefore, repeating this command causes the column to be filled
-row-by-row.
+ "Copy the value of the current field one row below.
+
+If the field at the cursor is empty, copy the content of the
+nearest non-empty field above. With argument N, use the Nth
+non-empty field.
+
+If the current field is not empty, it is copied down to the next
+row, and the cursor is moved with it. Therefore, repeating this
+command causes the column to be filled row-by-row.
+
If the variable `org-table-copy-increment' is non-nil and the
field is an integer or a timestamp, it will be incremented while
-copying. In the case of a timestamp, increment by one day."
+copying. By default, increment by the difference between the
+value in the current field and the one in the field above. To
+increment using a fixed integer, set `org-table-copy-increment'
+to a number. In the case of a timestamp, increment by days."
(interactive "p")
(let* ((colpos (org-table-current-column))
(col (current-column))
(field (save-excursion (org-table-get-field)))
+ (field-up (or (save-excursion
+ (org-table-get (1- (org-table-current-line))
+ (org-table-current-column))) ""))
(non-empty (string-match "[^ \t]" field))
+ (non-empty-up (string-match "[^ \t]" field-up))
(beg (org-table-begin))
(orig-n n)
- txt)
+ txt txt-up inc)
(org-table-check-inside-data-field)
- (if non-empty
- (progn
- (setq txt (org-trim field))
- (org-table-next-row)
- (org-table-blank-field))
+ (if (not non-empty)
(save-excursion
(setq txt
(catch 'exit
@@ -1127,35 +1120,60 @@ copying. In the case of a timestamp, increment by one day."
(if (and (looking-at
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
(<= (setq n (1- n)) 0))
- (throw 'exit (match-string 1))))))))
- (if txt
- (progn
- (if (and org-table-copy-increment
- (not (equal orig-n 0))
- (string-match "^[0-9]+$" txt)
- (< (string-to-number txt) 100000000))
- (setq txt (format "%d" (+ (string-to-number txt) 1))))
- (insert txt)
- (org-move-to-column col)
- (if (and org-table-copy-increment (org-at-timestamp-p t))
- (org-timestamp-up-day)
- (org-table-maybe-recalculate-line))
- (org-table-align)
- (org-move-to-column col))
- (user-error "No non-empty field found"))))
+ (throw 'exit (match-string 1))))))
+ (setq field-up
+ (catch 'exit
+ (while (progn (beginning-of-line 1)
+ (re-search-backward org-table-dataline-regexp
+ beg t))
+ (org-table-goto-column colpos t)
+ (if (and (looking-at
+ "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
+ (<= (setq n (1- n)) 0))
+ (throw 'exit (match-string 1))))))
+ (setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
+ ;; Above field was not empty, go down to the next row
+ (setq txt (org-trim field))
+ (org-table-next-row)
+ (org-table-blank-field))
+ (if non-empty-up (setq txt-up (org-trim field-up)))
+ (setq inc (cond
+ ((numberp org-table-copy-increment) org-table-copy-increment)
+ (txt-up (cond ((and (string-match org-ts-regexp3 txt-up)
+ (string-match org-ts-regexp3 txt))
+ (- (org-time-string-to-absolute txt)
+ (org-time-string-to-absolute txt-up)))
+ ((string-match org-ts-regexp3 txt) 1)
+ ((string-match "^[0-9]+\\(\.[0-9]+\\)?" txt-up)
+ (- (string-to-number txt)
+ (string-to-number (match-string 0 txt-up))))
+ (t 1)))
+ (t 1)))
+ (if (not txt)
+ (user-error "No non-empty field found")
+ (if (and org-table-copy-increment
+ (not (equal orig-n 0))
+ (string-match "^[-+^/*0-9eE.]+$" txt)
+ (< (string-to-number txt) 100000000))
+ (setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
+ (insert txt)
+ (org-move-to-column col)
+ (if (and org-table-copy-increment (org-at-timestamp-p t))
+ (org-timestamp-up-day inc)
+ (org-table-maybe-recalculate-line))
+ (org-table-align)
+ (org-move-to-column col))))
(defun org-table-check-inside-data-field (&optional noerror)
"Is point inside a table data field?
I.e. not on a hline or before the first or after the last column?
This actually throws an error, so it aborts the current command."
- (if (or (not (org-at-table-p))
- (= (org-table-current-column) 0)
- (org-at-table-hline-p)
- (looking-at "[ \t]*$"))
- (if noerror
- nil
- (user-error "Not in table data field"))
- t))
+ (cond ((and (org-at-table-p)
+ (not (save-excursion (skip-chars-backward " \t") (bolp)))
+ (not (org-at-table-hline-p))
+ (not (looking-at "[ \t]*$"))))
+ (noerror nil)
+ (t (user-error "Not in table data field"))))
(defvar org-table-clip nil
"Clipboard for table regions.")
@@ -1166,7 +1184,7 @@ If LINE is larger than the number of data lines in the table, the function
returns nil. However, if COLUMN is too large, we will simply return an
empty string.
If LINE is nil, use the current line.
-If column is nil, use the current column."
+If COLUMN is nil, use the current column."
(setq column (or column (org-table-current-column)))
(save-excursion
(and (or (not line) (org-table-goto-line line))
@@ -1242,18 +1260,20 @@ is always the old value."
"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"))
- (org-table-get-specials)
+ (org-table-analyze)
(save-excursion
(let* ((pos (point))
(col (org-table-current-column))
(cname (car (rassoc (int-to-string col) org-table-column-names)))
- (name (car (rassoc (list (org-current-line) col)
+ (name (car (rassoc (list (count-lines org-table-current-begin-pos
+ (line-beginning-position))
+ col)
org-table-named-field-locations)))
(eql (org-table-expand-lhs-ranges
(mapcar
(lambda (e)
- (cons (org-table-formula-handle-first/last-rc
- (car e)) (cdr e)))
+ (cons (org-table-formula-handle-first/last-rc (car e))
+ (cdr e)))
(org-table-get-stored-formulas))))
(dline (org-table-current-dline))
(ref (format "@%d$%d" dline col))
@@ -1261,12 +1281,10 @@ is always the old value."
(fequation (or (assoc name eql) (assoc ref eql)))
(cequation (assoc (int-to-string col) eql))
(eqn (or fequation cequation)))
- (if (and eqn (get-text-property 0 :orig-eqn (car eqn)))
- (setq eqn (get-text-property 0 :orig-eqn (car eqn))))
+ (let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn)))))
+ (when p (setq eqn p)))
(goto-char pos)
- (condition-case nil
- (org-table-show-reference 'local)
- (error nil))
+ (ignore-errors (org-table-show-reference 'local))
(message "line @%d, col $%s%s, ref @%d$%d or %s%s%s"
dline col
(if cname (concat " or $" cname) "")
@@ -1284,15 +1302,14 @@ is always the old value."
(defun org-table-current-column ()
"Find out which column we are in."
(interactive)
- (if (org-called-interactively-p 'any) (org-table-check-inside-data-field))
+ (when (org-called-interactively-p 'any) (org-table-check-inside-data-field))
(save-excursion
- (let ((cnt 0) (pos (point)))
- (beginning-of-line 1)
- (while (search-forward "|" pos t)
- (setq cnt (1+ cnt)))
+ (let ((column 0) (pos (point)))
+ (beginning-of-line)
+ (while (search-forward "|" pos t) (incf column))
(when (org-called-interactively-p 'interactive)
- (message "In table column %d" cnt))
- cnt)))
+ (message "In table column %d" column))
+ column)))
;;;###autoload
(defun org-table-current-dline ()
@@ -1302,14 +1319,15 @@ Only data lines count for this."
(when (org-called-interactively-p 'any)
(org-table-check-inside-data-field))
(save-excursion
- (let ((cnt 0) (pos (point)))
+ (let ((c 0)
+ (pos (point)))
(goto-char (org-table-begin))
(while (<= (point) pos)
- (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt)))
- (beginning-of-line 2))
+ (when (looking-at org-table-dataline-regexp) (incf c))
+ (forward-line))
(when (org-called-interactively-p 'any)
- (message "This is table line %d" cnt))
- cnt)))
+ (message "This is table line %d" c))
+ c)))
;;;###autoload
(defun org-table-goto-column (n &optional on-delim force)
@@ -1338,25 +1356,19 @@ However, when FORCE is non-nil, create new columns if necessary."
(defun org-table-insert-column ()
"Insert a new column into the table."
(interactive)
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
(let* ((col (max 1 (org-table-current-column)))
(beg (org-table-begin))
- (end (org-table-end))
- ;; Current cursor position
- (linepos (org-current-line))
- (colpos col))
- (goto-char beg)
- (while (< (point) end)
- (if (org-at-table-hline-p)
- nil
- (org-table-goto-column col t)
- (insert "| "))
- (beginning-of-line 2))
- (move-marker end nil)
- (org-goto-line linepos)
- (org-table-goto-column colpos)
+ (end (copy-marker (org-table-end))))
+ (org-table-save-field
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (org-at-table-hline-p)
+ (org-table-goto-column col t)
+ (insert "| "))
+ (forward-line)))
+ (set-marker end nil)
(org-table-align)
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
@@ -1384,58 +1396,55 @@ However, when FORCE is non-nil, create new columns if necessary."
(defun org-table-line-to-dline (line &optional above)
"Turn a buffer line number into a data line number.
+
If there is no data line in this line, return nil.
-If there is no matching dline (most likely te reference was a hline), the
-first dline below it is used. When ABOVE is non-nil, the one above is used."
- (catch 'exit
- (let ((ll (length org-table-dlines))
- i)
- (if above
- (progn
- (setq i (1- ll))
- (while (> i 0)
- (if (<= (aref org-table-dlines i) line)
- (throw 'exit i))
- (setq i (1- i))))
- (setq i 1)
- (while (< i ll)
- (if (>= (aref org-table-dlines i) line)
- (throw 'exit i))
- (setq i (1+ i)))))
- nil))
+
+If there is no matching dline (most likely the reference was
+a hline), the first dline below it is used. When ABOVE is
+non-nil, the one above is used."
+ (let ((min 1)
+ (max (1- (length org-table-dlines))))
+ (cond ((or (> (aref org-table-dlines min) line)
+ (< (aref org-table-dlines max) line))
+ nil)
+ ((= (aref org-table-dlines max) line) max)
+ (t (catch 'exit
+ (while (> (- max min) 1)
+ (let* ((mean (/ (+ max min) 2))
+ (v (aref org-table-dlines mean)))
+ (cond ((= v line) (throw 'exit mean))
+ ((> v line) (setq max mean))
+ (t (setq min mean)))))
+ (if above min max))))))
;;;###autoload
(defun org-table-delete-column ()
"Delete a column from the table."
(interactive)
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
- (let* ((col (org-table-current-column))
- (beg (org-table-begin))
- (end (org-table-end))
- ;; Current cursor position
- (linepos (org-current-line))
- (colpos col))
- (goto-char beg)
- (while (< (point) end)
- (if (org-at-table-hline-p)
- nil
- (org-table-goto-column col t)
- (and (looking-at "|[^|\n]+|")
- (replace-match "|")))
- (beginning-of-line 2))
- (move-marker end nil)
- (org-goto-line linepos)
- (org-table-goto-column colpos)
+ (let ((col (org-table-current-column))
+ (beg (org-table-begin))
+ (end (copy-marker (org-table-end))))
+ (org-table-save-field
+ (goto-char beg)
+ (while (< (point) end)
+ (if (org-at-table-hline-p)
+ nil
+ (org-table-goto-column col t)
+ (and (looking-at "|[^|\n]+|")
+ (replace-match "|")))
+ (forward-line)))
+ (set-marker end nil)
+ (org-table-goto-column (max 1 (1- col)))
(org-table-align)
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID"))
- col -1 col)
- (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID"))
- col -1 col))))
+ (org-table-fix-formulas
+ "$" (list (cons (number-to-string col) "INVALID")) col -1 col)
+ (org-table-fix-formulas
+ "$LR" (list (cons (number-to-string col) "INVALID")) col -1 col))))
;;;###autoload
(defun org-table-move-column-right ()
@@ -1452,31 +1461,27 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(defun org-table-move-column (&optional left)
"Move the current column to the right. With arg LEFT, move to the left."
(interactive "P")
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
(let* ((col (org-table-current-column))
(col1 (if left (1- col) col))
+ (colpos (if left (1- col) (1+ col)))
(beg (org-table-begin))
- (end (org-table-end))
- ;; Current cursor position
- (linepos (org-current-line))
- (colpos (if left (1- col) (1+ col))))
- (if (and left (= col 1))
- (user-error "Cannot move column further left"))
- (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
- (user-error "Cannot move column further right"))
- (goto-char beg)
- (while (< (point) end)
- (if (org-at-table-hline-p)
- nil
- (org-table-goto-column col1 t)
- (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
- (replace-match "|\\2|\\1|")))
- (beginning-of-line 2))
- (move-marker end nil)
- (org-goto-line linepos)
+ (end (copy-marker (org-table-end))))
+ (when (and left (= col 1))
+ (user-error "Cannot move column further left"))
+ (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
+ (user-error "Cannot move column further right"))
+ (org-table-save-field
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (org-at-table-hline-p)
+ (org-table-goto-column col1 t)
+ (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
+ (replace-match "|\\2|\\1|")))
+ (forward-line)))
+ (set-marker end nil)
(org-table-goto-column colpos)
(org-table-align)
(when (or (not org-table-fix-formulas-confirm)
@@ -1623,7 +1628,7 @@ In particular, this does handle wide and invisible characters."
dline -1 dline))))
;;;###autoload
-(defun org-table-sort-lines (with-case &optional sorting-type)
+(defun org-table-sort-lines (with-case &optional sorting-type getkey-func compare-func)
"Sort table lines according to the column at point.
The position of point indicates the column to be used for
@@ -1636,76 +1641,107 @@ should be in the last line to be included into the sorting.
The command then prompts for the sorting type which can be
alphabetically, numerically, or by time (as given in a time stamp
-in the field). Sorting in reverse order is also possible.
+in the field, or as a HH:MM value). Sorting in reverse order is
+also possible.
With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
If SORTING-TYPE is specified when this function is called from a Lisp
program, no prompting will take place. SORTING-TYPE must be a character,
-any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting
-should be done in reverse order."
+any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that
+sorting should be done in reverse order.
+
+If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
+a function to be called to extract the key. It must return either
+a string or a number that should serve as the sorting key for that
+row. It will then use COMPARE-FUNC to compare entries. If GETKEY-FUNC
+is specified interactively, the comparison will be either a string or
+numeric compare based on the type of the first key in the table."
(interactive "P")
- (let* ((thisline (org-current-line))
- (thiscol (org-table-current-column))
- (otc org-table-overlay-coordinates)
- beg end bcol ecol tend tbeg column lns pos)
- (when (equal thiscol 0)
- (if (org-called-interactively-p 'any)
- (setq thiscol
- (string-to-number
- (read-string "Use column N for sorting: ")))
- (setq thiscol 1))
- (org-table-goto-column thiscol))
- (org-table-check-inside-data-field)
- (if (org-region-active-p)
- (progn
- (setq beg (region-beginning) end (region-end))
- (goto-char beg)
- (setq column (org-table-current-column)
- beg (point-at-bol))
- (goto-char end)
- (setq end (point-at-bol 2)))
- (setq column (org-table-current-column)
- pos (point)
- tbeg (org-table-begin)
- tend (org-table-end))
- (if (re-search-backward org-table-hline-regexp tbeg t)
- (setq beg (point-at-bol 2))
- (goto-char tbeg)
- (setq beg (point-at-bol 1)))
- (goto-char pos)
- (if (re-search-forward org-table-hline-regexp tend t)
- (setq end (point-at-bol 1))
- (goto-char tend)
- (setq end (point-at-bol))))
- (setq beg (move-marker (make-marker) beg)
- end (move-marker (make-marker) end))
- (untabify beg end)
- (goto-char beg)
- (org-table-goto-column column)
- (skip-chars-backward "^|")
- (setq bcol (current-column))
- (org-table-goto-column (1+ column))
- (skip-chars-backward "^|")
- (setq ecol (1- (current-column)))
- (org-table-goto-column column)
- (setq lns (mapcar (lambda(x) (cons
- (org-sort-remove-invisible
- (nth (1- column)
- (org-split-string x "[ \t]*|[ \t]*")))
- x))
- (org-split-string (buffer-substring beg end) "\n")))
- (setq lns (org-do-sort lns "Table" with-case sorting-type))
- (when org-table-overlay-coordinates
- (org-table-toggle-coordinate-overlays))
- (delete-region beg end)
- (move-marker beg nil)
- (move-marker end nil)
- (insert (mapconcat 'cdr lns "\n") "\n")
- (org-goto-line thisline)
- (org-table-goto-column thiscol)
- (when otc (org-table-toggle-coordinate-overlays))
- (message "%d lines sorted, based on column %d" (length lns) column)))
+ (when (org-region-active-p) (goto-char (region-beginning)))
+ ;; Point must be either within a field or before a data line.
+ (save-excursion
+ (skip-chars-backward " \t")
+ (when (bolp) (search-forward "|" (line-end-position) t))
+ (org-table-check-inside-data-field))
+ ;; 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)
+ (read-number "Use column N for sorting: "))
+ (t 1))))
+ (sorting-type
+ (or sorting-type
+ (read-char-exclusive "Sort Table: [a]lphabetic, [n]umeric, \
+\[t]ime, [f]unc. A/N/T/F means reversed: "))))
+ (save-restriction
+ ;; Narrow buffer to appropriate sorting area.
+ (if (org-region-active-p)
+ (progn (goto-char (region-beginning))
+ (narrow-to-region
+ (point)
+ (save-excursion (goto-char (region-end))
+ (line-beginning-position 2))))
+ (let ((start (org-table-begin))
+ (end (org-table-end)))
+ (narrow-to-region
+ (save-excursion
+ (if (re-search-backward org-table-hline-regexp start t)
+ (line-beginning-position 2)
+ start))
+ (if (save-excursion (re-search-forward org-table-hline-regexp end t))
+ (match-beginning 0)
+ end))))
+ ;; Determine arguments for `sort-subr'. Also record original
+ ;; position. `org-table-save-field' cannot help here since
+ ;; sorting is too much destructive.
+ (let* ((sort-fold-case (not with-case))
+ (coordinates
+ (cons (count-lines (point-min) (line-beginning-position))
+ (current-column)))
+ (extract-key-from-field
+ ;; Function to be called on the contents of the field
+ ;; used for sorting in the current row.
+ (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
+ (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)
+ (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
+ ((?n ?N ?t ?T) #'<)
+ ((?a ?A) #'string<)
+ ((?f ?F) compare-func))))
+ (goto-char (point-min))
+ (sort-subr (memq sorting-type '(?A ?N ?T ?F))
+ (lambda ()
+ (forward-line)
+ (while (and (not (eobp))
+ (not (looking-at org-table-dataline-regexp)))
+ (forward-line)))
+ #'end-of-line
+ (lambda ()
+ (funcall extract-key-from-field
+ (org-trim (org-table-get-field column))))
+ nil
+ predicate)
+ ;; Move back to initial field.
+ (forward-line (car coordinates))
+ (move-to-column (cdr coordinates))))))
;;;###autoload
(defun org-table-cut-region (beg end)
@@ -1725,34 +1761,31 @@ with `org-table-paste-rectangle'."
(if (org-region-active-p) (region-beginning) (point))
(if (org-region-active-p) (region-end) (point))
current-prefix-arg))
- (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
- region cols
- (rpl (if cut " " nil)))
- (goto-char beg)
- (org-table-check-inside-data-field)
- (setq l01 (org-current-line)
- c01 (org-table-current-column))
- (goto-char end)
+ (goto-char (min beg end))
+ (org-table-check-inside-data-field)
+ (let ((beg (line-beginning-position))
+ (c01 (org-table-current-column))
+ region)
+ (goto-char (max beg end))
(org-table-check-inside-data-field)
- (setq l02 (org-current-line)
- c02 (org-table-current-column))
- (setq l1 (min l01 l02) l2 (max l01 l02)
- c1 (min c01 c02) c2 (max c01 c02))
- (catch 'exit
- (while t
- (catch 'nextline
- (if (> l1 l2) (throw 'exit t))
- (org-goto-line l1)
- (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1))))
- (setq cols nil ic1 c1 ic2 c2)
- (while (< ic1 (1+ ic2))
- (push (org-table-get-field ic1 rpl) cols)
- (setq ic1 (1+ ic1)))
- (push (nreverse cols) region)
- (setq l1 (1+ l1)))))
- (setq org-table-clip (nreverse region))
- (if cut (org-table-align))
- org-table-clip))
+ (let* ((end (copy-marker (line-end-position)))
+ (c02 (org-table-current-column))
+ (column-start (min c01 c02))
+ (column-end (max c01 c02))
+ (column-number (1+ (- column-end column-start)))
+ (rpl (and cut " ")))
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (org-at-table-hline-p)
+ ;; Collect every cell between COLUMN-START and COLUMN-END.
+ (let (cols)
+ (dotimes (c column-number)
+ (push (org-table-get-field (+ c column-start) rpl) cols))
+ (push (nreverse cols) region)))
+ (forward-line))
+ (set-marker end nil))
+ (when cut (org-table-align))
+ (setq org-table-clip (nreverse region))))
;;;###autoload
(defun org-table-paste-rectangle ()
@@ -1762,27 +1795,25 @@ will be overwritten. If the rectangle does not fit into the present table,
the table is enlarged as needed. The process ignores horizontal separator
lines."
(interactive)
- (unless (and org-table-clip (listp org-table-clip))
+ (unless (consp org-table-clip)
(user-error "First cut/copy a region to paste!"))
(org-table-check-inside-data-field)
- (let* ((clip org-table-clip)
- (line (org-current-line))
- (col (org-table-current-column))
+ (let* ((column (org-table-current-column))
(org-enable-table-editor t)
- (org-table-automatic-realign nil)
- c cols field)
- (while (setq cols (pop clip))
- (while (org-at-table-hline-p) (beginning-of-line 2))
- (if (not (org-at-table-p))
- (progn (end-of-line 0) (org-table-next-field)))
- (setq c col)
- (while (setq field (pop cols))
- (org-table-goto-column c nil 'force)
- (org-table-get-field nil field)
- (setq c (1+ c)))
- (beginning-of-line 2))
- (org-goto-line line)
- (org-table-goto-column col)
+ (org-table-automatic-realign nil))
+ (org-table-save-field
+ (dolist (row org-table-clip)
+ (while (org-at-table-hline-p) (forward-line))
+ ;; If we left the table, create a new row.
+ (when (and (bolp) (not (looking-at "[ \t]*|")))
+ (end-of-line 0)
+ (org-table-next-field))
+ (let ((c column))
+ (dolist (field row)
+ (org-table-goto-column c nil 'force)
+ (org-table-get-field nil field)
+ (incf c)))
+ (forward-line)))
(org-table-align)))
;;;###autoload
@@ -1799,8 +1830,8 @@ blindly applies a recipe that works for simple tables."
(require 'table)
(if (org-at-table.el-p)
;; convert to Org-mode table
- (let ((beg (move-marker (make-marker) (org-table-begin t)))
- (end (move-marker (make-marker) (org-table-end t))))
+ (let ((beg (copy-marker (org-table-begin t)))
+ (end (copy-marker (org-table-end t))))
(table-unrecognize-region beg end)
(goto-char beg)
(while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t)
@@ -1808,8 +1839,8 @@ blindly applies a recipe that works for simple tables."
(goto-char beg))
(if (org-at-table-p)
;; convert to table.el table
- (let ((beg (move-marker (make-marker) (org-table-begin)))
- (end (move-marker (make-marker) (org-table-end))))
+ (let ((beg (copy-marker (org-table-begin)))
+ (end (copy-marker (org-table-end))))
;; first, get rid of all horizontal lines
(goto-char beg)
(while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t)
@@ -1832,7 +1863,7 @@ blindly applies a recipe that works for simple tables."
(goto-char beg)))))
(defun org-table-transpose-table-at-point ()
- "Transpose orgmode table at point and eliminate hlines.
+ "Transpose Org table at point and eliminate hlines.
So a table like
| 1 | 2 | 4 | 5 |
@@ -1847,9 +1878,11 @@ will be transposed as
| 4 | c | g |
| 5 | d | h |
-Note that horizontal lines disappeared."
+Note that horizontal lines disappear."
(interactive)
(let* ((table (delete 'hline (org-table-to-lisp)))
+ (dline_old (org-table-current-line))
+ (col_old (org-table-current-column))
(contents (mapcar (lambda (p)
(let ((tp table))
(mapcar
@@ -1859,10 +1892,17 @@ Note that horizontal lines disappeared."
(setq tp (cdr tp))))
table)))
(car table))))
- (delete-region (org-table-begin) (org-table-end))
- (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
- contents ""))
- (org-table-align)))
+ (goto-char (org-table-begin))
+ (re-search-forward "|")
+ (backward-char)
+ (delete-region (point) (org-table-end))
+ (insert (mapconcat
+ (lambda(x)
+ (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
+ contents ""))
+ (org-table-goto-line col_old)
+ (org-table-goto-column dline_old))
+ (org-table-align))
;;;###autoload
(defun org-table-wrap-region (arg)
@@ -1873,7 +1913,8 @@ lines, in order to keep the table compact.
If there is an active region, and both point and mark are in the same column,
the text in the column is wrapped to minimum width for the given number of
lines. Generally, this makes the table more compact. A prefix ARG may be
-used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]'
+used to change the number of desired lines. For example, \
+`C-2 \\[org-table-wrap-region]'
formats the selected text to two lines. If the region was longer than two
lines, the remaining lines remain empty. A negative prefix argument reduces
the current number of lines by that amount. The wrapped text is pasted back
@@ -1890,48 +1931,43 @@ blank, and the content is appended to the field above."
(interactive "P")
(org-table-check-inside-data-field)
(if (org-region-active-p)
- ;; There is a region: fill as a paragraph
- (let* ((beg (region-beginning))
- (cline (save-excursion (goto-char beg) (org-current-line)))
- (ccol (save-excursion (goto-char beg) (org-table-current-column)))
- nlines)
+ ;; There is a region: fill as a paragraph.
+ (let ((start (region-beginning)))
(org-table-cut-region (region-beginning) (region-end))
- (if (> (length (car org-table-clip)) 1)
- (user-error "Region must be limited to single column"))
- (setq nlines (if arg
- (if (< arg 1)
- (+ (length org-table-clip) arg)
- arg)
- (length org-table-clip)))
- (setq org-table-clip
- (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
- nil nlines)))
- (org-goto-line cline)
- (org-table-goto-column ccol)
+ (when (> (length (car org-table-clip)) 1)
+ (user-error "Region must be limited to single column"))
+ (let ((nlines (cond ((not arg) (length org-table-clip))
+ ((< arg 1) (+ (length org-table-clip) arg))
+ (t arg))))
+ (setq org-table-clip
+ (mapcar #'list
+ (org-wrap (mapconcat #'car org-table-clip " ")
+ nil
+ nlines))))
+ (goto-char start)
(org-table-paste-rectangle))
- ;; No region, split the current field at point
+ ;; No region, split the current field at point.
(unless (org-get-alist-option org-M-RET-may-split-line 'table)
(skip-chars-forward "^\r\n|"))
- (if arg
- ;; combine with field above
- (let ((s (org-table-blank-field))
- (col (org-table-current-column)))
- (beginning-of-line 0)
- (while (org-at-table-hline-p) (beginning-of-line 0))
- (org-table-goto-column col)
- (skip-chars-forward "^|")
- (skip-chars-backward " ")
- (insert " " (org-trim s))
- (org-table-align))
- ;; split field
- (if (looking-at "\\([^|]+\\)+|")
- (let ((s (match-string 1)))
- (replace-match " |")
- (goto-char (match-beginning 0))
- (org-table-next-row)
- (insert (org-trim s) " ")
- (org-table-align))
- (org-table-next-row)))))
+ (cond
+ (arg ; Combine with field above.
+ (let ((s (org-table-blank-field))
+ (col (org-table-current-column)))
+ (forward-line -1)
+ (while (org-at-table-hline-p) (forward-line -1))
+ (org-table-goto-column col)
+ (skip-chars-forward "^|")
+ (skip-chars-backward " ")
+ (insert " " (org-trim s))
+ (org-table-align)))
+ ((looking-at "\\([^|]+\\)+|") ; Split field.
+ (let ((s (match-string 1)))
+ (replace-match " |")
+ (goto-char (match-beginning 0))
+ (org-table-next-row)
+ (insert (org-trim s) " ")
+ (org-table-align)))
+ (t (org-table-next-row)))))
(defvar org-field-marker nil)
@@ -2120,29 +2156,31 @@ If NLAST is a number, only the NLAST fields will actually be summed."
(defun org-table-current-field-formula (&optional key noerror)
"Return the formula active for the current field.
-Assumes that specials are in place.
-If KEY is given, return the key to this formula.
-Otherwise return the formula preceded with \"=\" or \":=\"."
- (let* ((name (car (rassoc (list (org-current-line)
- (org-table-current-column))
+
+Assumes that table is already analyzed. If KEY is given, return
+the key to this formula. Otherwise return the formula preceded
+with \"=\" or \":=\"."
+ (let* ((col (org-table-current-column))
+ (name (car (rassoc (list (count-lines org-table-current-begin-pos
+ (line-beginning-position))
+ col)
org-table-named-field-locations)))
- (col (org-table-current-column))
(scol (int-to-string col))
(ref (format "@%d$%d" (org-table-current-dline) col))
(stored-list (org-table-get-stored-formulas noerror))
(ass (or (assoc name stored-list)
(assoc ref stored-list)
(assoc scol stored-list))))
- (if key
- (car ass)
- (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=")
- (cdr ass))))))
+ (cond (key (car ass))
+ (ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=")
+ (cdr ass))))))
(defun org-table-get-formula (&optional equation named)
"Read a formula from the minibuffer, offer stored formula as default.
When NAMED is non-nil, look for a named equation."
(let* ((stored-list (org-table-get-stored-formulas))
- (name (car (rassoc (list (org-current-line)
+ (name (car (rassoc (list (count-lines org-table-current-begin-pos
+ (line-beginning-position))
(org-table-current-column))
org-table-named-field-locations)))
(ref (format "@%d$%d" (org-table-current-dline)
@@ -2305,83 +2343,6 @@ For all numbers larger than LIMIT, shift them by DELTA."
(message msg))))))
(forward-line))))
-(defun org-table-get-specials ()
- "Get the column names and local parameters for this table."
- (save-excursion
- (let ((beg (org-table-begin)) (end (org-table-end))
- names name fields fields1 field cnt
- c v l line col types dlines hlines last-dline)
- (setq org-table-column-names nil
- org-table-local-parameters nil
- org-table-named-field-locations nil
- org-table-current-begin-line nil
- org-table-current-begin-pos nil
- org-table-current-line-types nil
- org-table-current-ncol 0)
- (goto-char beg)
- (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
- (setq names (org-split-string (match-string 1) " *| *")
- cnt 1)
- (while (setq name (pop names))
- (setq cnt (1+ cnt))
- (if (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" name)
- (push (cons name (int-to-string cnt)) org-table-column-names))))
- (setq org-table-column-names (nreverse org-table-column-names))
- (setq org-table-column-name-regexp
- (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>"))
- (goto-char beg)
- (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
- (setq fields (org-split-string (match-string 1) " *| *"))
- (while (setq field (pop fields))
- (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field)
- (push (cons (match-string 1 field) (match-string 2 field))
- org-table-local-parameters))))
- (goto-char beg)
- (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
- (setq c (match-string 1)
- fields (org-split-string (match-string 2) " *| *"))
- (save-excursion
- (beginning-of-line (if (equal c "_") 2 0))
- (setq line (org-current-line) col 1)
- (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
- (setq fields1 (org-split-string (match-string 1) " *| *"))))
- (while (and fields1 (setq field (pop fields)))
- (setq v (pop fields1) col (1+ col))
- (when (and (stringp field) (stringp v)
- (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field))
- (push (cons field v) org-table-local-parameters)
- (push (list field line col) org-table-named-field-locations))))
- ;; Analyse the line types
- (goto-char beg)
- (setq org-table-current-begin-line (org-current-line)
- org-table-current-begin-pos (point)
- l org-table-current-begin-line)
- (while (looking-at "[ \t]*|\\(-\\)?")
- (push (if (match-end 1) 'hline 'dline) types)
- (if (match-end 1) (push l hlines) (push l dlines))
- (beginning-of-line 2)
- (setq l (1+ l)))
- (push 'hline types) ;; add an imaginary extra hline to the end
- (setq org-table-current-line-types (apply 'vector (nreverse types))
- last-dline (car dlines)
- org-table-dlines (apply 'vector (cons nil (nreverse dlines)))
- org-table-hlines (apply 'vector (cons nil (nreverse hlines))))
- (org-goto-line last-dline)
- (let* ((l last-dline)
- (fields (org-split-string
- (buffer-substring (point-at-bol) (point-at-eol))
- "[ \t]*|[ \t]*"))
- (nfields (length fields))
- al al2)
- (setq org-table-current-ncol nfields)
- (loop for i from 1 to nfields do
- (push (list (format "LR%d" i) l i) al)
- (push (cons (format "LR%d" i) (nth (1- i) fields)) al2))
- (setq org-table-named-field-locations
- (append org-table-named-field-locations al))
- (setq org-table-local-parameters
- (append org-table-local-parameters al2))))))
-
;;;###autoload
(defun org-table-maybe-eval-formula ()
"Check if the current field starts with \"=\" or \":=\".
@@ -2424,56 +2385,196 @@ After each change, a message will be displayed indicating the meaning
of the new mark."
(interactive)
(unless (org-at-table-p) (user-error "Not at a table"))
- (let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
- (beg (org-table-begin))
- (end (org-table-end))
- (l (org-current-line))
- (l1 (if (org-region-active-p) (org-current-line (region-beginning))))
- (l2 (if (org-region-active-p) (org-current-line (region-end))))
- (have-col
- (save-excursion
- (goto-char beg)
- (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t))))
+ (let* ((region (org-region-active-p))
+ (l1 (and region
+ (save-excursion (goto-char (region-beginning))
+ (copy-marker (line-beginning-position)))))
+ (l2 (and region
+ (save-excursion (goto-char (region-end))
+ (copy-marker (line-beginning-position)))))
+ (l (copy-marker (line-beginning-position)))
(col (org-table-current-column))
- (forcenew (car (assoc newchar org-recalc-marks)))
- epos new)
- (when l1
- (message "Change region to what mark? Type # * ! $ or SPC: ")
- (setq newchar (char-to-string (read-char-exclusive))
- forcenew (car (assoc newchar org-recalc-marks))))
- (if (and newchar (not forcenew))
- (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
- newchar))
- (if l1 (org-goto-line l1))
+ (newchar (if region
+ (char-to-string
+ (read-char-exclusive
+ "Change region to what mark? Type # * ! $ or SPC: "))
+ newchar))
+ (no-special-column
+ (save-excursion
+ (goto-char (org-table-begin))
+ (re-search-forward
+ "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" (org-table-end) t))))
+ (when (and newchar (not (assoc newchar org-recalc-marks)))
+ (user-error "Invalid character `%s' in `org-table-rotate-recalc-marks'"
+ newchar))
+ (when l1 (goto-char l1))
(save-excursion
- (beginning-of-line 1)
+ (beginning-of-line)
(unless (looking-at org-table-dataline-regexp)
(user-error "Not at a table data line")))
- (unless have-col
+ (when no-special-column
(org-table-goto-column 1)
- (org-table-insert-column)
- (org-table-goto-column (1+ col)))
- (setq epos (point-at-eol))
+ (org-table-insert-column))
+ (let ((previous-line-end (line-end-position))
+ (newchar
+ (save-excursion
+ (beginning-of-line)
+ (cond ((not (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")) "#")
+ (newchar)
+ (t (cadr (member (match-string 1)
+ (append (mapcar #'car org-recalc-marks)
+ '(" ")))))))))
+ ;; Rotate mark in first row.
+ (org-table-get-field 1 (format " %s " newchar))
+ ;; Rotate marks in additional rows if a region is active.
+ (when region
+ (save-excursion
+ (forward-line)
+ (while (<= (point) l2)
+ (when (looking-at org-table-dataline-regexp)
+ (org-table-get-field 1 (format " %s " newchar)))
+ (forward-line))))
+ ;; Only align if rotation actually changed lines' length.
+ (when (/= previous-line-end (line-end-position)) (org-table-align)))
+ (goto-char l)
+ (org-table-goto-column (if no-special-column (1+ col) col))
+ (when l1 (set-marker l1 nil))
+ (when l2 (set-marker l2 nil))
+ (set-marker l nil)
+ (when (org-called-interactively-p 'interactive)
+ (message "%s" (cdr (assoc newchar org-recalc-marks))))))
+
+;;;###autoload
+(defun org-table-analyze ()
+ "Analyze table at point and store results.
+
+This function sets up the following dynamically scoped variables:
+
+ `org-table-column-name-regexp',
+ `org-table-column-names',
+ `org-table-current-begin-pos',
+ `org-table-current-line-types',
+ `org-table-current-ncol',
+ `org-table-dlines',
+ `org-table-hlines',
+ `org-table-local-parameters',
+ `org-table-named-field-locations'."
+ (let ((beg (org-table-begin))
+ (end (org-table-end)))
(save-excursion
- (beginning-of-line 1)
- (org-table-get-field
- 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")
- (concat " "
- (setq new (or forcenew
- (cadr (member (match-string 1) marks))))
- " ")
- " # ")))
- (if (and l1 l2)
- (progn
- (org-goto-line l1)
- (while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
- (and (looking-at org-table-dataline-regexp)
- (org-table-get-field 1 (concat " " new " "))))
- (org-goto-line l1)))
- (if (not (= epos (point-at-eol))) (org-table-align))
- (org-goto-line l)
- (and (org-called-interactively-p 'interactive)
- (message "%s" (cdr (assoc new org-recalc-marks))))))
+ (goto-char beg)
+ ;; Extract column names.
+ (setq org-table-column-names nil)
+ (when (save-excursion
+ (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t))
+ (let ((c 1))
+ (dolist (name (org-split-string (match-string 1) " *| *"))
+ (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))
+ (setq org-table-column-name-regexp
+ (format "\\$\\(%s\\)\\>"
+ (regexp-opt (mapcar #'car org-table-column-names) t)))
+ ;; Extract local parameters.
+ (setq org-table-local-parameters nil)
+ (save-excursion
+ (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
+ (dolist (field (org-split-string (match-string 1) " *| *"))
+ (when (string-match
+ "\\`\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field)
+ (push (cons (match-string 1 field) (match-string 2 field))
+ org-table-local-parameters)))))
+ ;; Update named fields locations. We minimize `count-lines'
+ ;; processing by storing last known number of lines in LAST.
+ (setq org-table-named-field-locations nil)
+ (save-excursion
+ (let ((last (cons (point) 0)))
+ (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
+ (let ((c (match-string 1))
+ (fields (org-split-string (match-string 2) " *| *")))
+ (save-excursion
+ (forward-line (if (equal c "_") 1 -1))
+ (let ((fields1
+ (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
+ (org-split-string (match-string 1) " *| *")))
+ (line (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)
+ (when (and (stringp field)
+ (stringp v)
+ (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'"
+ field))
+ (push (cons field v) org-table-local-parameters)
+ (push (list field line col)
+ org-table-named-field-locations))))))))))
+ ;; Re-use existing markers when possible.
+ (if (markerp org-table-current-begin-pos)
+ (move-marker org-table-current-begin-pos (point))
+ (setq org-table-current-begin-pos (point-marker)))
+ ;; Analyze the line types.
+ (let ((l 0) hlines dlines types)
+ (while (looking-at "[ \t]*|\\(-\\)?")
+ (push (if (match-end 1) 'hline 'dline) types)
+ (if (match-end 1) (push l hlines) (push l dlines))
+ (forward-line)
+ (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))))
+ (setq org-table-hlines (apply #'vector (cons nil (nreverse hlines))))
+ (forward-line -1)
+ (let* ((last-dline (car dlines))
+ (fields (org-split-string
+ (buffer-substring (line-beginning-position)
+ (line-end-position))
+ "[ \t]*|[ \t]*"))
+ (nfields (length fields))
+ al al2)
+ (setq org-table-current-ncol nfields)
+ (dotimes (i nfields)
+ (let ((column (1+ i)))
+ (push (list (format "LR%d" column) last-dline column) al)
+ (push (cons (format "LR%d" column) (nth i fields)) al2)))
+ (setq org-table-named-field-locations
+ (append org-table-named-field-locations al))
+ (setq org-table-local-parameters
+ (append org-table-local-parameters al2)))))))
+
+(defun org-table-goto-field (ref &optional create-column-p)
+ "Move point to a specific field in the current table.
+
+REF is either the name of a field its absolute reference, as
+a string. No column is created unless CREATE-COLUMN-P is
+non-nil. If it is a function, it is called with the column
+number as its argument as is used as a predicate to know if the
+column can be created.
+
+This function assumes the table is already analyzed (i.e., using
+`org-table-analyze')."
+ (let* ((coordinates
+ (cond
+ ((cdr (assoc ref org-table-named-field-locations)))
+ ((string-match "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" ref)
+ (cons (condition-case nil
+ (aref org-table-dlines
+ (string-to-number (match-string 1 ref)))
+ (error (user-error "Invalid row number in %s" ref)))
+ (string-to-number (match-string 2 ref))))
+ (t (user-error "Unknown field: %s" ref))))
+ (line (car coordinates))
+ (column (cdr coordinates))
+ (create-new-column (if (functionp create-column-p)
+ (funcall create-column-p column)
+ create-column-p)))
+ (when coordinates
+ (goto-char org-table-current-begin-pos)
+ (forward-line line)
+ (org-table-goto-column column nil create-new-column))))
;;;###autoload
(defun org-table-maybe-recalculate-line ()
@@ -2481,7 +2582,7 @@ of the new mark."
(interactive)
(and org-table-allow-automatic-line-recalculation
(not (and (memq last-command org-recalc-commands)
- (equal org-last-recalc-line (org-current-line))))
+ (eq org-last-recalc-line (line-beginning-position))))
(save-excursion (beginning-of-line 1)
(looking-at org-table-auto-recalculate-regexp))
(org-table-recalculate) t))
@@ -2540,7 +2641,7 @@ it is already stored, or because it is a modified equation that should
not overwrite the stored one."
(interactive "P")
(org-table-check-inside-data-field)
- (or suppress-analysis (org-table-get-specials))
+ (or suppress-analysis (org-table-analyze))
(if (equal arg '(16))
(let ((eq (org-table-current-field-formula)))
(or eq (user-error "No equation active for current field"))
@@ -2557,7 +2658,7 @@ not overwrite the stored one."
(org-table-get-formula equation (equal arg '(4)))))
(n0 (org-table-current-column))
(org-tbl-calc-modes (copy-sequence org-calc-default-modes))
- (numbers nil) ; was a variable, now fixed default
+ (numbers nil) ; was a variable, now fixed default
(keep-empty nil)
n form form0 formrpl formrg bw fmt x ev orig c lispp literal
duration duration-output-format)
@@ -2641,9 +2742,10 @@ not overwrite the stored one."
t t form)))
;; Check for old vertical references
- (setq form (org-table-rewrite-old-row-references form))
+ (org-table--error-on-old-row-references form)
;; Insert remote references
- (while (string-match "\\<remote([ \t]*\\([-_a-zA-Z0-9]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form)
+ (setq form (org-table-remote-reference-indirection form))
+ (while (string-match "\\<remote([ \t]*\\([^,)]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form)
(setq form
(replace-match
(save-match-data
@@ -2660,8 +2762,10 @@ not overwrite the stored one."
;; Insert complex ranges
(while (and (string-match org-table-range-regexp form)
(> (length (match-string 0 form)) 1))
- (setq formrg (save-match-data
- (org-table-get-range (match-string 0 form) nil n0)))
+ (setq formrg
+ (save-match-data
+ (org-table-get-range
+ (match-string 0 form) org-table-current-begin-pos n0)))
(setq formrpl
(save-match-data
(org-table-make-reference
@@ -2676,15 +2780,19 @@ not overwrite the stored one."
(string-match (regexp-quote form) formrpl)))
(setq form (replace-match formrpl t t form))
(user-error "Spreadsheet error: invalid reference \"%s\"" form)))
- ;; Insert simple ranges
- (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
+ ;; Insert simple ranges, i.e. included in the current row.
+ (while (string-match
+ "\\$\\(\\([-+]\\)?[0-9]+\\)\\.\\.\\$\\(\\([-+]\\)?[0-9]+\\)"
+ form)
(setq form
(replace-match
(save-match-data
(org-table-make-reference
- (org-sublist
- fields (string-to-number (match-string 1 form))
- (string-to-number (match-string 2 form)))
+ (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))))
keep-empty numbers lispp))
t t form)))
(setq form0 form)
@@ -2692,14 +2800,16 @@ not overwrite the stored one."
(while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
(setq n (+ (string-to-number (match-string 1 form))
(if (match-end 2) n0 0))
- x (nth (1- (if (= n 0) n0 (max n 1))) fields))
- (unless x (user-error "Invalid field specifier \"%s\""
- (match-string 0 form)))
- (setq form (replace-match
- (save-match-data
- (org-table-make-reference
- x keep-empty numbers lispp))
- t t form)))
+ x (nth (1- (if (= n 0) n0 (max n 1))) fields)
+ formrpl (save-match-data
+ (org-table-make-reference
+ x keep-empty numbers lispp)))
+ (when (or (not x)
+ (save-match-data
+ (string-match (regexp-quote formula) formrpl)))
+ (user-error "Invalid field specifier \"%s\""
+ (match-string 0 form)))
+ (setq form (replace-match formrpl t t form)))
(if lispp
(setq ev (condition-case nil
@@ -2742,7 +2852,7 @@ Orig: %s
$xyz-> %s
@r$c-> %s
$1-> %s\n" orig formula form0 form))
- (if (listp ev)
+ (if (consp ev)
(princ (format " %s^\nError: %s"
(make-string (car ev) ?\-) (nth 1 ev)))
(princ (format "Result: %s\nFormat: %s\nFinal: %s"
@@ -2757,7 +2867,7 @@ $1-> %s\n" orig formula form0 form))
(user-error "Abort"))
(delete-window bw)
(message "")))
- (if (listp ev) (setq fmt nil ev "#ERROR"))
+ (when (consp ev) (setq fmt nil ev "#ERROR"))
(org-table-justify-field-maybe
(format org-table-formula-field-format
(if fmt (format fmt (string-to-number ev)) ev)))
@@ -2776,139 +2886,143 @@ $1-> %s\n" orig formula form0 form))
(defun org-table-get-range (desc &optional tbeg col highlight corners-only)
"Get a calc vector from a column, according to descriptor DESC.
+
Optional arguments TBEG and COL can give the beginning of the table and
the current column, to avoid unnecessary parsing.
HIGHLIGHT means just highlight the range.
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
-in the buffer and column1 and column2 are table column numbers."
- (if (not (equal (string-to-char desc) ?@))
- (setq desc (concat "@" desc)))
- (save-excursion
- (or tbeg (setq tbeg (org-table-begin)))
- (or col (setq col (org-table-current-column)))
- (let ((thisline (org-current-line))
- beg end c1 c2 r1 r2 rangep tmp)
- (unless (string-match org-table-range-regexp desc)
- (user-error "Invalid table range specifier `%s'" desc))
- (setq rangep (match-end 3)
- r1 (and (match-end 1) (match-string 1 desc))
- r2 (and (match-end 4) (match-string 4 desc))
- c1 (and (match-end 2) (substring (match-string 2 desc) 1))
- c2 (and (match-end 5) (substring (match-string 5 desc) 1)))
-
- (and c1 (setq c1 (+ (string-to-number c1)
- (if (memq (string-to-char c1) '(?- ?+)) col 0))))
- (and c2 (setq c2 (+ (string-to-number c2)
- (if (memq (string-to-char c2) '(?- ?+)) col 0))))
- (if (equal r1 "") (setq r1 nil))
- (if (equal r2 "") (setq r2 nil))
- (if r1 (setq r1 (org-table-get-descriptor-line r1)))
- (if r2 (setq r2 (org-table-get-descriptor-line r2)))
- ; (setq r2 (or r2 r1) c2 (or c2 c1))
- (if (not r1) (setq r1 thisline))
- (if (not r2) (setq r2 thisline))
- (if (or (not c1) (= 0 c1)) (setq c1 col))
- (if (or (not c2) (= 0 c2)) (setq c2 col))
- (if (and (not corners-only)
- (or (not rangep) (and (= r1 r2) (= c1 c2))))
- ;; just one field
- (progn
- (org-goto-line r1)
- (while (not (looking-at org-table-dataline-regexp))
- (beginning-of-line 2))
- (prog1 (org-trim (org-table-get-field c1))
- (if highlight (org-table-highlight-rectangle (point) (point)))))
- ;; A range, return a vector
- ;; First sort the numbers to get a regular rectangle
- (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
- (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
- (if corners-only
- ;; Only return the corners of the range
- (list r1 c1 r2 c2)
- ;; Copy the range values into a list
- (org-goto-line r1)
- (while (not (looking-at org-table-dataline-regexp))
- (beginning-of-line 2))
- (org-table-goto-column c1)
- (setq beg (point))
- (org-goto-line r2)
- (while (not (looking-at org-table-dataline-regexp))
- (beginning-of-line 0))
- (org-table-goto-column c2)
- (setq end (point))
- (if highlight
- (org-table-highlight-rectangle
- beg (progn (skip-chars-forward "^|\n") (point))))
- ;; return string representation of calc vector
- (mapcar 'org-trim
- (apply 'append (org-table-copy-region beg end))))))))
-
-(defun org-table-get-descriptor-line (desc &optional cline bline table)
- "Analyze descriptor DESC and retrieve the corresponding line number.
-The cursor is currently in line CLINE, the table begins in line BLINE,
-and TABLE is a vector with line types."
- (if (string-match "^[0-9]+$" desc)
+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 (eq (string-to-char desc) ?@) desc (concat "@" desc)))
+ (col (or col (org-table-current-column)))
+ (tbeg (or tbeg (org-table-begin)))
+ (thisline (count-lines tbeg (line-beginning-position))))
+ (unless (string-match org-table-range-regexp desc)
+ (user-error "Invalid table range specifier `%s'" desc))
+ (let ((rangep (match-end 3))
+ (r1 (let ((r (and (match-end 1) (match-string 1 desc))))
+ (or (save-match-data
+ (and (org-string-nw-p r)
+ (org-table--descriptor-line r thisline)))
+ thisline)))
+ (r2 (let ((r (and (match-end 4) (match-string 4 desc))))
+ (or (save-match-data
+ (and (org-string-nw-p r)
+ (org-table--descriptor-line r thisline)))
+ thisline)))
+ (c1 (let ((c (and (match-end 2) (substring (match-string 2 desc) 1))))
+ (if (or (not c) (= (string-to-number c) 0)) col
+ (+ (string-to-number c)
+ (if (memq (string-to-char c) '(?- ?+)) col 0)))))
+ (c2 (let ((c (and (match-end 5) (substring (match-string 5 desc) 1))))
+ (if (or (not c) (= (string-to-number c) 0)) col
+ (+ (string-to-number c)
+ (if (memq (string-to-char c) '(?- ?+)) col 0))))))
+ (save-excursion
+ (if (and (not corners-only)
+ (or (not rangep) (and (= r1 r2) (= c1 c2))))
+ ;; Just one field.
+ (progn
+ (forward-line (- r1 thisline))
+ (while (not (looking-at org-table-dataline-regexp))
+ (forward-line))
+ (prog1 (org-trim (org-table-get-field c1))
+ (when highlight (org-table-highlight-rectangle))))
+ ;; A range, return a vector. First sort the numbers to get
+ ;; a regular rectangle.
+ (let ((first-row (min r1 r2))
+ (last-row (max r1 r2))
+ (first-column (min c1 c2))
+ (last-column (max c1 c2)))
+ (if corners-only (list first-row first-column last-row last-column)
+ ;; Copy the range values into a list.
+ (forward-line (- first-row thisline))
+ (while (not (looking-at org-table-dataline-regexp))
+ (forward-line)
+ (incf first-row))
+ (org-table-goto-column first-column)
+ (let ((beg (point)))
+ (forward-line (- last-row first-row))
+ (while (not (looking-at org-table-dataline-regexp))
+ (forward-line -1))
+ (org-table-goto-column last-column)
+ (let ((end (point)))
+ (when highlight
+ (org-table-highlight-rectangle
+ beg (progn (skip-chars-forward "^|\n") (point))))
+ ;; Return string representation of calc vector.
+ (mapcar #'org-trim
+ (apply #'append
+ (org-table-copy-region beg end))))))))))))
+
+(defun org-table--descriptor-line (desc cline)
+ "Return relative line number corresponding to descriptor DESC.
+The cursor is currently in relative line number CLINE."
+ (if (string-match "\\`[0-9]+\\'" desc)
(aref org-table-dlines (string-to-number desc))
- (setq cline (or cline (org-current-line))
- bline (or bline org-table-current-begin-line)
- table (or table org-table-current-line-types))
- (if (or
- (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc))
- ;; 1 2 3 4 5 6
- (and (not (match-end 3)) (not (match-end 6)))
- (and (match-end 3) (match-end 6) (not (match-end 5))))
- (user-error "Invalid row descriptor `%s'" desc))
- (let* ((hdir (and (match-end 2) (match-string 2 desc)))
- (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil))
- (odir (and (match-end 5) (match-string 5 desc)))
- (on (if (match-end 6) (string-to-number (match-string 6 desc))))
- (i (- cline bline))
+ (when (or (not (string-match
+ "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?"
+ ;; 1 2 3 4 5 6
+ desc))
+ (and (not (match-end 3)) (not (match-end 6)))
+ (and (match-end 3) (match-end 6) (not (match-end 5))))
+ (user-error "Invalid row descriptor `%s'" desc))
+ (let* ((hn (and (match-end 3) (- (match-end 3) (match-beginning 3))))
+ (hdir (match-string 2 desc))
+ (odir (match-string 5 desc))
+ (on (and (match-end 6) (string-to-number (match-string 6 desc))))
(rel (and (match-end 6)
(or (and (match-end 1) (not (match-end 3)))
(match-end 5)))))
- (if (and hn (not hdir))
- (progn
- (setq i 0 hdir "+")
- (if (eq (aref table 0) 'hline) (setq hn (1- hn)))))
- (if (and (not hn) on (not odir))
- (user-error "Should never happen");;(aref org-table-dlines on)
- (if (and hn (> hn 0))
- (setq i (org-table-find-row-type table i 'hline (equal hdir "-")
- nil hn cline desc)))
- (if on
- (setq i (org-table-find-row-type table i 'dline (equal odir "-")
- rel on cline desc)))
- (+ bline i)))))
-
-(defun org-table-find-row-type (table i type backwards relative n cline desc)
- "FIXME: Needs more documentation."
- (let ((l (length table)))
- (while (> n 0)
- (while (and (setq i (+ i (if backwards -1 1)))
- (>= i 0) (< i l)
- (not (eq (aref table i) type))
- (if (and relative (eq (aref table i) 'hline))
- (cond
- ((eq org-table-relative-ref-may-cross-hline t) t)
- ((eq org-table-relative-ref-may-cross-hline 'error)
- (user-error "Row descriptor %s used in line %d crosses hline" desc cline))
- (t (setq i (- i (if backwards -1 1))
- n 1)
- nil))
- t)))
- (setq n (1- n)))
- (if (or (< i 0) (>= i l))
- (user-error "Row descriptor %s used in line %d leads outside table"
- desc cline)
- i)))
-
-(defun org-table-rewrite-old-row-references (s)
- (if (string-match "&[-+0-9I]" s)
- (user-error "Formula contains old &row reference, please rewrite using @-syntax")
- s))
+ (when (and hn (not hdir))
+ (setq cline 0)
+ (setq hdir "+")
+ (when (eq (aref org-table-current-line-types 0) 'hline) (decf hn)))
+ (when (and (not hn) on (not odir)) (user-error "Should never happen"))
+ (when hn
+ (setq cline
+ (org-table--row-type 'hline hn cline (equal hdir "-") nil desc)))
+ (when on
+ (setq cline
+ (org-table--row-type 'dline on cline (equal odir "-") rel desc)))
+ cline)))
+
+(defun org-table--row-type (type n i backwards relative desc)
+ "Return relative line of Nth row with type TYPE.
+Search starts from relative line I. When BACKWARDS in non-nil,
+look before I. When RELATIVE is non-nil, the reference is
+relative. DESC is the original descriptor that started the
+search, as a string."
+ (let ((l (length org-table-current-line-types)))
+ (catch :exit
+ (dotimes (_ n)
+ (while (and (incf i (if backwards -1 1))
+ (>= i 0)
+ (< i l)
+ (not (eq (aref org-table-current-line-types i) type))
+ ;; We are going to cross a hline. Check if this is
+ ;; an authorized move.
+ (cond
+ ((not relative))
+ ((not (eq (aref org-table-current-line-types i) 'hline)))
+ ((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.
+ (throw :exit nil)))))))
+ (cond ((or (< i 0) (>= i l))
+ (user-error "Row descriptor %s leads outside table" desc))
+ ;; The last hline doesn't exist. Instead, point to last row
+ ;; in table.
+ ((= i (1- l)) (1- i))
+ (t i))))
+
+(defun org-table--error-on-old-row-references (s)
+ (when (string-match "&[-+0-9I]" s)
+ (user-error "Formula contains old &row reference, please rewrite using @-syntax")))
(defun org-table-make-reference (elements keep-empty numbers lispp)
"Convert list ELEMENTS to something appropriate to insert into formula.
@@ -2961,23 +3075,16 @@ list, 'literal is for the format specifier L."
elements
",") "]"))))
-;;;###autoload
-(defun org-table-set-constants ()
- "Set `org-table-formula-constants-local' in the current buffer."
- (let (cst consts const-str)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t)
- (setq const-str (substring-no-properties (match-string 1)))
- (setq consts (append consts (org-split-string const-str "[ \t]+")))
- (when consts
- (let (e)
- (while (setq e (pop consts))
- (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
- (if (assoc-string (match-string 1 e) cst)
- (setq cst (delete (assoc-string (match-string 1 e) cst) cst)))
- (push (cons (match-string 1 e) (match-string 2 e)) cst)))
- (setq org-table-formula-constants-local cst)))))))
+(defun org-table-message-once-per-second (t1 &rest args)
+ "If there has been more than one second since T1, display message.
+ARGS are passed as arguments to the `message' function. Returns
+current time if a message is printed, otherwise returns T1. If
+T1 is nil, always messages."
+ (let ((curtime (current-time)))
+ (if (or (not t1) (< 0 (nth 1 (time-subtract curtime t1))))
+ (progn (apply 'message args)
+ curtime)
+ t1)))
;;;###autoload
(defun org-table-recalculate (&optional all noalign)
@@ -2990,133 +3097,163 @@ 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."
(interactive "P")
- (or (memq this-command org-recalc-commands)
- (setq org-recalc-commands (cons this-command org-recalc-commands)))
+ (unless (memq this-command org-recalc-commands)
+ (push this-command org-recalc-commands))
(unless (org-at-table-p) (user-error "Not at a table"))
(if (or (eq all 'iterate) (equal all '(16)))
(org-table-iterate)
- (org-table-get-specials)
+ (org-table-analyze)
(let* ((eqlist (sort (org-table-get-stored-formulas)
(lambda (a b) (string< (car a) (car b)))))
(eqlist1 (copy-sequence eqlist))
(inhibit-redisplay (not debug-on-error))
(line-re org-table-dataline-regexp)
- (thisline (org-current-line))
- (thiscol (org-table-current-column))
- seen-fields lhs1
- beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
+ (log-first-time (current-time))
+ (log-last-time log-first-time)
+ (cnt 0)
+ beg end eqlnum eqlname)
;; Insert constants in all formulas
- (setq eqlist
- (mapcar (lambda (x)
- (when (string-match "\\`$[<>]" (car x))
- (setq lhs1 (car x))
- (setq x (cons (substring
- (org-table-formula-handle-first/last-rc
- (car x)) 1)
- (cdr x)))
- (if (assoc (car x) eqlist1)
- (user-error "\"%s=\" formula tries to overwrite existing formula for column %s"
- lhs1 (car x))))
- (cons
- (org-table-formula-handle-first/last-rc (car x))
- (org-table-formula-substitute-names
- (org-table-formula-handle-first/last-rc (cdr x)))))
- eqlist))
- ;; Split the equation list
- (while (setq eq (pop eqlist))
- (if (<= (string-to-char (car eq)) ?9)
- (push eq eqlnum)
- (push eq eqlname)))
- (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
- ;; Expand ranges in lhs of formulas
- (setq eqlname (org-table-expand-lhs-ranges eqlname))
-
- ;; Get the correct line range to process
- (if all
- (progn
- (setq end (move-marker (make-marker) (1+ (org-table-end))))
- (goto-char (setq beg (org-table-begin)))
- (if (re-search-forward org-table-calculate-mark-regexp end t)
- ;; This is a table with marked lines, compute selected lines
- (setq line-re org-table-recalculate-regexp)
- ;; Move forward to the first non-header line
- (if (and (re-search-forward org-table-dataline-regexp end t)
- (re-search-forward org-table-hline-regexp end t)
- (re-search-forward org-table-dataline-regexp end t))
- (setq beg (match-beginning 0))
- nil))) ;; just leave beg where it is
- (setq beg (point-at-bol)
- end (move-marker (make-marker) (1+ (point-at-eol)))))
- (goto-char beg)
- (and all (message "Re-applying formulas to full table..."))
-
- ;; First find the named fields, and mark them untouchable.
- ;; Also check if several field/range formulas try to set the same field.
- (remove-text-properties beg end '(org-untouchable t))
- (while (setq eq (pop eqlname))
- (setq name (car eq)
- a (assoc name org-table-named-field-locations))
- (setq name1 name)
- (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
- (nth 2 a))))
- (when (member name1 seen-fields)
- (user-error "Several field/range formulas try to set %s" name1))
- (push name1 seen-fields)
-
- (and (not a)
- (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
- (setq a (list name
- (condition-case nil
- (aref org-table-dlines
- (string-to-number (match-string 1 name)))
- (error (user-error "Invalid row number in %s"
- name)))
- (string-to-number (match-string 2 name)))))
- (when (and a (or all (equal (nth 1 a) thisline)))
- (message "Re-applying formula to field: %s" name)
- (org-goto-line (nth 1 a))
- (org-table-goto-column (nth 2 a))
- (push (append a (list (cdr eq))) eqlname1)
- (org-table-put-field-property :org-untouchable t)))
- (setq eqlname1 (nreverse eqlname1))
-
- ;; Now evaluate the column formulas, but skip fields covered by
- ;; field formulas
- (goto-char beg)
- (while (re-search-forward line-re end t)
- (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1))
- ;; Unprotected line, recalculate
- (and all (message "Re-applying formulas to full table...(line %d)"
- (setq cnt (1+ cnt))))
- (setq org-last-recalc-line (org-current-line))
- (setq eql eqlnum)
- (while (setq entry (pop eql))
- (org-goto-line org-last-recalc-line)
- (org-table-goto-column (string-to-number (car entry)) nil 'force)
- (unless (get-text-property (point) :org-untouchable)
- (org-table-eval-formula nil (cdr entry)
- 'noalign 'nocst 'nostore 'noanalysis)))))
-
- ;; Now evaluate the field formulas
- (while (setq eq (pop eqlname1))
- (message "Re-applying formula to field: %s" (car eq))
- (org-goto-line (nth 1 eq))
- (org-table-goto-column (nth 2 eq))
- (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst
- 'nostore 'noanalysis))
-
- (org-goto-line thisline)
- (org-table-goto-column thiscol)
- (remove-text-properties (point-min) (point-max) '(org-untouchable t))
- (or noalign (and org-table-may-need-update (org-table-align))
- (and all (message "Re-applying formulas to %d lines...done" cnt)))
-
- ;; back to initial position
- (message "Re-applying formulas...done")
- (org-goto-line thisline)
- (org-table-goto-column thiscol)
- (or noalign (and org-table-may-need-update (org-table-align))
- (and all (message "Re-applying formulas...done"))))))
+ (when eqlist
+ (org-table-save-field
+ (setq eqlist
+ (mapcar
+ (lambda (x)
+ (when (string-match "\\`@-?I+" (car x))
+ (user-error "Can't assign to hline relative reference"))
+ (when (string-match "\\`$[<>]" (car x))
+ (let ((old-lhs (car x)))
+ (setq x
+ (cons
+ (substring
+ (org-table-formula-handle-first/last-rc old-lhs)
+ 1)
+ (cdr x)))
+ (when (assoc (car x) eqlist1)
+ (user-error "\"%s=\" formula tries to overwrite \
+existing formula for column %s"
+ old-lhs
+ (car x)))))
+ (cons (org-table-formula-handle-first/last-rc (car x))
+ (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc (cdr x)))))
+ eqlist))
+ ;; Split the equation list.
+ (dolist (eq eqlist)
+ (if (<= (string-to-char (car eq)) ?9)
+ (push eq eqlnum)
+ (push eq eqlname)))
+ (setq eqlnum (nreverse eqlnum))
+ ;; Expand ranges in lhs of formulas
+ (setq eqlname (org-table-expand-lhs-ranges (nreverse eqlname)))
+ ;; Get the correct line range to process
+ (if all
+ (progn
+ (setq end (copy-marker (org-table-end)))
+ (goto-char (setq beg org-table-current-begin-pos))
+ (cond
+ ((re-search-forward org-table-calculate-mark-regexp end t)
+ ;; This is a table with marked lines, compute selected
+ ;; lines.
+ (setq line-re org-table-recalculate-regexp))
+ ;; Move forward to the first non-header line.
+ ((and (re-search-forward org-table-dataline-regexp end t)
+ (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 nil)))
+ (setq beg (line-beginning-position)
+ end (copy-marker (line-beginning-position 2))))
+ (goto-char beg)
+ ;; Mark named fields untouchable. Also check if several
+ ;; field/range formulas try to set the same field.
+ (remove-text-properties beg end '(org-untouchable t))
+ (let ((current-line (count-lines org-table-current-begin-pos
+ (line-beginning-position)))
+ seen-fields)
+ (dolist (eq eqlname)
+ (let* ((name (car eq))
+ (location (assoc name org-table-named-field-locations))
+ (eq-line (or (nth 1 location)
+ (and (string-match "\\`@\\([0-9]+\\)" name)
+ (aref org-table-dlines
+ (string-to-number
+ (match-string 1 name))))))
+ (reference
+ (if location
+ ;; Turn field coordinates associated to NAME
+ ;; into an absolute reference.
+ (format "@%d$%d"
+ (org-table-line-to-dline eq-line)
+ (nth 2 location))
+ name)))
+ (when (member reference seen-fields)
+ (user-error "Several field/range formulas try to set %s"
+ reference))
+ (push reference seen-fields)
+ (when (or all (eq eq-line current-line))
+ (org-table-goto-field name)
+ (org-table-put-field-property :org-untouchable t)))))
+ ;; Evaluate the column formulas, but skip fields covered by
+ ;; field formulas.
+ (goto-char beg)
+ (while (re-search-forward line-re end t)
+ (unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1))
+ ;; Unprotected line, recalculate.
+ (incf cnt)
+ (when all
+ (setq log-last-time
+ (org-table-message-once-per-second
+ log-last-time
+ "Re-applying formulas to full table...(line %d)" cnt)))
+ (if (markerp org-last-recalc-line)
+ (move-marker org-last-recalc-line (line-beginning-position))
+ (setq org-last-recalc-line
+ (copy-marker (line-beginning-position))))
+ (dolist (entry eqlnum)
+ (goto-char org-last-recalc-line)
+ (org-table-goto-column (string-to-number (car entry)) nil 'force)
+ (unless (get-text-property (point) :org-untouchable)
+ (org-table-eval-formula
+ nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
+ ;; Evaluate the field formulas.
+ (dolist (eq eqlname)
+ (let ((reference (car eq))
+ (formula (cdr eq)))
+ (setq log-last-time
+ (org-table-message-once-per-second
+ (and all log-last-time)
+ "Re-applying formula to field: %s" (car eq)))
+ (org-table-goto-field
+ reference
+ ;; Possibly create a new column, as long as
+ ;; `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? ")))))))
+ (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))
+ (set-marker end nil)
+ (unless noalign
+ (when org-table-may-need-update (org-table-align))
+ (when all
+ (org-table-message-once-per-second
+ log-first-time "Re-applying formulas to %d lines... done" cnt)))
+ (org-table-message-once-per-second
+ (and all log-first-time) "Re-applying formulas... done")))))
;;;###autoload
(defun org-table-iterate (&optional arg)
@@ -3177,66 +3314,65 @@ with the prefix ARG."
(interactive "P")
(unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line"))
(let ((formula (buffer-substring
- (point-at-bol)
- (point-at-eol)))
- s e)
+ (line-beginning-position)
+ (line-end-position))))
(save-excursion
;; Insert a temporary formula at right after the table
(goto-char (org-table-TBLFM-begin))
- (setq s (set-marker (make-marker) (point)))
- (insert (concat formula "\n"))
- (setq e (set-marker (make-marker) (point)))
- ;; Recalculate the table
- (beginning-of-line 0) ; move to the inserted line
- (skip-chars-backward " \r\n\t")
- (if (org-at-table-p)
+ (let ((s (point-marker)))
+ (insert formula "\n")
+ (let ((e (point-marker)))
+ ;; Recalculate the table.
+ (beginning-of-line 0) ; move to the inserted line
+ (skip-chars-backward " \r\n\t")
(unwind-protect
- (org-call-with-arg 'org-table-recalculate (or arg t))
- ;; delete the formula inserted temporarily
- (delete-region s e))))))
+ (org-call-with-arg #'org-table-recalculate (or arg t))
+ ;; Delete the formula inserted temporarily.
+ (delete-region s e)
+ (set-marker s nil)
+ (set-marker e nil)))))))
(defun org-table-TBLFM-begin ()
"Find the beginning of the TBLFM lines and return its position.
Return nil when the beginning of TBLFM line was not found."
(save-excursion
(when (progn (forward-line 1)
- (re-search-backward
- org-table-TBLFM-begin-regexp
- nil t))
- (point-at-bol 2))))
+ (re-search-backward org-table-TBLFM-begin-regexp nil t))
+ (line-beginning-position 2))))
(defun org-table-expand-lhs-ranges (equations)
"Expand list of formulas.
If some of the RHS in the formulas are ranges or a row reference, expand
them to individual field equations for each field."
- (let (e res lhs rhs range r1 r2 c1 c2)
- (while (setq e (pop equations))
- (setq lhs (car e) rhs (cdr e))
- (cond
- ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs)
- ;; This just refers to one fixed field
- (push e res))
- ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs)
- ;; This just refers to one fixed named field
- (push e res))
- ((string-match "^@[0-9]+$" lhs)
- (loop for ic from 1 to org-table-current-ncol do
- (push (cons (format "%s$%d" lhs ic) rhs) res)
- (put-text-property 0 (length (caar res))
- :orig-eqn e (caar res))))
- (t
- (setq range (org-table-get-range lhs org-table-current-begin-pos
- 1 nil 'corners))
- (setq r1 (nth 0 range) c1 (nth 1 range)
- r2 (nth 2 range) c2 (nth 3 range))
- (setq r1 (org-table-line-to-dline r1))
- (setq r2 (org-table-line-to-dline r2 'above))
- (loop for ir from r1 to r2 do
- (loop for ic from c1 to c2 do
- (push (cons (format "@%d$%d" ir ic) rhs) res)
- (put-text-property 0 (length (caar res))
- :orig-eqn e (caar res)))))))
- (nreverse res)))
+ (let (res)
+ (dolist (e equations (nreverse res))
+ (let ((lhs (car e))
+ (rhs (cdr e)))
+ (cond
+ ((string-match "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
+ ;; This just refers to one fixed field.
+ (push e res))
+ ((string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
+ ;; This just refers to one fixed named field.
+ (push e res))
+ ((string-match "\\`@[0-9]+\\'" lhs)
+ (dotimes (ic org-table-current-ncol)
+ (push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e)
+ rhs)
+ res)))
+ (t
+ (let* ((range (org-table-get-range
+ lhs org-table-current-begin-pos 1 nil 'corners))
+ (r1 (org-table-line-to-dline (nth 0 range)))
+ (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))))))))))
(defun org-table-formula-handle-first/last-rc (s)
"Replace @<, @>, $<, $> with first/last row/column of the table.
@@ -3269,25 +3405,33 @@ borders of the table using the @< @> $< $> makers."
(defun org-table-formula-substitute-names (f)
"Replace $const with values in string F."
- (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
- ;; First, check for column names
- (while (setq start (string-match org-table-column-name-regexp f start))
- (setq start (1+ start))
- (setq a (assoc (match-string 1 f) org-table-column-names))
- (setq f (replace-match (concat "$" (cdr a)) t t f)))
- ;; Parameters and constants
- (setq start 0)
- (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)" f start))
- (if (match-end 2)
- (setq start (match-end 2))
- (setq start (1+ start))
- (if (setq a (save-match-data
- (org-table-get-constant (match-string 1 f))))
- (setq f (replace-match
- (concat (if pp "(") a (if pp ")")) t t f)))))
- (if org-table-formula-debug
- (put-text-property 0 (length f) :orig-formula f1 f))
- f))
+ (let ((start 0)
+ (pp (/= (string-to-char f) ?'))
+ (duration (org-string-match-p ";.*[Tt].*\\'" f))
+ (new (replace-regexp-in-string ; Check for column names.
+ org-table-column-name-regexp
+ (lambda (m)
+ (concat "$" (cdr (assoc (match-string 1 m)
+ org-table-column-names))))
+ f t t)))
+ ;; Parameters and constants.
+ (while (setq start
+ (string-match
+ "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)"
+ new start))
+ (if (match-end 2) (setq start (match-end 2))
+ (incf start)
+ ;; When a duration is expected, convert value on the fly.
+ (let ((value
+ (save-match-data
+ (let ((v (org-table-get-constant (match-string 1 new))))
+ (if (and (org-string-nw-p v) duration)
+ (org-table-time-string-to-seconds v)
+ v)))))
+ (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))
(defun org-table-get-constant (const)
"Find the value for a parameter or constant in a formula.
@@ -3358,21 +3502,21 @@ Parameters get priority."
(defun org-table-edit-formulas ()
"Edit the formulas of the current table in a separate buffer."
(interactive)
- (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM")))
+ (when (save-excursion (beginning-of-line)
+ (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM")))
(beginning-of-line 0))
(unless (org-at-table-p) (user-error "Not at a table"))
- (org-table-get-specials)
+ (org-table-analyze)
(let ((key (org-table-current-field-formula 'key 'noerror))
(eql (sort (org-table-get-stored-formulas 'noerror)
- 'org-table-formula-less-p))
+ #'org-table-formula-less-p))
(pos (point-marker))
(startline 1)
(wc (current-window-configuration))
(sel-win (selected-window))
(titles '((column . "# Column Formulas\n")
(field . "# Field and Range Formulas\n")
- (named . "# Named Field Formulas\n")))
- entry s type title)
+ (named . "# Named Field Formulas\n"))))
(org-switch-to-buffer-other-window "*Edit Formulas*")
(erase-buffer)
;; Keep global-font-lock-mode from turning on font-lock-mode
@@ -3383,36 +3527,36 @@ Parameters get priority."
(org-set-local 'org-window-configuration wc)
(org-set-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)
+ (org-add-hook 'post-command-hook #'org-table-fedit-post-command t t)
(easy-menu-add org-table-fedit-menu)
(setq startline (org-current-line))
- (while (setq entry (pop eql))
- (setq type (cond
- ((string-match "\\`$[<>]" (car entry)) 'column)
- ((equal (string-to-char (car entry)) ?@) 'field)
- ((string-match "^[0-9]" (car entry)) 'column)
- (t 'named)))
- (when (setq title (assq type titles))
- (or (bobp) (insert "\n"))
- (insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
- (setq titles (remove title titles)))
- (if (equal key (car entry)) (setq startline (org-current-line)))
- (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$")
- (car entry) " = " (cdr entry) "\n"))
- (remove-text-properties 0 (length s) '(face nil) s)
- (insert s))
- (if (eq org-table-use-standard-references t)
- (org-table-fedit-toggle-ref-type))
+ (dolist (entry eql)
+ (let* ((type (cond
+ ((string-match "\\`$[<>]" (car entry)) 'column)
+ ((equal (string-to-char (car entry)) ?@) 'field)
+ ((string-match "\\'[0-9]" (car entry)) 'column)
+ (t 'named)))
+ (title (assq type titles)))
+ (when title
+ (unless (bobp) (insert "\n"))
+ (insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
+ (setq titles (remove title titles)))
+ (when (equal key (car entry)) (setq startline (org-current-line)))
+ (let ((s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$")
+ (car entry) " = " (cdr entry) "\n")))
+ (remove-text-properties 0 (length s) '(face nil) s)
+ (insert s))))
+ (when (eq org-table-use-standard-references t)
+ (org-table-fedit-toggle-ref-type))
(org-goto-line startline)
- (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands.")))
+ (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. \
+See menu for more commands.")))
(defun org-table-fedit-post-command ()
(when (not (memq this-command '(lisp-complete-symbol)))
(let ((win (selected-window)))
(save-excursion
- (condition-case nil
- (org-table-show-reference)
- (error nil))
+ (ignore-errors (org-table-show-reference))
(select-window win)))))
(defun org-table-formula-to-user (s)
@@ -3542,13 +3686,14 @@ minutes or seconds."
(defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION."
- (let ((line (org-current-line)))
+ (let ((origin (copy-marker (line-beginning-position))))
(goto-char (point-min))
(while (not (eobp))
- (insert (funcall function (buffer-substring (point) (point-at-eol))))
- (delete-region (point) (point-at-eol))
- (or (eobp) (forward-char 1)))
- (org-goto-line line)))
+ (insert (funcall function (buffer-substring (point) (line-end-position))))
+ (delete-region (point) (line-end-position))
+ (forward-line))
+ (goto-char origin)
+ (set-marker origin nil)))
(defun org-table-fedit-toggle-ref-type ()
"Convert all references in the buffer from B3 to @3$2 and back."
@@ -3579,16 +3724,16 @@ minutes or seconds."
(defun org-table-fedit-shift-reference (dir)
(cond
- ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&")
+ ((org-in-regexp "\\(\\<[a-zA-Z]\\)&")
(if (memq dir '(left right))
(org-rematch-and-replace 1 (eq dir 'left))
(user-error "Cannot shift reference in this direction")))
- ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
+ ((org-in-regexp "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
;; A B3-like reference
(if (memq dir '(up down))
(org-rematch-and-replace 2 (eq dir 'up))
(org-rematch-and-replace 1 (eq dir 'left))))
- ((org-at-regexp-p
+ ((org-in-regexp
"\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?")
;; An internal reference
(if (memq dir '(up down))
@@ -3736,30 +3881,31 @@ With prefix ARG, apply the new formulas to the table."
"Show the location/value of the $ expression at point."
(interactive)
(org-table-remove-rectangle-highlight)
+ (when local (org-table-analyze))
(catch 'exit
(let ((pos (if local (point) org-pos))
+ (table-start (if local org-table-current-begin-pos (org-table-begin)))
(face2 'highlight)
(org-inhibit-highlight-removal t)
(win (selected-window))
(org-show-positions nil)
var name e what match dest)
- (if local (org-table-get-specials))
(setq what (cond
- ((org-at-regexp-p "^@[0-9]+[ \t=]")
+ ((org-in-regexp "^@[0-9]+[ \t=]")
(setq match (concat (substring (match-string 0) 0 -1)
"$1.."
(substring (match-string 0) 0 -1)
"$100"))
'range)
- ((or (org-at-regexp-p org-table-range-regexp2)
- (org-at-regexp-p org-table-translate-regexp)
- (org-at-regexp-p org-table-range-regexp))
+ ((or (org-in-regexp org-table-range-regexp2)
+ (org-in-regexp org-table-translate-regexp)
+ (org-in-regexp org-table-range-regexp))
(setq match
(save-match-data
(org-table-convert-refs-to-rc (match-string 0))))
'range)
- ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
- ((org-at-regexp-p "\\$[0-9]+") 'column)
+ ((org-in-regexp "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
+ ((org-in-regexp "\\$[0-9]+") 'column)
((not local) nil)
(t (user-error "No reference at point")))
match (and what (or match (match-string 0))))
@@ -3767,17 +3913,18 @@ With prefix ARG, apply the new formulas to the table."
(org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
'secondary-selection))
(org-add-hook 'before-change-functions
- 'org-table-remove-rectangle-highlight)
- (if (eq what 'name) (setq var (substring match 1)))
+ #'org-table-remove-rectangle-highlight)
+ (when (eq what 'name) (setq var (substring match 1)))
(when (eq what 'range)
- (or (equal (string-to-char match) ?@) (setq match (concat "@" match)))
+ (unless (eq (string-to-char match) ?@) (setq match (concat "@" match)))
(setq match (org-table-formula-substitute-names match)))
(unless local
(save-excursion
- (end-of-line 1)
+ (end-of-line)
(re-search-backward "^\\S-" nil t)
- (beginning-of-line 1)
- (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=")
+ (beginning-of-line)
+ (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\
+\\([0-9]+\\|&\\)\\) *=")
(setq dest
(save-match-data
(org-table-convert-refs-to-rc (match-string 1))))
@@ -3793,15 +3940,11 @@ With prefix ARG, apply the new formulas to the table."
(when dest
(setq name (substring dest 1))
(cond
- ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest)
- (setq e (assoc name org-table-named-field-locations))
- (org-goto-line (nth 1 e))
- (org-table-goto-column (nth 2 e)))
- ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest)
- (let ((l (string-to-number (match-string 1 dest)))
- (c (string-to-number (match-string 2 dest))))
- (org-goto-line (aref org-table-dlines l))
- (org-table-goto-column c)))
+ ((org-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)
+ (org-table-goto-field dest))
(t (org-table-goto-column (string-to-number name))))
(move-marker pos (point))
(org-table-highlight-rectangle nil nil face2))
@@ -3809,19 +3952,15 @@ With prefix ARG, apply the new formulas to the table."
((equal dest match))
((not match))
((eq what 'range)
- (condition-case nil
- (save-excursion
- (org-table-get-range match nil nil 'highlight))
- (error nil)))
+ (ignore-errors (org-table-get-range match table-start nil 'highlight)))
((setq e (assoc var org-table-named-field-locations))
- (org-goto-line (nth 1 e))
- (org-table-goto-column (nth 2 e))
- (org-table-highlight-rectangle (point) (point))
+ (org-table-goto-field var)
+ (org-table-highlight-rectangle)
(message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
((setq e (assoc var org-table-column-names))
(org-table-goto-column (string-to-number (cdr e)))
- (org-table-highlight-rectangle (point) (point))
- (goto-char (org-table-begin))
+ (org-table-highlight-rectangle)
+ (goto-char table-start)
(if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|")
(org-table-end) t)
(progn
@@ -3830,37 +3969,35 @@ With prefix ARG, apply the new formulas to the table."
(message "Named column (column %s)" (cdr e)))
(user-error "Column name not found")))
((eq what 'column)
- ;; column number
+ ;; Column number.
(org-table-goto-column (string-to-number (substring match 1)))
- (org-table-highlight-rectangle (point) (point))
+ (org-table-highlight-rectangle)
(message "Column %s" (substring match 1)))
((setq e (assoc var org-table-local-parameters))
- (goto-char (org-table-begin))
+ (goto-char table-start)
(if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t)
(progn
(goto-char (match-beginning 1))
(org-table-highlight-rectangle)
(message "Local parameter."))
(user-error "Parameter not found")))
- (t
- (cond
- ((not var) (user-error "No reference at point"))
- ((setq e (assoc var org-table-formula-constants-local))
- (message "Local Constant: $%s=%s in #+CONSTANTS line."
- var (cdr e)))
- ((setq e (assoc var org-table-formula-constants))
- (message "Constant: $%s=%s in `org-table-formula-constants'."
- var (cdr e)))
- ((setq e (and (fboundp 'constants-get) (constants-get var)))
- (message "Constant: $%s=%s, from `constants.el'%s."
- var e (format " (%s units)" constants-unit-system)))
- (t (user-error "Undefined name $%s" var)))))
+ ((not var) (user-error "No reference at point"))
+ ((setq e (assoc var org-table-formula-constants-local))
+ (message "Local Constant: $%s=%s in #+CONSTANTS line."
+ var (cdr e)))
+ ((setq e (assoc var org-table-formula-constants))
+ (message "Constant: $%s=%s in `org-table-formula-constants'."
+ var (cdr e)))
+ ((setq e (and (fboundp 'constants-get) (constants-get var)))
+ (message "Constant: $%s=%s, from `constants.el'%s."
+ var e (format " (%s units)" constants-unit-system)))
+ (t (user-error "Undefined name $%s" var)))
(goto-char pos)
(when (and org-show-positions
(not (memq this-command '(org-table-fedit-scroll
org-table-fedit-scroll-down))))
(push pos org-show-positions)
- (push org-table-current-begin-pos org-show-positions)
+ (push table-start org-show-positions)
(let ((min (apply 'min org-show-positions))
(max (apply 'max org-show-positions)))
(set-window-start (selected-window) min)
@@ -3926,32 +4063,39 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
(push ov org-table-rectangle-overlays)))
(defun org-table-highlight-rectangle (&optional beg end face)
- "Highlight rectangular region in a table."
- (setq beg (or beg (point)) end (or end (point)))
- (let ((b (min beg end))
- (e (max beg end))
- l1 c1 l2 c2 tmp)
- (and (boundp 'org-show-positions)
- (setq org-show-positions (cons b (cons e org-show-positions))))
- (goto-char (min beg end))
- (setq l1 (org-current-line)
- c1 (org-table-current-column))
- (goto-char (max beg end))
- (setq l2 (org-current-line)
- c2 (org-table-current-column))
- (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp))
- (org-goto-line l1)
- (beginning-of-line 1)
- (loop for line from l1 to l2 do
- (when (looking-at org-table-dataline-regexp)
- (org-table-goto-column c1)
- (skip-chars-backward "^|\n") (setq beg (point))
- (org-table-goto-column c2)
- (skip-chars-forward "^|\n") (setq end (point))
- (org-table-add-rectangle-overlay beg end face))
- (beginning-of-line 2))
- (goto-char b))
- (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight))
+ "Highlight rectangular region in a table.
+When buffer positions BEG and END are provided, use them to
+delimit the region to highlight. Otherwise, refer to point. Use
+FACE, when non-nil, for the highlight."
+ (let* ((beg (or beg (point)))
+ (end (or end (point)))
+ (b (min beg end))
+ (e (max beg end))
+ (start-coordinates
+ (save-excursion
+ (goto-char b)
+ (cons (line-beginning-position) (org-table-current-column))))
+ (end-coordinates
+ (save-excursion
+ (goto-char e)
+ (cons (line-beginning-position) (org-table-current-column)))))
+ (when (boundp 'org-show-positions)
+ (setq org-show-positions (cons b (cons e org-show-positions))))
+ (goto-char (car start-coordinates))
+ (let ((column-start (min (cdr start-coordinates) (cdr end-coordinates)))
+ (column-end (max (cdr start-coordinates) (cdr end-coordinates)))
+ (last-row (car end-coordinates)))
+ (while (<= (point) last-row)
+ (when (looking-at org-table-dataline-regexp)
+ (org-table-goto-column column-start)
+ (skip-chars-backward "^|\n")
+ (let ((p (point)))
+ (org-table-goto-column column-end)
+ (skip-chars-forward "^|\n")
+ (org-table-add-rectangle-overlay p (point) face)))
+ (forward-line)))
+ (goto-char (car start-coordinates)))
+ (add-hook 'before-change-functions #'org-table-remove-rectangle-highlight))
(defun org-table-remove-rectangle-highlight (&rest ignore)
"Remove the rectangle overlays."
@@ -4290,7 +4434,10 @@ to execute outside of tables."
org-table-toggle-coordinate-overlays :active (org-at-table-p)
:keys "C-c }"
:style toggle :selected org-table-overlay-coordinates]
- ))
+ "--"
+ ("Plot"
+ ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
+ ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
t))
(defun orgtbl-ctrl-c-ctrl-c (arg)
@@ -4316,7 +4463,6 @@ With prefix arg, also recompute table."
(when (orgtbl-send-table 'maybe)
(run-hooks 'orgtbl-after-send-table-hook)))
((eq action 'recalc)
- (org-table-set-constants)
(save-excursion
(beginning-of-line 1)
(skip-chars-backward " \r\n\t")
@@ -4398,6 +4544,7 @@ overwritten, and the table is not marked as requiring realignment."
(setq org-self-insert-command-undo-counter
(1+ org-self-insert-command-undo-counter))))))))
+;;;###autoload
(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
"Regular expression matching exponentials as produced by calc.")
@@ -4425,15 +4572,12 @@ a radio table."
(unless (re-search-forward
(concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
(user-error "Don't know where to insert translated table"))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (save-excursion
- (let ((beg (point)))
- (unless (re-search-forward
- (concat "END +RECEIVE +ORGTBL +" name) nil t)
- (user-error "Cannot find end of insertion region"))
- (beginning-of-line 1)
- (delete-region beg (point))))
+ (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")))
;;;###autoload
@@ -4442,76 +4586,43 @@ a radio table."
The structure will be a list. Each item is either the symbol `hline'
for a horizontal separator line, or a list of field values as strings.
The table is taken from the parameter TXT, or from the buffer at point."
- (unless txt
- (unless (org-at-table-p)
- (user-error "No table at point")))
- (let* ((txt (or txt
- (buffer-substring-no-properties (org-table-begin)
- (org-table-end))))
- (lines (org-split-string txt "[ \t]*\n[ \t]*")))
-
- (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-split-string (org-trim x) "\\s-*|\\s-*")))
- lines)))
+ (unless (or txt (org-at-table-p)) (user-error "No table at point"))
+ (let ((txt (or txt
+ (buffer-substring-no-properties (org-table-begin)
+ (org-table-end)))))
+ (mapcar (lambda (x)
+ (if (string-match org-table-hline-regexp x) 'hline
+ (org-split-string (org-trim x) "\\s-*|\\s-*")))
+ (org-split-string txt "[ \t]*\n[ \t]*"))))
(defun orgtbl-send-table (&optional maybe)
- "Send a transformed version of this table to the receiver position.
-With argument MAYBE, fail quietly if no transformation is defined for
-this table."
+ "Send a transformed version of table at point to the receiver position.
+With argument MAYBE, fail quietly if no transformation is defined
+for this table."
(interactive)
(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))
(let ((dests (orgtbl-gather-send-defs))
- (txt (buffer-substring-no-properties (org-table-begin)
- (org-table-end)))
+ (table (org-table-to-lisp
+ (buffer-substring-no-properties (org-table-begin)
+ (org-table-end))))
(ntbl 0))
- (unless dests (if maybe (throw 'exit nil)
- (user-error "Don't know how to transform this table")))
+ (unless dests
+ (if maybe (throw 'exit nil)
+ (user-error "Don't know how to transform this table")))
(dolist (dest dests)
- (let* ((name (plist-get dest :name))
- (transform (plist-get dest :transform))
- (params (plist-get dest :params))
- (skip (plist-get params :skip))
- (skipcols (plist-get params :skipcols))
- (no-escape (plist-get params :no-escape))
- beg
- (lines (org-table-clean-before-export
- (nthcdr (or skip 0)
- (org-split-string txt "[ \t]*\n[ \t]*"))))
- (i0 (if org-table-clean-did-remove-column 2 1))
- (lines (if no-escape lines
- (mapcar (lambda(l) (replace-regexp-in-string
- "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines)))
- (table (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-remove-by-index
- (org-split-string (org-trim x) "\\s-*|\\s-*")
- skipcols i0)))
- lines))
- (fun (if (= i0 2) 'cdr 'identity))
- (org-table-last-alignment
- (org-remove-by-index (funcall fun org-table-last-alignment)
- skipcols i0))
- (org-table-last-column-widths
- (org-remove-by-index (funcall fun org-table-last-column-widths)
- skipcols i0))
- (txt (if (fboundp transform)
- (funcall transform table params)
- (user-error "No such transformation function %s" transform))))
- (orgtbl-send-replace-tbl name txt))
- (setq ntbl (1+ ntbl)))
+ (let ((name (plist-get dest :name))
+ (transform (plist-get dest :transform))
+ (params (plist-get dest :params)))
+ (unless (fboundp transform)
+ (user-error "No such transformation function %s" transform))
+ (orgtbl-send-replace-tbl name (funcall transform table params)))
+ (incf ntbl))
(message "Table converted and installed at %d receiver location%s"
ntbl (if (> ntbl 1) "s" ""))
- (if (> ntbl 0)
- ntbl
- nil))))
+ (and (> ntbl 0) ntbl))))
(defun org-remove-by-index (list indices &optional i0)
"Remove the elements in LIST with indices in INDICES.
@@ -4561,356 +4672,486 @@ First element has index 0, or I0 if given."
(insert txt)
(goto-char pos)))
-;; Dynamically bound input and output for table formatting.
-(defvar *orgtbl-table* nil
- "Carries the current table through formatting routines.")
-(defvar *orgtbl-rtn* nil
- "Formatting routines push the output lines here.")
-;; Formatting parameters for the current table section.
-(defvar *orgtbl-hline* nil "Text used for horizontal lines.")
-(defvar *orgtbl-sep* nil "Text used as a column separator.")
-(defvar *orgtbl-default-fmt* nil "Default format for each entry.")
-(defvar *orgtbl-fmt* nil "Format for each entry.")
-(defvar *orgtbl-efmt* nil "Format for numbers.")
-(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.")
-(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.")
-(defvar *orgtbl-lstart* nil "Text starting a row.")
-(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.")
-(defvar *orgtbl-lend* nil "Text ending a row.")
-(defvar *orgtbl-llend* nil "Specializes lend for the last row.")
-
-(defsubst orgtbl-get-fmt (fmt i)
- "Retrieve the format from FMT corresponding to the Ith column."
- (if (and (not (functionp fmt)) (consp fmt))
- (plist-get fmt i)
- fmt))
-
-(defsubst orgtbl-apply-fmt (fmt &rest args)
- "Apply format FMT to arguments ARGS.
-When FMT is nil, return the first argument from ARGS."
- (cond ((functionp fmt) (apply fmt args))
- (fmt (apply 'format fmt args))
- (args (car args))
- (t args)))
-
-(defsubst orgtbl-eval-str (str)
- "If STR is a function, evaluate it with no arguments."
- (if (functionp str)
- (funcall str)
- str))
-
-(defun orgtbl-format-line (line)
- "Format LINE as a table row."
- (if (eq line 'hline) (if *orgtbl-hline* (push *orgtbl-hline* *orgtbl-rtn*))
- (let* ((i 0)
- (line
- (mapcar
- (lambda (f)
- (setq i (1+ i))
- (let* ((efmt (orgtbl-get-fmt *orgtbl-efmt* i))
- (f (if (and efmt (string-match orgtbl-exp-regexp f))
- (orgtbl-apply-fmt efmt (match-string 1 f)
- (match-string 2 f))
- f)))
- (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i)
- *orgtbl-default-fmt*)
- f)))
- line)))
- (push (if *orgtbl-lfmt*
- (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line)
- (concat (orgtbl-eval-str *orgtbl-lstart*)
- (mapconcat 'identity line *orgtbl-sep*)
- (orgtbl-eval-str *orgtbl-lend*)))
- *orgtbl-rtn*))))
-
-(defun orgtbl-format-section (section-stopper)
- "Format lines until the first occurrence of SECTION-STOPPER."
- (let (prevline)
- (progn
- (while (not (eq (car *orgtbl-table*) section-stopper))
- (if prevline (orgtbl-format-line prevline))
- (setq prevline (pop *orgtbl-table*)))
- (if prevline (let ((*orgtbl-lstart* *orgtbl-llstart*)
- (*orgtbl-lend* *orgtbl-llend*)
- (*orgtbl-lfmt* *orgtbl-llfmt*))
- (orgtbl-format-line prevline))))))
-
;;;###autoload
-(defun orgtbl-to-generic (table params &optional backend)
+(defun orgtbl-to-generic (table params)
"Convert the orgtbl-mode TABLE to some other format.
+
This generic routine can be used for many standard cases.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-A third optional argument BACKEND can be used to convert the content of
-the cells using a specific export back-end.
-For the generic converter, some parameters are obligatory: you need to
-specify either :lfmt, or all of (:lstart :lend :sep).
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that
+line. PARAMS is a property list of parameters that can
+influence the conversion.
Valid parameters are:
-:splice When set to t, return only table body lines, don't wrap
- them into :tstart and :tend. Default is nil. When :splice
- is non-nil, this also means that the exporter should not look
- for and interpret header and footer sections.
+:backend, :raw
+
+ Export back-end used as a basis to transcode elements of the
+ table, when no specific parameter applies to it. It is also
+ used to translate cells contents. You can prevent this by
+ setting :raw property to a non-nil value.
+
+:splice
+
+ When non-nil, only convert rows, not the table itself. This is
+ equivalent to setting to the empty string both :tstart
+ and :tend, which see.
+
+:skip
+
+ When set to an integer N, skip the first N lines of the table.
+ Horizontal separation lines do count for this parameter!
+
+:skipcols
+
+ List of columns that should be skipped. If the table has
+ a column with calculation marks, that column is automatically
+ discarded beforehand.
-:hline String to be inserted on horizontal separation lines.
- May be nil to ignore hlines.
+:hline
-:sep Separator between two fields
-:remove-nil-lines Do not include lines that evaluate to nil.
+ String to be inserted on horizontal separation lines. May be
+ nil to ignore these lines altogether.
+
+:sep
+
+ Separator between two fields, as a string.
Each in the following group may be either a string or a function
of no arguments returning a string:
-:tstart String to start the table. Ignored when :splice is t.
-:tend String to end the table. Ignored when :splice is t.
-:lstart String to start a new table line.
-:llstart String to start the last table line, defaults to :lstart.
-:lend String to end a table line
-:llend String to end the last table line, defaults to :lend.
-
-Each in the following group may be a string, a function of one
-argument (the field or line) returning a string, or a plist
-mapping columns to either of the above:
-
-:lfmt Format for entire line, with enough %s to capture all fields.
- If this is present, :lstart, :lend, and :sep are ignored.
-:llfmt Format for the entire last line, defaults to :lfmt.
-:fmt A format to be used to wrap the field, should contain
- %s for the original field value. For example, to wrap
- everything in dollars, you could use :fmt \"$%s$\".
- This may also be a property list with column numbers and
- formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
-:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt
- Same as above, specific for the header lines in the table.
- All lines before the first hline are treated as header.
- If any of these is not present, the data line value is used.
+:tstart, :tend
+
+ Strings to start and end the table. Ignored when :splice is t.
+
+:lstart, :lend
+
+ Strings to start and end a new table line.
+
+:llstart, :llend
+
+ Strings to start and end the last table line. Default,
+ respectively, to :lstart and :lend.
+
+Each in the following group may be a string or a function of one
+argument (either the cells in the current row, as a list of
+strings, or the current cell) returning a string:
+
+:lfmt
+
+ Format string for an entire row, with enough %s to capture all
+ fields. When non-nil, :lstart, :lend, and :sep are ignored.
+
+:llfmt
+
+ Format for the entire last line, defaults to :lfmt.
+
+:fmt
+
+ A format to be used to wrap the field, should contain %s for
+ the original field value. For example, to wrap everything in
+ dollars, you could use :fmt \"$%s$\". This may also be
+ a property list with column numbers and format strings, or
+ functions, e.g.,
+
+ \(:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
+
+:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt
+
+ Same as above, specific for the header lines in the table.
+ All lines before the first hline are treated as header. If
+ any of these is not present, the data line value is used.
This may be either a string or a function of two arguments:
-:efmt Use this format to print numbers with exponentials.
- The format should have %s twice for inserting mantissa
- and exponent, for example \"%s\\\\times10^{%s}\". This
- may also be a property list with column numbers and
- formats. :fmt will still be applied after :efmt.
-
-In addition to this, the parameters :skip and :skipcols are always handled
-directly by `orgtbl-send-table'. See manual."
- (let* ((splicep (plist-get params :splice))
- (hline (plist-get params :hline))
- (skipheadrule (plist-get params :skipheadrule))
- (remove-nil-linesp (plist-get params :remove-nil-lines))
- (remove-newlines (plist-get params :remove-newlines))
- (*orgtbl-hline* hline)
- (*orgtbl-table* table)
- (*orgtbl-sep* (plist-get params :sep))
- (*orgtbl-efmt* (plist-get params :efmt))
- (*orgtbl-lstart* (plist-get params :lstart))
- (*orgtbl-llstart* (or (plist-get params :llstart) *orgtbl-lstart*))
- (*orgtbl-lend* (plist-get params :lend))
- (*orgtbl-llend* (or (plist-get params :llend) *orgtbl-lend*))
- (*orgtbl-lfmt* (plist-get params :lfmt))
- (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*))
- (*orgtbl-fmt* (plist-get params :fmt))
- *orgtbl-rtn*)
- ;; Convert cells content to backend BACKEND
- (when backend
- (setq *orgtbl-table*
- (mapcar
- (lambda(r)
- (if (listp r)
- (mapcar
- (lambda (c)
- (org-trim (org-export-string-as c backend t '(:with-tables t))))
- r)
- r))
- *orgtbl-table*)))
- ;; Put header
- (unless splicep
- (when (plist-member params :tstart)
- (let ((tstart (orgtbl-eval-str (plist-get params :tstart))))
- (if tstart (push tstart *orgtbl-rtn*)))))
- ;; If we have a heading, format it and handle the trailing hline.
- (if (and (not splicep)
- (or (consp (car *orgtbl-table*))
- (consp (nth 1 *orgtbl-table*)))
- (memq 'hline (cdr *orgtbl-table*)))
- (progn
- (when (eq 'hline (car *orgtbl-table*))
- ;; There is a hline before the first data line
- (and hline (push hline *orgtbl-rtn*))
- (pop *orgtbl-table*))
- (let* ((*orgtbl-lstart* (or (plist-get params :hlstart)
- *orgtbl-lstart*))
- (*orgtbl-llstart* (or (plist-get params :hllstart)
- *orgtbl-llstart*))
- (*orgtbl-lend* (or (plist-get params :hlend) *orgtbl-lend*))
- (*orgtbl-llend* (or (plist-get params :hllend)
- (plist-get params :hlend) *orgtbl-llend*))
- (*orgtbl-lfmt* (or (plist-get params :hlfmt) *orgtbl-lfmt*))
- (*orgtbl-llfmt* (or (plist-get params :hllfmt)
- (plist-get params :hlfmt) *orgtbl-llfmt*))
- (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*))
- (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*)))
- (orgtbl-format-section 'hline))
- (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*))
- (pop *orgtbl-table*)))
- ;; Now format the main section.
- (orgtbl-format-section nil)
- (unless splicep
- (when (plist-member params :tend)
- (let ((tend (orgtbl-eval-str (plist-get params :tend))))
- (if tend (push tend *orgtbl-rtn*)))))
- (mapconcat (if remove-newlines
- (lambda (tend)
- (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend))
- 'identity)
- (nreverse (if remove-nil-linesp
- (remq nil *orgtbl-rtn*)
- *orgtbl-rtn*)) "\n")))
+:efmt
+
+ Use this format to print numbers with exponential. The format
+ should have %s twice for inserting mantissa and exponent, for
+ example \"%s\\\\times10^{%s}\". This may also be a property
+ list with column numbers and format strings or functions.
+ :fmt will still be applied after :efmt."
+ (let ((backend (plist-get params :backend))
+ ;; Disable user-defined export filters and hooks.
+ (org-export-filters-alist nil)
+ (org-export-before-parsing-hook nil)
+ (org-export-before-processing-hook nil))
+ (when (and backend (symbolp backend) (not (org-export-get-backend backend)))
+ (user-error "Unknown :backend value"))
+ (when (or (not backend) (plist-get params :raw)) (require 'ox-org))
+ ;; Remove final newline.
+ (substring
+ (org-export-string-as
+ ;; Return TABLE as Org syntax. Tolerate non-string cells.
+ (with-output-to-string
+ (dolist (e table)
+ (cond ((eq e 'hline) (princ "|--\n"))
+ ((consp e)
+ (princ "| ") (dolist (c e) (princ c) (princ " |"))
+ (princ "\n")))))
+ ;; Build a custom back-end according to PARAMS. Before defining
+ ;; a translator, check if there is anything to do. When there
+ ;; isn't, let BACKEND handle the element.
+ (org-export-create-backend
+ :parent (or backend 'org)
+ :filters
+ '((:filter-parse-tree
+ ;; Handle :skip parameter.
+ (lambda (tree backend info)
+ (let ((skip (plist-get info :skip)))
+ (when skip
+ (unless (wholenump skip) (user-error "Wrong :skip value"))
+ (let ((n 0))
+ (org-element-map tree 'table-row
+ (lambda (row)
+ (if (>= n skip) t
+ (org-element-extract-element row)
+ (incf n)
+ nil))
+ info t))
+ tree)))
+ ;; Handle :skipcols parameter.
+ (lambda (tree backend info)
+ (let ((skipcols (plist-get info :skipcols)))
+ (when skipcols
+ (unless (consp skipcols) (user-error "Wrong :skipcols value"))
+ (org-element-map tree 'table
+ (lambda (table)
+ (let ((specialp
+ (org-export-table-has-special-column-p table)))
+ (dolist (row (org-element-contents table))
+ (when (eq (org-element-property :type row) 'standard)
+ (let ((c 1))
+ (dolist (cell (nthcdr (if specialp 1 0)
+ (org-element-contents row)))
+ (when (memq c skipcols)
+ (org-element-extract-element cell))
+ (incf c)))))))
+ info)
+ tree)))))
+ :transcoders
+ `((table . ,(org-table--to-generic-table params))
+ (table-row . ,(org-table--to-generic-row params))
+ (table-cell . ,(org-table--to-generic-cell params))
+ ;; Section. Return contents to avoid garbage around table.
+ (section . (lambda (s c i) c))))
+ 'body-only (org-combine-plists params '(:with-tables t)))
+ 0 -1)))
+
+(defun org-table--generic-apply (value name &optional with-cons &rest args)
+ (cond ((null value) nil)
+ ((functionp value) `(funcall ',value ,@args))
+ ((stringp value)
+ (cond ((consp (car args)) `(apply #'format ,value ,@args))
+ (args `(format ,value ,@args))
+ (t value)))
+ ((and with-cons (consp value))
+ `(let ((val (cadr (memq column ',value))))
+ (cond ((null val) contents)
+ ((stringp val) (format val ,@args))
+ ((functionp val) (funcall val ,@args))
+ (t (user-error "Wrong %s value" ,name)))))
+ (t (user-error "Wrong %s value" name))))
+
+(defun org-table--to-generic-table (params)
+ "Return custom table transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more
+information."
+ (let ((backend (plist-get params :backend))
+ (splice (plist-get params :splice))
+ (tstart (plist-get params :tstart))
+ (tend (plist-get params :tend)))
+ `(lambda (table contents info)
+ (concat
+ ,(and tstart (not splice)
+ `(concat ,(org-table--generic-apply tstart ":tstart") "\n"))
+ ,(if (or (not backend) tstart tend splice) 'contents
+ `(org-export-with-backend ',backend table contents info))
+ ,(org-table--generic-apply (and (not splice) tend) ":tend")))))
+
+(defun org-table--to-generic-row (params)
+ "Return custom table row transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more
+information."
+ (let* ((backend (plist-get params :backend))
+ (lstart (plist-get params :lstart))
+ (llstart (plist-get params :llstart))
+ (hlstart (plist-get params :hlstart))
+ (hllstart (plist-get params :hllstart))
+ (lend (plist-get params :lend))
+ (llend (plist-get params :llend))
+ (hlend (plist-get params :hlend))
+ (hllend (plist-get params :hllend))
+ (lfmt (plist-get params :lfmt))
+ (llfmt (plist-get params :llfmt))
+ (hlfmt (plist-get params :hlfmt))
+ (hllfmt (plist-get params :hllfmt)))
+ `(lambda (row contents info)
+ (if (eq (org-element-property :type row) 'rule)
+ ,(cond
+ ((plist-member params :hline)
+ (org-table--generic-apply (plist-get params :hline) ":hline"))
+ (backend `(org-export-with-backend ',backend row nil info)))
+ (let ((headerp (org-export-table-row-in-header-p row info))
+ (lastp (not (org-export-get-next-element row info)))
+ (last-header-p (org-export-table-row-ends-header-p row info)))
+ (when contents
+ ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or
+ ;; `:hllfmt' to CONTENTS. Otherwise, fallback on
+ ;; `:lstart', `:lend' and their relatives.
+ ,(let ((cells
+ '(org-element-map row 'table-cell
+ (lambda (cell)
+ ;; Export all cells, without separators.
+ ;;
+ ;; Use `org-export-data-with-backend'
+ ;; instead of `org-export-data' to eschew
+ ;; cached values, which
+ ;; ignore :orgtbl-ignore-sep parameter.
+ (org-export-data-with-backend
+ cell
+ (plist-get info :back-end)
+ (org-combine-plists info '(:orgtbl-ignore-sep t))))
+ info)))
+ `(cond
+ ,(and hllfmt
+ `(last-header-p ,(org-table--generic-apply
+ hllfmt ":hllfmt" nil cells)))
+ ,(and hlfmt
+ `(headerp ,(org-table--generic-apply
+ hlfmt ":hlfmt" nil cells)))
+ ,(and llfmt
+ `(lastp ,(org-table--generic-apply
+ llfmt ":llfmt" nil cells)))
+ (t
+ ,(if lfmt (org-table--generic-apply lfmt ":lfmt" nil cells)
+ `(concat
+ (cond
+ ,(and
+ (or hllstart hllend)
+ `(last-header-p
+ (concat
+ ,(org-table--generic-apply hllstart ":hllstart")
+ contents
+ ,(org-table--generic-apply hllend ":hllend"))))
+ ,(and
+ (or hlstart hlend)
+ `(headerp
+ (concat
+ ,(org-table--generic-apply hlstart ":hlstart")
+ contents
+ ,(org-table--generic-apply hlend ":hlend"))))
+ ,(and
+ (or llstart llend)
+ `(lastp
+ (concat
+ ,(org-table--generic-apply llstart ":llstart")
+ contents
+ ,(org-table--generic-apply llend ":llend"))))
+ (t
+ ,(cond
+ ((or lstart lend)
+ `(concat
+ ,(org-table--generic-apply lstart ":lstart")
+ contents
+ ,(org-table--generic-apply lend ":lend")))
+ (backend
+ `(org-export-with-backend
+ ',backend row contents info))
+ (t 'contents)))))))))))))))
+
+(defun org-table--to-generic-cell (params)
+ "Return custom table cell transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more
+information."
+ (let* ((backend (plist-get params :backend))
+ (efmt (plist-get params :efmt))
+ (fmt (plist-get params :fmt))
+ (hfmt (plist-get params :hfmt))
+ (sep (plist-get params :sep))
+ (hsep (plist-get params :hsep)))
+ `(lambda (cell contents info)
+ (let ((headerp (org-export-table-row-in-header-p
+ (org-export-get-parent-element cell) info))
+ (column (1+ (cdr (org-export-table-cell-address cell info)))))
+ ;; Make sure that contents are exported as Org data when :raw
+ ;; parameter is non-nil.
+ ,(when (and backend (plist-get params :raw))
+ `(setq contents
+ ;; Since we don't know what are the pseudo object
+ ;; types defined in backend, we cannot pass them to
+ ;; `org-element-interpret-data'. As a consequence,
+ ;; they will be treated as pseudo elements, and
+ ;; will have newlines appended instead of spaces.
+ ;; Therefore, we must make sure :post-blank value
+ ;; is really turned into spaces.
+ (replace-regexp-in-string
+ "\n" " "
+ (org-trim
+ (org-element-interpret-data
+ (org-element-contents cell))))))
+ (when contents
+ ;; Check if we can apply `:efmt' on CONTENTS.
+ ,(when efmt
+ `(when (string-match orgtbl-exp-regexp contents)
+ (let ((mantissa (match-string 1 contents))
+ (exponent (match-string 2 contents)))
+ (setq contents ,(org-table--generic-apply
+ efmt ":efmt" t 'mantissa 'exponent)))))
+ ;; Check if we can apply FMT (or HFMT) on CONTENTS.
+ (cond
+ ,(and hfmt `(headerp (setq contents ,(org-table--generic-apply
+ hfmt ":hfmt" t 'contents))))
+ ,(and fmt `(t (setq contents ,(org-table--generic-apply
+ fmt ":fmt" t 'contents))))))
+ ;; If a separator is provided, use it instead of BACKEND's.
+ ;; Separators are ignored when LFMT (or equivalent) is
+ ;; provided.
+ ,(cond
+ ((or hsep sep)
+ `(if (or ,(and (not sep) '(not headerp))
+ (plist-get info :orgtbl-ignore-sep)
+ (not (org-export-get-next-element cell info)))
+ ,(if (not backend) 'contents
+ `(org-export-with-backend ',backend cell contents info))
+ (concat contents
+ ,(if (and sep hsep) `(if headerp ,hsep ,sep)
+ (or hsep sep)))))
+ (backend `(org-export-with-backend ',backend cell contents info))
+ (t 'contents))))))
;;;###autoload
(defun orgtbl-to-tsv (table params)
"Convert the orgtbl-mode table to TAB separated material."
(orgtbl-to-generic table (org-combine-plists '(:sep "\t") params)))
+
;;;###autoload
(defun orgtbl-to-csv (table params)
"Convert the orgtbl-mode table to CSV material.
This does take care of the proper quoting of fields with comma or quotes."
- (orgtbl-to-generic table (org-combine-plists
- '(:sep "," :fmt org-quote-csv-field)
- params)))
+ (orgtbl-to-generic table
+ (org-combine-plists '(:sep "," :fmt org-quote-csv-field)
+ params)))
;;;###autoload
(defun orgtbl-to-latex (table params)
"Convert the orgtbl-mode TABLE to LaTeX.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Supports all parameters from `orgtbl-to-generic'. Most important for
-LaTeX are:
-
-:splice When set to t, return only table body lines, don't wrap
- them into a tabular environment. Default is nil.
-
-:fmt A format to be used to wrap the field, should contain %s for the
- original field value. For example, to wrap everything in dollars,
- use :fmt \"$%s$\". This may also be a property list with column
- numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
- The format may also be a function that formats its one argument.
-
-:efmt Format for transforming numbers with exponentials. The format
- should have %s twice for inserting mantissa and exponent, for
- example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\".
- This may also be a property list with column numbers and formats.
- The format may also be a function that formats its two arguments.
-
-:llend If you find too much space below the last line of a table,
- pass a value of \"\" for :llend to suppress the final \\\\.
-
-The general parameters :skip and :skipcols have already been applied when
-this function is called."
- (let* ((alignment (mapconcat (lambda (x) (if x "r" "l"))
- org-table-last-alignment ""))
- (params2
- (list
- :tstart (concat "\\begin{tabular}{" alignment "}")
- :tend "\\end{tabular}"
- :lstart "" :lend " \\\\" :sep " & "
- :efmt "%s\\,(%s)" :hline "\\hline")))
- (require 'ox-latex)
- (orgtbl-to-generic table (org-combine-plists params2 params) 'latex)))
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following ones:
+
+:booktabs
+
+ When non-nil, use formal \"booktabs\" style.
+
+:environment
+
+ Specify environment to use, as a string. If you use
+ \"longtable\", you may also want to specify :language property,
+ as a string, to get proper continuation strings."
+ (require 'ox-latex)
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ ;; Provide sane default values.
+ (list :backend 'latex
+ :latex-default-table-mode 'table
+ :latex-tables-centered nil
+ :latex-tables-booktabs (plist-get params :booktabs)
+ :latex-table-scientific-notation nil
+ :latex-default-table-environment
+ (or (plist-get params :environment) "tabular"))
+ params)))
;;;###autoload
(defun orgtbl-to-html (table params)
"Convert the orgtbl-mode TABLE to HTML.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Currently this function recognizes the following parameters:
-:splice When set to t, return only table body lines, don't wrap
- them into a <table> environment. Default is nil.
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following one:
+
+:attributes
-The general parameters :skip and :skipcols have already been applied when
-this function is called. The function does *not* use `orgtbl-to-generic',
-so you cannot specify parameters for it."
+ Attributes and values, as a plist, which will be used in
+ <table> tag."
(require 'ox-html)
- (let ((output (org-export-string-as
- (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t))))
- (if (not (plist-get params :splice)) output
- (org-trim
- (replace-regexp-in-string
- "\\`<table .*>\n" ""
- (replace-regexp-in-string "</table>\n*\\'" "" output))))))
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ ;; Provide sane default values.
+ (list :backend 'html
+ :html-table-data-tags '("<td%s>" . "</td>")
+ :html-table-use-header-tags-for-first-column nil
+ :html-table-align-individual-fields t
+ :html-table-row-tags '("<tr>" . "</tr>")
+ :html-table-attributes
+ (if (plist-member params :attributes)
+ (plist-get params :attributes)
+ '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups"
+ :frame "hsides")))
+ params)))
;;;###autoload
(defun orgtbl-to-texinfo (table params)
- "Convert the orgtbl-mode TABLE to TeXInfo.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Supports all parameters from `orgtbl-to-generic'. Most important for
-TeXInfo are:
-
-:splice nil/t When set to t, return only table body lines, don't wrap
- them into a multitable environment. Default is nil.
-
-:fmt fmt A format to be used to wrap the field, should contain
- %s for the original field value. For example, to wrap
- everything in @kbd{}, you could use :fmt \"@kbd{%s}\".
- This may also be a property list with column numbers and
- formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\").
- Each format also may be a function that formats its one
- argument.
-
-:cf \"f1 f2..\" The column fractions for the table. By default these
- are computed automatically from the width of the columns
- under org-mode.
-
-The general parameters :skip and :skipcols have already been applied when
-this function is called."
- (let* ((total (float (apply '+ org-table-last-column-widths)))
- (colfrac (or (plist-get params :cf)
- (mapconcat
- (lambda (x) (format "%.3f" (/ (float x) total)))
- org-table-last-column-widths " ")))
- (params2
- (list
- :tstart (concat "@multitable @columnfractions " colfrac)
- :tend "@end multitable"
- :lstart "@item " :lend "" :sep " @tab "
- :hlstart "@headitem ")))
- (require 'ox-texinfo)
- (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo)))
+ "Convert the orgtbl-mode TABLE to Texinfo.
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following one:
+
+:columns
+
+ Column widths, as a string. When providing column fractions,
+ \"@columnfractions\" command can be omitted."
+ (require 'ox-texinfo)
+ (let ((output
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ (list :backend 'texinfo
+ :texinfo-tables-verbatim nil
+ :texinfo-table-scientific-notation nil)
+ params)))
+ (columns (let ((w (plist-get params :columns)))
+ (cond ((not w) nil)
+ ((org-string-match-p "{\\|@columnfractions " w) w)
+ (t (concat "@columnfractions " w))))))
+ (if (not columns) output
+ (replace-regexp-in-string
+ "@multitable \\(.*\\)" columns output t nil 1))))
;;;###autoload
(defun orgtbl-to-orgtbl (table params)
"Convert the orgtbl-mode TABLE into another orgtbl-mode table.
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported.
+
Useful when slicing one table into many. The :hline, :sep,
-:lstart, and :lend provide orgtbl framing. The default nil :tstart
-and :tend suppress strings without splicing; they can be set to
-provide ORGTBL directives for the generated table."
- (let* ((params2
- (list
- :remove-newlines t
- :tstart nil :tend nil
- :hline "|---"
- :sep " | "
- :lstart "| "
- :lend " |"))
- (params (org-combine-plists params2 params)))
- (with-temp-buffer
- (insert (orgtbl-to-generic table params))
- (goto-char (point-min))
- (while (re-search-forward org-table-hline-regexp nil t)
- (org-table-align))
- (buffer-substring 1 (buffer-size)))))
+:lstart, and :lend provide orgtbl framing. :tstart and :tend can
+be set to provide ORGTBL directives for the generated table."
+ (require 'ox-org)
+ (orgtbl-to-generic table (org-combine-plists params (list :backend 'org))))
(defun orgtbl-to-table.el (table params)
- "Convert the orgtbl-mode TABLE into a table.el table."
+ "Convert the orgtbl-mode TABLE into a table.el table.
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported."
(with-temp-buffer
(insert (orgtbl-to-orgtbl table params))
(org-table-align)
@@ -4920,19 +5161,134 @@ provide ORGTBL directives for the generated table."
(defun orgtbl-to-unicode (table params)
"Convert the orgtbl-mode TABLE into a table with unicode characters.
-You need the ascii-art-to-unicode.el package for this. You can download
-it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
- (with-temp-buffer
- (insert (orgtbl-to-table.el table params))
- (goto-char (point-min))
- (if (or (featurep 'ascii-art-to-unicode)
- (require 'ascii-art-to-unicode nil t))
- (aa2u)
- (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links))
- (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el"
- "Link to ascii-art-to-unicode.el") org-stored-links))
- (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)"))
- (buffer-string)))
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following ones:
+
+:ascii-art
+
+ When non-nil, use \"ascii-art-to-unicode\" package to translate
+ the table. You can download it here:
+ http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.
+
+:narrow
+
+ When non-nil, narrow columns width than provided width cookie,
+ using \"=>\" as an ellipsis, just like in an Org mode buffer."
+ (require 'ox-ascii)
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ (list :backend 'ascii
+ :ascii-charset 'utf-8
+ :ascii-table-widen-columns (not (plist-get params :narrow))
+ :ascii-table-use-ascii-art (plist-get params :ascii-art))
+ params)))
+
+;; Put the cursor in a column containing numerical values
+;; of an Org-Mode table,
+;; type C-c " a
+;; A new column is added with a bar plot.
+;; When the table is refreshed (C-u C-c *),
+;; the plot is updated to reflect the new values.
+
+(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))))))))))
+
+;;;###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.
+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."
+ (interactive "P")
+ (let ((col (org-table-current-column))
+ (min 1e999) ; 1e999 will be converted to infinity
+ (max -1e999) ; which is the desired result
+ (table (org-table-to-lisp))
+ (length
+ (cond ((consp ask)
+ (read-number "Length of column " 12))
+ ((numberp ask) ask)
+ (t 12))))
+ ;; Skip any hline a the top of table.
+ (while (eq (car table) 'hline) (setq table (cdr table)))
+ ;; Skip table header if any.
+ (dolist (x (or (cdr (memq 'hline table)) table))
+ (when (consp x)
+ (setq x (nth (1- col) x))
+ (when (string-match
+ "^[-+]?\\([0-9]*[.]\\)?[0-9]*\\([eE][+-]?[0-9]+\\)?$"
+ x)
+ (setq x (string-to-number x))
+ (when (> min x) (setq min x))
+ (when (< max x) (setq max x)))))
+ (org-table-insert-column)
+ (org-table-move-column-right)
+ (org-table-store-formulas
+ (cons
+ (cons
+ (number-to-string (1+ col))
+ (format "'(%s $%s %s %s %s)"
+ "orgtbl-ascii-draw" col min max length))
+ (org-table-get-stored-formulas)))
+ (org-table-recalculate t)))
+
+;; Example of extension: unicode characters
+;; Here are two examples of different styles.
+
+;; Unicode block characters are used to give a smooth effect.
+;; See http://en.wikipedia.org/wiki/Block_Elements
+;; Use one of those drawing functions
+;; - orgtbl-ascii-draw (the default ascii)
+;; - orgtbl-uc-draw-grid (unicode with a grid effect)
+;; - orgtbl-uc-draw-cont (smooth unicode)
+
+;; This is best viewed with the "DejaVu Sans Mono" font
+;; (use M-x set-default-font).
+
+(defun orgtbl-uc-draw-grid (value min max &optional width)
+ "Draw a bar in a table using block unicode characters.
+It is a variant of orgtbl-ascii-draw with Unicode block
+characters, for a smooth display. Bars appear as grids (to the
+extent the font allows)."
+ ;; http://en.wikipedia.org/wiki/Block_Elements
+ ;; best viewed with the "DejaVu Sans Mono" font.
+ (orgtbl-ascii-draw value min max width
+ " \u258F\u258E\u258D\u258C\u258B\u258A\u2589"))
+
+(defun orgtbl-uc-draw-cont (value min max &optional width)
+ "Draw a bar in a table using block unicode characters.
+It is a variant of orgtbl-ascii-draw with Unicode block
+characters, for a smooth display. Bars are solid (to the extent
+the font allows)."
+ (orgtbl-ascii-draw value min max width
+ " \u258F\u258E\u258D\u258C\u258B\u258A\u2589\u2588"))
(defun org-table-get-remote-range (name-or-id form)
"Get a field value or a list of values in a range from table at ID.
@@ -4949,52 +5305,76 @@ The return value is either a single string for a single field, or a
list of the fields in the rectangle."
(save-match-data
(let ((case-fold-search t) (id-loc nil)
- ;; Protect a bunch of variables from being overwritten
- ;; by the context of the remote table
+ ;; Protect a bunch of variables from being overwritten by
+ ;; the context of the remote table.
org-table-column-names org-table-column-name-regexp
org-table-local-parameters org-table-named-field-locations
- org-table-current-line-types org-table-current-begin-line
+ org-table-current-line-types
org-table-current-begin-pos org-table-dlines
org-table-current-ncol
org-table-hlines org-table-last-alignment
org-table-last-column-widths org-table-last-alignment
- org-table-last-column-widths tbeg
+ org-table-last-column-widths
buffer loc)
(setq form (org-table-convert-refs-to-rc form))
- (save-excursion
- (save-restriction
- (widen)
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*"
- (regexp-quote name-or-id) "[ \t]*$")
- nil t)
- (setq buffer (current-buffer) loc (match-beginning 0))
- (setq id-loc (org-id-find name-or-id 'marker))
- (unless (and id-loc (markerp id-loc))
- (user-error "Can't find remote table \"%s\"" name-or-id))
- (setq buffer (marker-buffer id-loc)
- loc (marker-position id-loc))
- (move-marker id-loc nil)))
- (with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char loc)
- (forward-char 1)
- (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t)
- (not (match-beginning 1)))
- (user-error "Cannot find a table at NAME or ID %s" name-or-id))
- (setq tbeg (point-at-bol))
- (org-table-get-specials)
- (setq form (org-table-formula-substitute-names
- (org-table-formula-handle-first/last-rc form)))
- (if (and (string-match org-table-range-regexp form)
- (> (length (match-string 0 form)) 1))
- (save-match-data
- (org-table-get-range (match-string 0 form) tbeg 1))
- form)))))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*"
+ (regexp-quote name-or-id) "[ \t]*$")
+ nil t)
+ (setq buffer (current-buffer) loc (match-beginning 0))
+ (setq id-loc (org-id-find name-or-id 'marker))
+ (unless (and id-loc (markerp id-loc))
+ (user-error "Can't find remote table \"%s\"" name-or-id))
+ (setq buffer (marker-buffer id-loc)
+ loc (marker-position id-loc))
+ (move-marker id-loc nil))
+ (with-current-buffer buffer
+ (org-with-wide-buffer
+ (goto-char loc)
+ (forward-char 1)
+ (unless (and (re-search-forward "^\\(\\*+ \\)\\|^[ \t]*|" nil t)
+ (not (match-beginning 1)))
+ (user-error "Cannot find a table at NAME or ID %s" name-or-id))
+ (org-table-analyze)
+ (setq form (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc form)))
+ (if (and (string-match org-table-range-regexp form)
+ (> (length (match-string 0 form)) 1))
+ (org-table-get-range
+ (match-string 0 form) org-table-current-begin-pos 1)
+ form)))))))
+
+(defun org-table-remote-reference-indirection (form)
+ "Return formula with table remote references substituted by indirection.
+For example \"remote($1, @>$2)\" => \"remote(year_2013, @>$1)\".
+This indirection works only with the format @ROW$COLUMN. The
+format \"B3\" is not supported because it can not be
+distinguished from a plain table name or ID."
+ (let ((start 0))
+ (while (string-match (concat
+ ;; Same as in `org-table-eval-formula'.
+ "\\<remote([ \t]*\\("
+ ;; Allow "$1", "@<", "$-1", "@<<$1" etc.
+ "[@$][^ \t,]+"
+ ;; Same as in `org-table-eval-formula'.
+ "\\)[ \t]*,[ \t]*\\([^\n)]+\\))")
+ form
+ start)
+ ;; The position of the character as far as possible to the right
+ ;; that will not be replaced and particularly not be shifted by
+ ;; `replace-match'.
+ (setq start (match-beginning 1))
+ ;; Substitute the remote reference with the value found in the
+ ;; field.
+ (setq form
+ (replace-match
+ (save-match-data
+ (org-table-get-range (org-table-formula-handle-first/last-rc
+ (match-string 1 form))))
+ t t form 1))))
+ form)
(defmacro org-define-lookup-function (mode)
(let ((mode-str (symbol-name mode))
diff --git a/lisp/org-timer.el b/lisp/org-timer.el
index 8161699..2c51b42 100644
--- a/lisp/org-timer.el
+++ b/lisp/org-timer.el
@@ -1,4 +1,4 @@
-;;; org-timer.el --- The relative timer code for Org-mode
+;;; org-timer.el --- Timer code for Org mode
;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
@@ -24,13 +24,20 @@
;;
;;; Commentary:
-;; This file contains the relative timer code for Org-mode
+;; This file implements two types of timers for Org buffers:
+;;
+;; - A relative timer that counts up (from 0 or a specified offset)
+;; - A countdown timer that counts down from a specified time
+;;
+;; The relative and countdown timers differ in their entry points.
+;; Use `org-timer' or `org-timer-start' to start the relative timer,
+;; and `org-timer-set-timer' to start the countdown timer.
;;; Code:
(require 'org)
+(require 'org-clock)
-(declare-function org-notify "org-clock" (notification &optional play-sound))
(declare-function org-agenda-error "org-agenda" ())
(defvar org-timer-start-time nil
@@ -39,22 +46,32 @@
(defvar org-timer-pause-time nil
"Time when the timer was paused.")
+(defvar org-timer-countdown-timer nil
+ "Current countdown timer.
+This is a timer object if there is an active countdown timer,
+'paused' if there is a paused countdown timer, and nil
+otherwise.")
+
+(defvar org-timer-countdown-timer-title nil
+ "Title for notification displayed when a countdown finishes.")
+
(defconst org-timer-re "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
"Regular expression used to match timer stamps.")
(defcustom org-timer-format "%s "
"The format to insert the time of the timer.
This format must contain one instance of \"%s\" which will be replaced by
-the value of the relative timer."
+the value of the timer."
:group 'org-time
:type 'string)
-(defcustom org-timer-default-timer 0
- "The default timer when a timer is set.
+(defcustom org-timer-default-timer "0"
+ "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 "24.1"
- :type 'number)
+ :version "25.1"
+ :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
@@ -76,13 +93,13 @@ nil current timer is not displayed"
"Hook run after relative timer is started.")
(defvar org-timer-stop-hook nil
- "Hook run before relative timer is stopped.")
+ "Hook run before relative or countdown timer is stopped.")
(defvar org-timer-pause-hook nil
- "Hook run before relative timer is paused.")
+ "Hook run before relative or countdown timer is paused.")
(defvar org-timer-continue-hook nil
- "Hook run after relative timer is continued.")
+ "Hook run after relative or countdown timer is continued.")
(defvar org-timer-set-hook nil
"Hook run after countdown timer is set.")
@@ -90,9 +107,6 @@ nil current timer is not displayed"
(defvar org-timer-done-hook nil
"Hook run after countdown timer reaches zero.")
-(defvar org-timer-cancel-hook nil
- "Hook run before countdown timer is canceled.")
-
;;;###autoload
(defun org-timer-start (&optional offset)
"Set the starting time for the relative timer to now.
@@ -105,8 +119,12 @@ region will be shifted by a specific amount. You will be prompted for
the amount, with the default to make the first timer string in
the region 0:00:00."
(interactive "P")
- (if (equal offset '(16))
- (call-interactively 'org-timer-change-times-in-region)
+ (cond
+ ((equal offset '(16))
+ (call-interactively 'org-timer-change-times-in-region))
+ (org-timer-countdown-timer
+ (user-error "Countdown timer is running. Cancel first"))
+ (t
(let (delta def s)
(if (not offset)
(setq org-timer-start-time (current-time))
@@ -123,47 +141,66 @@ 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
- (- (org-float-time) delta))))
+ ;; Pass `current-time' result to `org-float-time'
+ ;; (instead of calling without arguments) so that only
+ ;; `current-time' has to be overriden in tests.
+ (- (org-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"
(format-time-string "%T" org-timer-start-time)
(org-timer-secs-to-hms (or delta 0)))
- (run-hooks 'org-timer-start-hook))))
+ (run-hooks 'org-timer-start-hook)))))
(defun org-timer-pause-or-continue (&optional stop)
- "Pause or continue the relative timer.
+ "Pause or continue the relative or countdown timer.
With prefix arg STOP, stop it entirely."
(interactive "P")
(cond
(stop (org-timer-stop))
((not org-timer-start-time) (error "No timer is running"))
(org-timer-pause-time
- ;; timer is paused, continue
- (setq org-timer-start-time
- (seconds-to-time
- (-
- (org-float-time)
- (- (org-float-time org-timer-pause-time)
- (org-float-time org-timer-start-time))))
- org-timer-pause-time nil)
- (org-timer-set-mode-line 'on)
- (run-hooks 'org-timer-continue-hook)
- (message "Timer continues at %s" (org-timer-value-string)))
+ (let ((start-secs (org-float-time org-timer-start-time))
+ (pause-secs (org-float-time org-timer-pause-time)))
+ (if org-timer-countdown-timer
+ (progn
+ (let ((new-secs (- start-secs pause-secs)))
+ (setq org-timer-countdown-timer
+ (org-timer--run-countdown-timer
+ new-secs org-timer-countdown-timer-title))
+ (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
+ ;; `current-time' has to be overriden in tests.
+ (seconds-to-time (- (org-float-time (current-time))
+ (- pause-secs start-secs)))))
+ (setq org-timer-pause-time nil)
+ (org-timer-set-mode-line 'on)
+ (run-hooks 'org-timer-continue-hook)
+ (message "Timer continues at %s" (org-timer-value-string))))
(t
;; pause timer
+ (when org-timer-countdown-timer
+ (cancel-timer org-timer-countdown-timer)
+ (setq org-timer-countdown-timer 'pause))
(run-hooks 'org-timer-pause-hook)
(setq org-timer-pause-time (current-time))
(org-timer-set-mode-line 'pause)
(message "Timer paused at %s" (org-timer-value-string)))))
-(defvar org-timer-current-timer nil)
(defun org-timer-stop ()
- "Stop the relative timer."
+ "Stop the relative or countdown timer."
(interactive)
+ (unless org-timer-start-time
+ (user-error "No timer running"))
+ (when (timerp org-timer-countdown-timer)
+ (cancel-timer org-timer-countdown-timer))
(run-hooks 'org-timer-stop-hook)
(setq org-timer-start-time nil
org-timer-pause-time nil
- org-timer-current-timer nil)
+ org-timer-countdown-timer nil)
(org-timer-set-mode-line 'off)
(message "Timer stopped"))
@@ -179,11 +216,13 @@ that was not started at the correct moment.
If NO-INSERT-P is non-nil, return the string instead of inserting
it in the buffer."
(interactive "P")
- (when (or (equal restart '(4)) (not org-timer-start-time))
- (org-timer-start))
- (if no-insert-p
- (org-timer-value-string)
- (insert (org-timer-value-string))))
+ (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
+ (org-timer-value-string)
+ (insert (org-timer-value-string)))))
(defun org-timer-value-string ()
"Set the timer string."
@@ -191,11 +230,13 @@ it in the buffer."
(org-timer-secs-to-hms
(abs (floor (org-timer-seconds))))))
-(defvar org-timer-timer-is-countdown nil)
(defun org-timer-seconds ()
- (if org-timer-timer-is-countdown
+ ;; Pass `current-time' result to `org-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 (current-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))))
@@ -290,7 +331,7 @@ If the integer is negative, the string will start with \"-\"."
(defvar org-timer-mode-line-string nil)
(defun org-timer-set-mode-line (value)
- "Set the mode-line display of the relative timer.
+ "Set the mode-line display for relative or countdown timer.
VALUE can be `on', `off', or `pause'."
(when (or (eq org-timer-display 'mode-line)
(eq org-timer-display 'both))
@@ -349,103 +390,116 @@ VALUE can be `on', `off', or `pause'."
(concat " <" (substring (org-timer-value-string) 0 -1) ">"))
(force-mode-line-update)))
-(defun org-timer-cancel-timer ()
- "Cancel the current timer."
- (interactive)
- (when (eval org-timer-current-timer)
- (run-hooks 'org-timer-cancel-hook)
- (cancel-timer org-timer-current-timer)
- (setq org-timer-current-timer nil)
- (setq org-timer-timer-is-countdown nil)
- (org-timer-set-mode-line 'off))
- (message "Last timer canceled"))
-
(defun org-timer-show-remaining-time ()
"Display the remaining time before the timer ends."
(interactive)
(require 'time)
- (if (not org-timer-current-timer)
+ (if (not org-timer-countdown-timer)
(message "No timer set")
(let* ((rtime (decode-time
- (time-subtract (timer--time org-timer-current-timer)
+ (time-subtract (timer--time org-timer-countdown-timer)
(current-time))))
(rsecs (nth 0 rtime))
(rmins (nth 1 rtime)))
(message "%d minute(s) %d seconds left before next time out"
rmins rsecs))))
-(defvar org-clock-sound)
-
;;;###autoload
(defun org-timer-set-timer (&optional opt)
- "Prompt for a duration and set a timer.
+ "Prompt for a duration in minutes or hh:mm:ss and set a timer.
-If `org-timer-default-timer' is not zero, suggest this value as
+If `org-timer-default-timer' is not \"0\", suggest this value as
the default duration for the timer. If a timer is already set,
prompt the user if she wants to replace it.
Called with a numeric prefix argument, use this numeric value as
-the duration of the timer.
+the duration of the timer in minutes.
Called with a `C-u' prefix arguments, use `org-timer-default-timer'
without prompting the user for a duration.
With two `C-u' prefix arguments, use `org-timer-default-timer'
without prompting the user for a duration and automatically
-replace any running timer."
+replace any running timer.
+
+By default, the timer duration will be set to the number of
+minutes in the Effort property, if any. You can ignore this by
+using three `C-u' prefix arguments."
(interactive "P")
- (let ((minutes (or (and (numberp opt) (number-to-string opt))
- (and (listp opt) (not (null opt))
- (number-to-string org-timer-default-timer))
- (read-from-minibuffer
- "How many minutes left? "
- (if (not (eq org-timer-default-timer 0))
- (number-to-string org-timer-default-timer))))))
+ (when (and org-timer-start-time
+ (not org-timer-countdown-timer))
+ (user-error "Relative timer is running. Stop first"))
+ (let* ((default-timer
+ ;; `org-timer-default-timer' used to be a number, don't choke:
+ (if (numberp org-timer-default-timer)
+ (number-to-string org-timer-default-timer)
+ org-timer-default-timer))
+ (effort-minutes (ignore-errors (org-get-at-eol 'effort-minutes 1)))
+ (minutes (or (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
+ "How much time left? (minutes or h:mm:ss) "
+ (and (not (string-equal default-timer "0")) default-timer)))))
+ (when (string-match "\\`[0-9]+\\'" minutes)
+ (setq minutes (concat minutes ":00")))
(if (not (string-match "[0-9]+" minutes))
(org-timer-show-remaining-time)
- (let* ((mins (string-to-number (match-string 0 minutes)))
- (secs (* mins 60))
- (hl (cond
- ((string-match "Org Agenda" (buffer-name))
- (let* ((marker (or (get-text-property (point) 'org-marker)
- (org-agenda-error)))
- (hdmarker (or (get-text-property (point) 'org-hd-marker)
- marker))
- (pos (marker-position marker)))
- (with-current-buffer (marker-buffer marker)
- (widen)
- (goto-char pos)
- (org-show-entry)
- (or (ignore-errors (org-get-heading))
- (concat "File:" (file-name-nondirectory (buffer-file-name)))))))
- ((derived-mode-p 'org-mode)
- (or (ignore-errors (org-get-heading))
- (concat "File:" (file-name-nondirectory (buffer-file-name)))))
- (t (error "Not in an Org buffer"))))
- timer-set)
- (if (or (and org-timer-current-timer
- (or (equal opt '(16))
- (y-or-n-p "Replace current timer? ")))
- (not org-timer-current-timer))
+ (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes)))
+ (hl (org-timer--get-timer-title)))
+ (if (or (not org-timer-countdown-timer)
+ (equal opt '(16))
+ (y-or-n-p "Replace current timer? "))
(progn
- (require 'org-clock)
- (when org-timer-current-timer
- (cancel-timer org-timer-current-timer))
- (setq org-timer-current-timer
- (run-with-timer
- secs nil `(lambda ()
- (setq org-timer-current-timer nil)
- (org-notify ,(format "%s: time out" hl) ,org-clock-sound)
- (setq org-timer-timer-is-countdown nil)
- (org-timer-set-mode-line 'off)
- (run-hooks 'org-timer-done-hook))))
+ (when (timerp org-timer-countdown-timer)
+ (cancel-timer org-timer-countdown-timer))
+ (setq org-timer-countdown-timer-title
+ (org-timer--get-timer-title))
+ (setq org-timer-countdown-timer
+ (org-timer--run-countdown-timer
+ secs org-timer-countdown-timer-title))
(run-hooks 'org-timer-set-hook)
- (setq org-timer-timer-is-countdown t
- org-timer-start-time
- (time-add (current-time) (seconds-to-time (* mins 60))))
+ (setq org-timer-start-time
+ (time-add (current-time) (seconds-to-time secs)))
+ (setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on))
(message "No timer set"))))))
+(defun org-timer--run-countdown-timer (secs title)
+ "Start countdown timer that will last SECS.
+TITLE will be appended to the notification message displayed when
+time is up."
+ (let ((msg (format "%s: time out" title)))
+ (run-with-timer
+ secs nil `(lambda ()
+ (setq org-timer-countdown-timer nil
+ org-timer-start-time nil)
+ (org-notify ,msg ,org-clock-sound)
+ (org-timer-set-mode-line 'off)
+ (run-hooks 'org-timer-done-hook)))))
+
+(defun org-timer--get-timer-title ()
+ "Construct timer title from heading or file name of Org buffer."
+ (cond
+ ((derived-mode-p 'org-agenda-mode)
+ (let* ((marker (or (get-text-property (point) 'org-marker)
+ (org-agenda-error)))
+ (hdmarker (or (get-text-property (point) 'org-hd-marker)
+ marker)))
+ (with-current-buffer (marker-buffer marker)
+ (org-with-wide-buffer
+ (goto-char hdmarker)
+ (org-show-entry)
+ (or (ignore-errors (org-get-heading))
+ (buffer-name (buffer-base-buffer)))))))
+ ((derived-mode-p 'org-mode)
+ (or (ignore-errors (org-get-heading))
+ (buffer-name (buffer-base-buffer))))
+ (t (error "Not in an Org buffer"))))
+
(provide 'org-timer)
;; Local variables:
diff --git a/lisp/org-version.el b/lisp/org-version.el
index e8c6044..6f2c936 100644
--- a/lisp/org-version.el
+++ b/lisp/org-version.el
@@ -5,13 +5,13 @@
(defun org-release ()
"The release version of org-mode.
Inserted by installing org-mode or when a release is made."
- (let ((org-release "8.2.10"))
+ (let ((org-release "8.3.1"))
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.2.10-dist"))
+ (let ((org-git-version "8.3.1-dist"))
org-git-version))
;;;###autoload
(defvar org-odt-data-dir "/usr/share/emacs/etc/org"
diff --git a/lisp/org.el b/lisp/org.el
index 2b5603c..b6f1da7 100644..100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -1,7 +1,7 @@
;;; org.el --- Outline-based notes management and organizer
;; Carstens outline-mode for keeping track of everything.
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
@@ -77,7 +77,16 @@
(require 'find-func)
(require 'format-spec)
-(load "org-loaddefs.el" t t t)
+(or (equal this-command 'eval-buffer)
+ (condition-case nil
+ (load (concat (file-name-directory load-file-name)
+ "org-loaddefs.el")
+ nil t t t)
+ (error
+ (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.")
+ (sit-for 3)
+ (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory")
+ (sit-for 3))))
(require 'org-macs)
(require 'org-compat)
@@ -111,63 +120,77 @@ Stars are put in group 1 and the trimmed body in group 2.")
(unless (boundp 'diary-fancy-buffer)
(org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))
+(declare-function cdlatex-environment "ext:cdlatex" (environment item))
(declare-function org-add-archive-files "org-archive" (files))
-
-(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
-(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
-(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
-(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
+(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-redo "org-agenda" (&optional all))
+(declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body))
+(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
+(declare-function org-beamer-mode "ox-beamer" ())
(declare-function org-clock-get-last-clock-out-time "org-clock" ())
-(declare-function org-clock-timestamps-up "org-clock" (&optional n))
-(declare-function org-clock-timestamps-down "org-clock" (&optional n))
+(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))
+(declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname))
(declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
+(declare-function org-clock-timestamps-down "org-clock" (&optional n))
+(declare-function org-clock-timestamps-up "org-clock" (&optional n))
(declare-function org-clock-update-time-maybe "org-clock" ())
(declare-function org-clocktable-shift "org-clock" (dir n))
-
-(declare-function orgtbl-mode "org-table" (&optional arg))
-(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
-(declare-function org-beamer-mode "ox-beamer" ())
-(declare-function org-table-edit-field "org-table" (arg))
-(declare-function org-table-justify-field-maybe "org-table" (&optional new))
-(declare-function org-table-set-constants "org-table" ())
-(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg))
-(declare-function org-id-get-create "org-id" (&optional force))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-cache-refresh "org-element" (pos))
+(declare-function org-element-cache-reset "org-element" (&optional all))
+(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-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))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-put-property "org-element" (element property value))
+(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-update-syntax "org-element" ())
(declare-function org-id-find-id-file "org-id" (id))
-(declare-function org-tags-view "org-agenda" (&optional todo-only match))
-(declare-function org-agenda-list "org-agenda" (&optional arg start-day span))
-(declare-function org-agenda-redo "org-agenda" (&optional all))
+(declare-function org-id-get-create "org-id" (&optional force))
+(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
+(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-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))
(declare-function org-table-insert-row "org-table" (&optional arg))
-(declare-function org-table-paste-rectangle "org-table" ())
+(declare-function org-table-justify-field-maybe "org-table" (&optional new))
(declare-function org-table-maybe-eval-formula "org-table" ())
(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-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))
+(declare-function orgtbl-mode "org-table" (&optional arg))
-(declare-function org-element--parse-objects "org-element"
- (beg end acc restriction))
-(declare-function org-element-at-point "org-element" (&optional keep-trail))
-(declare-function org-element-contents "org-element" (element))
-(declare-function org-element-context "org-element" (&optional element))
-(declare-function org-element-interpret-data "org-element"
- (data &optional parent))
-(declare-function org-element-map "org-element"
- (data types fun &optional info first-match no-recursion))
-(declare-function org-element-nested-p "org-element" (elem-a elem-b))
-(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-swap-A-B "org-element" (elem-a elem-b))
-(declare-function org-element--parse-objects "org-element"
- (beg end acc restriction))
-(declare-function org-element-parse-buffer "org-element"
- (&optional granularity visible-only))
-(declare-function org-element-restriction "org-element" (element))
-(declare-function org-element-type "org-element" (element))
+(defsubst org-uniquify (list)
+ "Non-destructively remove duplicate elements from LIST."
+ (let ((res (copy-sequence list))) (delete-dups res)))
+
+(defsubst org-get-at-bol (property)
+ "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."
+ (replace-regexp-in-string
+ "\\`[ \t\n\r]+" ""
+ (replace-regexp-in-string "[ \t\n\r]+\\'" "" s)))
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
@@ -197,7 +220,6 @@ and then loads the resulting file using `load-file'. With prefix
arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
file to byte-code before it is loaded."
(interactive "fFile to load: \nP")
- (require 'ob-core)
(let* ((age (lambda (file)
(float-time
(time-subtract (current-time)
@@ -208,8 +230,10 @@ file to byte-code before it is loaded."
;; tangle if the org-mode 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
+ ;; and we want to evaluate the first target.
(setq exported-file
- (car (org-babel-tangle-file file exported-file "emacs-lisp"))))
+ (car (last (org-babel-tangle-file file exported-file "emacs-lisp")))))
(message "%s %s"
(if compile
(progn (byte-compile-file exported-file 'load)
@@ -244,10 +268,12 @@ requirements) is loaded."
(const :tag "Ditaa" ditaa)
(const :tag "Dot" dot)
(const :tag "Emacs Lisp" emacs-lisp)
+ (const :tag "Forth" forth)
(const :tag "Fortran" fortran)
(const :tag "Gnuplot" gnuplot)
(const :tag "Haskell" haskell)
(const :tag "IO" io)
+ (const :tag "J" J)
(const :tag "Java" java)
(const :tag "Javascript" js)
(const :tag "LaTeX" latex)
@@ -270,10 +296,11 @@ requirements) is loaded."
(const :tag "Scala" scala)
(const :tag "Scheme" scheme)
(const :tag "Screen" screen)
- (const :tag "Shell Script" sh)
+ (const :tag "Shell Script" shell)
(const :tag "Shen" shen)
(const :tag "Sql" sql)
- (const :tag "Sqlite" sqlite))
+ (const :tag "Sqlite" sqlite)
+ (const :tag "ebnf2ps" ebnf2ps))
:value-type (boolean :tag "Activate" :value t)))
;;;; Customization variables
@@ -291,11 +318,12 @@ identifier."
;;;###autoload
(defun org-version (&optional here full message)
- "Show the org-mode version in the echo area.
-With prefix argument HERE, insert it at point.
-When FULL is non-nil, use a verbose version string.
-When MESSAGE is non-nil, display a message with the version."
- (interactive "P")
+ "Show the org-mode 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"))
@@ -315,17 +343,287 @@ When MESSAGE is non-nil, display a message with the version."
(concat "mixed installation! " org-install-dir " and " org-dir))
"org-loaddefs.el can not be found!")))
(version1 (if full version org-version)))
- (if (org-called-interactively-p 'interactive)
- (if here
- (insert version)
- (message version))
- (if message (message version1))
- version1)))
+ (when here (insert version1))
+ (when message (message "%s" version1))
+ version1))
(defconst org-version (org-version))
-;;; Compatibility constants
+
+;;; Syntax Constants
+
+;;;; Block
+
+(defconst org-block-regexp
+ "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
+ "Regular expression for hiding blocks.")
+
+(defconst org-dblock-start-re
+ "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
+ "Matches the start line of a dynamic block, with parameters.")
+
+(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
+ "Matches the end of a dynamic block.")
+
+;;;; Clock and Planning
+
+(defconst org-clock-string "CLOCK:"
+ "String used as prefix for timestamps clocking work hours on an item.")
+
+(defvar org-closed-string "CLOSED:"
+ "String used as the prefix for timestamps logging closing a TODO entry.")
+
+(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].")
+
+(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].")
+
+(defconst org-ds-keyword-length
+ (+ 2
+ (apply #'max
+ (mapcar #'length
+ (list org-deadline-string org-scheduled-string
+ org-clock-string org-closed-string))))
+ "Maximum length of the DEADLINE and SCHEDULED keywords.")
+
+(defconst org-planning-line-re
+ (concat "^[ \t]*"
+ (regexp-opt
+ (list org-closed-string org-deadline-string org-scheduled-string)
+ t))
+ "Matches a line with planning info.
+Matched keyword is in group 1.")
+
+(defconst org-clock-line-re
+ (concat "^[ \t]*" org-clock-string)
+ "Matches a line with clock info.")
+
+(defconst org-deadline-regexp (concat "\\<" org-deadline-string)
+ "Matches the DEADLINE keyword.")
+
+(defconst org-deadline-time-regexp
+ (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
+ "Matches the DEADLINE keyword together with a time stamp.")
+
+(defconst org-deadline-time-hour-regexp
+ (concat "\\<" org-deadline-string
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
+ "Matches the DEADLINE keyword together with a time-and-hour stamp.")
+
+(defconst org-deadline-line-regexp
+ (concat "\\<\\(" org-deadline-string "\\).*")
+ "Matches the DEADLINE keyword and the rest of the line.")
+
+(defconst org-scheduled-regexp (concat "\\<" org-scheduled-string)
+ "Matches the SCHEDULED keyword.")
+
+(defconst org-scheduled-time-regexp
+ (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
+ "Matches the SCHEDULED keyword together with a time stamp.")
+
+(defconst org-scheduled-time-hour-regexp
+ (concat "\\<" org-scheduled-string
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
+ "Matches the SCHEDULED keyword together with a time-and-hour stamp.")
+
+(defconst org-closed-time-regexp
+ (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
+ "Matches the CLOSED keyword together with a time stamp.")
+
+(defconst org-keyword-time-regexp
+ (concat "\\<"
+ (regexp-opt
+ (list org-scheduled-string org-deadline-string org-closed-string
+ org-clock-string)
+ t)
+ " *[[<]\\([^]>]+\\)[]>]")
+ "Matches any of the 4 keywords, together with the time stamp.")
+
+(defconst org-keyword-time-not-clock-regexp
+ (concat
+ "\\<"
+ (regexp-opt
+ (list org-scheduled-string org-deadline-string org-closed-string) t)
+ " *[[<]\\([^]>]+\\)[]>]")
+ "Matches any of the 3 keywords, together with the time stamp.")
+
+(defconst org-maybe-keyword-time-regexp
+ (concat "\\(\\<"
+ (regexp-opt
+ (list org-scheduled-string org-deadline-string org-closed-string
+ org-clock-string)
+ t)
+ "\\)?"
+ " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]"
+ "\\|"
+ "<%%([^\r\n>]*>\\)")
+ "Matches a timestamp, possibly preceded by a keyword.")
+
+(defconst org-all-time-keywords
+ (mapcar (lambda (w) (substring w 0 -1))
+ (list org-scheduled-string org-deadline-string
+ org-clock-string org-closed-string))
+ "List of time keywords.")
+
+;;;; Drawer
+
+(defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"
+ "Matches first or last line of a hidden block.
+Group 1 contains drawer's name or \"END\".")
+
+(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
+ "Regular expression matching the first line of a property drawer.")
+
+(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
+ "Regular expression matching the last line of a property drawer.")
+
+(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
+ "Regular expression matching the first line of a clock drawer.")
+
+(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
+ "Regular expression matching the last line of a clock drawer.")
+
+(defconst org-property-drawer-re
+ (concat "^[ \t]*:PROPERTIES:[ \t]*\n"
+ "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*"
+ "[ \t]*:END:[ \t]*$")
+ "Matches an entire property drawer.")
+
+(defconst org-clock-drawer-re
+ (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\("
+ org-clock-drawer-end-re "\\)\n?")
+ "Matches an entire clock drawer.")
+
+;;;; Headline
+
+(defconst org-heading-keyword-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching a headline with some keyword.
+This regexp will match the headline of any node which has the
+exact keyword that is put into the format. The keyword isn't in
+any group by default, but the stars and the body are.")
+
+(defconst org-heading-keyword-maybe-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching a headline, possibly with some keyword.
+This regexp can match any headline with the specified keyword, or
+without a keyword. The keyword isn't in any group by default,
+but the stars and the body are.")
+
+(defconst org-archive-tag "ARCHIVE"
+ "The tag that marks a subtree as archived.
+An archived subtree does not open during visibility cycling, and does
+not contribute to the agenda listings.")
+
+(defconst org-comment-string "COMMENT"
+ "Entries starting with this keyword will never be exported.
+An entry can be toggled between COMMENT and normal with
+\\[org-toggle-comment].")
+
+
+;;;; LaTeX Environments and Fragments
+
+(defconst org-latex-regexps
+ '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
+ ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
+ ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
+ ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|$\\)" 2 nil)
+ ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|$\\)" 2 nil)
+ ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
+ ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
+ ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
+ "Regular expressions for matching embedded LaTeX.")
+
+;;;; Node Property
+
+(defconst org-effort-property "Effort"
+ "The property that is being used to keep track of effort estimates.
+Effort estimates given in this property need to have the format H:MM.")
+
+;;;; Table
+
+(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
+ "Detect an org-type or table-type table.")
+
+(defconst org-table-line-regexp "^[ \t]*|"
+ "Detect an org-type table line.")
+
+(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
+ "Detect an org-type table line.")
+
+(defconst org-table-hline-regexp "^[ \t]*|-"
+ "Detect an org-type table hline.")
+
+(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
+ "Detect a table-type table hline.")
+
+(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
+ "Detect the first line outside a table when searching from within it.
+This works for both table types.")
+
+(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
+ "Detect a #+TBLFM line.")
+
+;;;; Timestamp
+
+(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
+ "Regular expression for fast time stamp matching.")
+
+(defconst org-ts-regexp-inactive
+ "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]"
+ "Regular expression for fast inactive time stamp matching.")
+
+(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
+ "Regular expression for fast time stamp matching.")
+
+(defconst org-ts-regexp0
+ "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+ "Regular expression matching time strings for analysis.
+This one does not require the space after the date, so it can be used
+on a string that terminates immediately after the date.")
+
+(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+ "Regular expression matching time strings for analysis.")
+
+(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
+ "Regular expression matching time stamps, with groups.")
+
+(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
+ "Regular expression matching time stamps (also [..]), with groups.")
+
+(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
+ "Regular expression matching a time stamp range.")
+
+(defconst org-tr-regexp-both
+ (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
+ "Regular expression matching a time stamp range.")
+
+(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
+ org-ts-regexp "\\)?")
+ "Regular expression matching a time stamp or time stamp range.")
+
+(defconst org-tsr-regexp-both
+ (concat org-ts-regexp-both "\\(--?-?"
+ org-ts-regexp-both "\\)?")
+ "Regular expression matching a time stamp or time stamp range.
+The time stamps may be either active or inactive.")
+
+(defconst org-repeat-re
+ "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
+ "Regular expression for specifying repeated events.
+After a match, group 1 contains the repeat expression.")
+
+(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
+ "Formats for `format-time-string' which are used for time stamps.")
+
;;; The custom variables
(defgroup org nil
@@ -367,7 +665,8 @@ When MESSAGE is non-nil, display a message with the version."
"Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
(set var value)
(when (featurep 'org)
- (org-load-modules-maybe 'force)))
+ (org-load-modules-maybe 'force)
+ (org-element-cache-reset 'all)))
(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail)
"Modules that should always be loaded together with org.el.
@@ -419,12 +718,12 @@ For export specific modules, see also `org-export-backends'."
(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 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 jira: Add a jira:ticket protocol to Org-mode" org-jira)
(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)
@@ -446,7 +745,7 @@ For export specific modules, see also `org-export-backends'."
(const :tag "C wl: Links to Wanderlust folders/messages" org-wl)
(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
-(defvar org-export--registered-backends) ; From ox.el.
+(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)
@@ -466,7 +765,7 @@ interface or run the following code, where VAL stands for the new
value of the variable, after updating it:
\(progn
- \(setq org-export--registered-backends
+ \(setq org-export-registered-backends
\(org-remove-if-not
\(lambda (backend)
\(let ((name (org-export-backend-name backend)))
@@ -475,9 +774,9 @@ value of the variable, after updating it:
\(dolist (b val)
\(and (org-export-derived-backend-p b name)
\(throw 'parentp t)))))))
- org-export--registered-backends))
- \(let ((new-list (mapcar 'org-export-backend-name
- org-export--registered-backends)))
+ org-export-registered-backends))
+ \(let ((new-list (mapcar #'org-export-backend-name
+ org-export-registered-backends)))
\(dolist (backend val)
\(cond
\((not (load (format \"ox-%s\" backend) t t))
@@ -498,7 +797,7 @@ depends on, if any."
;; Any back-end not required anymore (not present in VAL and not
;; a parent of any back-end in the new value) is removed from the
;; list of registered back-ends.
- (setq org-export--registered-backends
+ (setq org-export-registered-backends
(org-remove-if-not
(lambda (backend)
(let ((name (org-export-backend-name backend)))
@@ -507,11 +806,11 @@ depends on, if any."
(dolist (b val)
(and (org-export-derived-backend-p b name)
(throw 'parentp t)))))))
- org-export--registered-backends))
+ org-export-registered-backends))
;; Now build NEW-LIST of both new back-ends and required
;; parents.
- (let ((new-list (mapcar 'org-export-backend-name
- org-export--registered-backends)))
+ (let ((new-list (mapcar #'org-export-backend-name
+ org-export-registered-backends)))
(dolist (backend val)
(cond
((not (load (format "ox-%s" backend) t t))
@@ -595,7 +894,7 @@ XEmacs user should have this variable set to nil, because
(defcustom org-loop-over-headlines-in-active-region nil
"Shall some commands act upon headlines in the active region?
-When set to `t', some commands will be performed in all headlines
+When set to t, some commands will be performed in all headlines
within the active region.
When set to `start-level', some commands will be performed in all
@@ -827,7 +1126,7 @@ 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 `M-x org-mode RET' in a buffer to become
+Changing this requires executing \\[org-mode] in a buffer to become
effective."
:group 'org-startup
:type '(choice (const :tag "Default" nil)
@@ -842,34 +1141,6 @@ effective."
:tag "Org Keywords"
:group 'org)
-(defcustom 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].
-Changes become only effective after restarting Emacs."
- :group 'org-keywords
- :type 'string)
-
-(defcustom 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].
-Changes become only effective after restarting Emacs."
- :group 'org-keywords
- :type 'string)
-
-(defcustom org-closed-string "CLOSED:"
- "String used as the prefix for timestamps logging closing a TODO entry."
- :group 'org-keywords
- :type 'string)
-
-(defcustom org-clock-string "CLOCK:"
- "String used as prefix for timestamps clocking work hours on an item."
- :group 'org-keywords
- :type 'string)
-
(defcustom org-closed-keep-when-no-todo nil
"Remove CLOSED: time-stamp when switching back to a non-todo state?"
:group 'org-todo
@@ -878,35 +1149,6 @@ Changes become only effective after restarting Emacs."
:package-version '(Org . "8.0")
:type 'boolean)
-(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\("
- org-scheduled-string "\\|"
- org-deadline-string "\\|"
- org-closed-string "\\|"
- org-clock-string "\\)")
- "Matches a line with planning or clock info.")
-
-(defcustom org-comment-string "COMMENT"
- "Entries starting with this keyword will never be exported.
-An entry can be toggled between COMMENT and normal with
-\\[org-toggle-comment].
-Changes become only effective after restarting Emacs."
- :group 'org-keywords
- :type 'string)
-
-(defcustom org-quote-string "QUOTE"
- "Entries starting with this keyword will be exported in fixed-width font.
-Quoting applies only to the text in the entry following the headline, and does
-not extend beyond the next headline, even if that is lower level.
-An entry can be toggled between QUOTE and normal with
-\\[org-toggle-fixed-width-section]."
- :group 'org-keywords
- :type 'string)
-
-(defconst org-repeat-re
- "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
- "Regular expression for specifying repeated events.
-After a match, group 1 contains the repeat expression.")
-
(defgroup org-structure nil
"Options concerning the general structure of Org-mode files."
:tag "Org Structure"
@@ -917,87 +1159,80 @@ After a match, group 1 contains the repeat expression.")
:tag "Org Reveal Location"
:group 'org-structure)
-(defconst org-context-choice
- '(choice
- (const :tag "Always" t)
- (const :tag "Never" nil)
- (repeat :greedy t :tag "Individual contexts"
- (cons
- (choice :tag "Context"
- (const agenda)
- (const org-goto)
- (const occur-tree)
- (const tags-tree)
- (const link-search)
- (const mark-goto)
- (const bookmark-jump)
- (const isearch)
- (const default))
- (boolean))))
- "Contexts for the reveal options.")
-
-(defcustom org-show-hierarchy-above '((default . t))
- "Non-nil means show full hierarchy when revealing a location.
-Org-mode often shows locations in an org-mode file which might have
-been invisible before. When this is set, the hierarchy of headings
-above the exposed location is shown.
-Turning this off for example for sparse trees makes them very compact.
-Instead of t, this can also be an alist specifying this option for different
-contexts. Valid contexts are
+(defcustom org-show-context-detail '((isearch . lineage)
+ (bookmark-jump . lineage)
+ (default . ancestors))
+ "Alist between context and visibility span when revealing a location.
+
+\\<org-mode-map>Some actions may move point into invisible
+locations. As a consequence, Org always expose a neighborhood
+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' on key C-c C-j
- occur-tree when using the command `org-occur' on key C-c /
+ 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
bookmark-jump when exposing a bookmark location
isearch when exiting from an incremental search
- default default for all contexts not set explicitly"
- :group 'org-reveal-location
- :type org-context-choice)
-
-(defcustom org-show-following-heading '((default . nil))
- "Non-nil means show following heading when revealing a location.
-Org-mode often shows locations in an org-mode file which might have
-been invisible before. When this is set, the heading following the
-match is shown.
-Turning this off for example for sparse trees makes them very compact,
-but makes it harder to edit the location of the match. In such a case,
-use the command \\[org-reveal] to show more context.
-Instead of t, this can also be an alist specifying this option for different
-contexts. See `org-show-hierarchy-above' for valid contexts."
- :group 'org-reveal-location
- :type org-context-choice)
-
-(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump t))
- "Non-nil means show all sibling heading when revealing a location.
-Org-mode often shows locations in an org-mode file which might have
-been invisible before. When this is set, the sibling of the current entry
-heading are all made visible. If `org-show-hierarchy-above' is t,
-the same happens on each level of the hierarchy above the current entry.
-
-By default this is on for the isearch context, off for all other contexts.
-Turning this off for example for sparse trees makes them very compact,
-but makes it harder to edit the location of the match. In such a case,
-use the command \\[org-reveal] to show more context.
-Instead of t, this can also be an alist specifying this option for different
-contexts. See `org-show-hierarchy-above' for valid contexts."
- :group 'org-reveal-location
- :type org-context-choice
- :version "24.4"
- :package-version '(Org . "8.0"))
+ default default for all contexts not set explicitly
+
+Allowed visibility spans are
+
+ minimal show current headline; if point is not on headline,
+ also show entry
+
+ local show current headline, entry and next headline
+
+ ancestors show current headline and its direct ancestors; if
+ point is not on headline, also show entry
+
+ lineage show current headline, its direct ancestors and all
+ their children; if point is not on headline, also show
+ entry and first child
+
+ tree show current headline, its direct ancestors and all
+ their children; if point is not on headline, also show
+ entry and all children
+
+ canonical show current headline, its direct ancestors along with
+ their entries and children; if point is not located on
+ the headline, also show current entry and all children
-(defcustom org-show-entry-below '((default . nil))
- "Non-nil means show the entry below a headline when revealing a location.
-Org-mode often shows locations in an org-mode file which might have
-been invisible before. When this is set, the text below the headline that is
-exposed is also shown.
+As special cases, a nil or t value means show all contexts in
+`minimal' or `canonical' view, respectively.
-By default this is off for all contexts.
-Instead of t, this can also be an alist specifying this option for different
-contexts. See `org-show-hierarchy-above' for valid contexts."
+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
+more context."
:group 'org-reveal-location
- :type org-context-choice)
+ :version "25.1"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "Canonical" t)
+ (const :tag "Minimal" nil)
+ (repeat :greedy t :tag "Individual contexts"
+ (cons
+ (choice :tag "Context"
+ (const agenda)
+ (const org-goto)
+ (const occur-tree)
+ (const tags-tree)
+ (const link-search)
+ (const mark-goto)
+ (const bookmark-jump)
+ (const isearch)
+ (const default))
+ (choice :tag "Detail level"
+ (const minimal)
+ (const local)
+ (const ancestors)
+ (const lineage)
+ (const tree)
+ (const canonical))))))
(defcustom org-indirect-buffer-display 'other-window
"How should indirect tree buffers be displayed?
@@ -1021,7 +1256,13 @@ new-frame Make a new frame each time. Note that in this case
(defcustom org-use-speed-commands nil
"Non-nil means activate single letter commands at beginning of a headline.
This may also be a function to test for appropriate locations where speed
-commands should be active."
+commands should be active.
+
+For example, to activate speed commands when the point is on any
+star at the beginning of the headline, you can do this:
+
+ (setq org-use-speed-commands
+ (lambda () (and (looking-at org-outline-regexp) (looking-back \"^\\**\"))))"
:group 'org-structure
:type '(choice
(const :tag "Never" nil)
@@ -1051,10 +1292,10 @@ commands in the Help buffer using the `?' speed command."
(sexp))))))
(defcustom org-bookmark-names-plist
- '(:last-capture "org-capture-last-stored"
- :last-refile "org-refile-last-stored"
- :last-capture-marker "org-capture-last-stored-marker")
- "Names for bookmarks automatically set by some Org commands.
+ '(:last-capture "org-capture-last-stored"
+ :last-refile "org-refile-last-stored"
+ :last-capture-marker "org-capture-last-stored-marker")
+ "Names for bookmarks automatically set by some Org commands.
This can provide strings as names for a number of bookmarks Org sets
automatically. The following keys are currently implemented:
:last-capture
@@ -1062,8 +1303,8 @@ automatically. The following keys are currently implemented:
:last-refile
When a key does not show up in the property list, the corresponding bookmark
is not set."
- :group 'org-structure
- :type 'plist)
+ :group 'org-structure
+ :type 'plist)
(defgroup org-cycle nil
"Options concerning visibility cycling in Org-mode."
@@ -1090,23 +1331,6 @@ than its value."
(const :tag "No limit" nil)
(integer :tag "Maximum level")))
-(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS")
- "Names of drawers. Drawers are not opened by cycling on the headline above.
-Drawers only open with a TAB on the drawer line itself. A drawer looks like
-this:
- :DRAWERNAME:
- .....
- :END:
-The drawer \"PROPERTIES\" is special for capturing properties through
-the property API.
-
-Drawers can be defined on the per-file basis with a line like:
-
-#+DRAWERS: HIDDEN STATE PROPERTIES"
- :group 'org-structure
- :group 'org-cycle
- :type '(repeat (string :tag "Drawer Name")))
-
(defcustom org-hide-block-startup nil
"Non-nil means entering Org-mode will fold all blocks.
This can also be set in on a per-file basis with
@@ -1189,7 +1413,6 @@ the values `folded', `children', or `subtree'."
(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
org-cycle-hide-drawers
- org-cycle-hide-inline-tasks
org-cycle-show-empty-lines
org-optimize-window-after-visibility-change)
"Hook that is run after `org-cycle' has changed the buffer visibility.
@@ -1199,7 +1422,9 @@ argument is a symbol. After a global state change, it can have the values
`overview', `contents', or `all'. After a local state change, it can have
the values `folded', `children', or `subtree'."
:group 'org-cycle
- :type 'hook)
+ :type 'hook
+ :version "25.1"
+ :package-version '(Org . "8.3"))
(defgroup org-edit-structure nil
"Options concerning structure editing in Org-mode."
@@ -1226,23 +1451,25 @@ lines to the buffer:
"Non-nil means adapt indentation to outline node level.
When this variable is set, Org assumes that you write outlines by
-indenting text in each node to align with the headline (after the stars).
-The following issues are influenced by this variable:
+indenting text in each node to align with the headline (after the
+stars). The following issues are influenced by this variable:
-- When this is set and the *entire* text in an entry is indented, the
- indentation is increased by one space in a demotion command, and
- decreased by one in a promotion command. If any line in the entry
- body starts with text at column 0, indentation is not changed at all.
+- The indentation is increased by one space in a demotion
+ command, and decreased by one in a promotion command. However,
+ in the latter case, if shifting some line in the entry body
+ would alter document structure (e.g., insert a new headline),
+ indentation is not changed at all.
-- Property drawers and planning information is inserted indented when
- this variable s set. When nil, they will not be indented.
+- Property drawers and planning information is inserted indented
+ when this variable is set. When nil, they will not be indented.
-- TAB indents a line relative to context. The lines below a headline
- will be indented when this variable is set.
+- TAB indents a line relative to current level. The lines below
+ a headline will be indented when this variable is set.
-Note that this is all about true indentation, by adding and removing
-space characters. See also `org-indent.el' which does level-dependent
-indentation in a virtual way, i.e. at display time in Emacs."
+Note that this is all about true indentation, by adding and
+removing space characters. See also `org-indent.el' which does
+level-dependent indentation in a virtual way, i.e. at display
+time in Emacs."
:group 'org-edit-structure
:type 'boolean)
@@ -1419,8 +1646,7 @@ the list structure."
(defcustom org-enable-fixed-width-editor t
"Non-nil means lines starting with \":\" are treated as fixed-width.
This currently only means they are never auto-wrapped.
-When nil, such lines will be treated like ordinary lines.
-See also the QUOTE keyword."
+When nil, such lines will be treated like ordinary lines."
:group 'org-edit-structure
:type 'boolean)
@@ -1452,9 +1678,9 @@ changed by an edit command."
(defcustom org-remove-highlights-with-change t
"Non-nil means any change to the buffer will remove temporary highlights.
Such highlights are created by `org-occur' and `org-clock-display'.
-When nil, `C-c C-c needs to be used to get rid of the highlights.
-The highlights created by `org-preview-latex-fragment' always need
-`C-c C-c' to be removed."
+When nil, `C-c C-c' needs to be used to get rid of the highlights.
+The highlights created by `org-toggle-latex-fragment' always need
+`C-c C-x C-l' to be removed."
:group 'org-sparse-trees
:group 'org-time
:type 'boolean)
@@ -1575,7 +1801,7 @@ See the manual for examples."
"Non-nil means Org will display descriptive links.
E.g. [[http://orgmode.org][Org website]] will be displayed as
\"Org Website\", hiding the link itself and just displaying its
-description. When set to `nil', Org will display the full links
+description. When set to nil, Org will display the full links
literally.
You can interactively set the value of this variable by calling
@@ -1600,11 +1826,18 @@ adaptive Use relative path for files in the current directory and sub-
(const noabbrev)
(const adaptive)))
-(defcustom org-activate-links '(bracket angle plain radio tag date footnote)
- "Types of links that should be activated in Org-mode files.
-This is a list of symbols, each leading to the activation of a certain link
-type. In principle, it does not hurt to turn on most link types - there may
-be a small gain when turning off unused link types. The types are:
+(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.
+
+This is a list of symbols, each one of them leading to the
+highlighting of a certain link type.
+
+You can still open links that are not highlighted.
+
+In principle, it does not hurt to turn on highlighting for all
+link types. There may be a small gain when turning off unused
+link types. The types are:
bracket The recommended [[link][description]] or [[link]] links with hiding.
angle Links in angular brackets that may contain whitespace like
@@ -1615,8 +1848,10 @@ tag Tag settings in a headline (link to tag search).
date Time stamps (link to calendar).
footnote Footnote labels.
-Changing this variable requires a restart of Emacs to become effective."
+If you set this variable during an Emacs session, use `org-mode-restart'
+in the Org buffer so that the change takes effect."
:group 'org-link
+ :group 'org-appearance
:type '(set :greedy t
(const :tag "Double bracket links" bracket)
(const :tag "Angular bracket links" angle)
@@ -1857,19 +2092,6 @@ window on that directory."
:group 'org-link-follow
:type 'boolean)
-(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s")
- "Function and arguments to call for following mailto links.
-This is a list with the first element being a Lisp function, and the
-remaining elements being arguments to the function. In string arguments,
-%a will be replaced by the address, and %s will be replaced by the subject
-if one was given like in <mailto:arthur@galaxy.org::this subject>."
- :group 'org-link-follow
- :type '(choice
- (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s"))
- (const :tag "compose-mail" (compose-mail "%a" "%s"))
- (const :tag "message-mail" (message-mail "%a" "%s"))
- (cons :tag "other" (function) (repeat :tag "argument" sexp))))
-
(defcustom org-confirm-shell-link-function 'yes-or-no-p
"Non-nil means ask for confirmation before executing shell links.
Shell links can be dangerous: just think about a link
@@ -1888,7 +2110,7 @@ single keystroke rather than having to type \"yes\"."
(const :tag "no confirmation (dangerous)" nil)))
(put 'org-confirm-shell-link-function
'safe-local-variable
- #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+ (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
(defcustom org-confirm-shell-link-not-regexp ""
"A regexp to skip confirmation for shell links."
@@ -1914,7 +2136,7 @@ single keystroke rather than having to type \"yes\"."
(const :tag "no confirmation (dangerous)" nil)))
(put 'org-confirm-shell-link-function
'safe-local-variable
- #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+ (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
(defcustom org-confirm-elisp-link-not-regexp ""
"A regexp to skip confirmation for Elisp links."
@@ -2086,9 +2308,7 @@ Used as a fall back file for org-capture.el, for templates that
do not specify a target file."
:group 'org-refile
:group 'org-capture
- :type '(choice
- (const :tag "Default from remember-data-file" nil)
- file))
+ :type 'file)
(defcustom org-goto-interface 'outline
"The default interface to be used for `org-goto'.
@@ -2245,7 +2465,7 @@ When `full-file-path', include the full file path."
"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 is a single go, or if can be done in steps down
+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
@@ -2353,9 +2573,9 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
(lambda (widget)
(widget-put widget
:args (mapcar
- #'(lambda (x)
- (widget-convert
- (cons 'const x)))
+ (lambda (x)
+ (widget-convert
+ (cons 'const x)))
org-todo-interpretation-widgets))
widget))
(repeat
@@ -2366,7 +2586,6 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
(make-variable-buffer-local 'org-todo-keywords-1)
(defvar org-todo-keywords-for-agenda nil)
(defvar org-done-keywords-for-agenda nil)
-(defvar org-drawers-for-agenda nil)
(defvar org-todo-keyword-alist-for-agenda nil)
(defvar org-tag-alist-for-agenda nil
"Alist of all tags from all agenda files.")
@@ -2433,6 +2652,9 @@ ALL-HEADLINES means update todo statistics by including headlines
with no TODO keyword as well, counting them as not done.
A list of TODO keywords means the same, but skip keywords that are
not in this list.
+When set to a list of two lists, the first list contains keywords
+to consider as TODO keywords, the second list contains keywords
+to consider as DONE keywords.
When this is set, todo statistics is updated in the parent of the
current entry each time a todo state is changed."
@@ -2442,6 +2664,9 @@ current entry each time a todo state is changed."
(const :tag "Yes, including all entries" all-headlines)
(repeat :tag "Yes, for TODOs in this list"
(string :tag "TODO keyword"))
+ (list :tag "Yes, for TODOs and DONEs in these lists"
+ (repeat (string :tag "TODO keyword"))
+ (repeat (string :tag "DONE keyword")))
(other :tag "No TODO statistics" nil)))
(defcustom org-hierarchical-todo-statistics t
@@ -2664,20 +2889,23 @@ When nil, only the date will be recorded."
(refile . "Refiled on %t")
(clock-out . ""))
"Headings for notes added to entries.
-The value is an alist, with the car being a symbol indicating the note
-context, and the cdr is the heading to be used. The heading may also be the
-empty string.
-%t in the heading will be replaced by a time stamp.
-%T will be an active time stamp instead the default inactive one
-%d will be replaced by a short-format time stamp.
-%D will be replaced by an active short-format time stamp.
-%s will be replaced by the new TODO state, in double quotes.
-%S will be replaced by the old TODO state, in double quotes.
-%u will be replaced by the user name.
-%U will be replaced by the full user name.
-
-In fact, it is not a good idea to change the `state' entry, because
-agenda log mode depends on the format of these entries."
+
+The value is an alist, with the car being a symbol indicating the
+note context, and the cdr is the heading to be used. The heading
+may also be the empty string. The following placeholders can be
+used:
+
+ %t a time stamp.
+ %T an active time stamp instead the default inactive one
+ %d a short-format time stamp.
+ %D an active short-format time stamp.
+ %s the new TODO state or time stamp (inactive), in double quotes.
+ %S the old TODO state or time stamp (inactive), in double quotes.
+ %u the user name.
+ %U full user name.
+
+In fact, it is not a good idea to change the `state' entry,
+because Agenda Log mode depends on the format of these entries."
:group 'org-todo
:group 'org-progress
:type '(list :greedy t
@@ -2716,7 +2944,10 @@ If this variable is set, `org-log-state-notes-insert-after-drawers'
will be ignored.
You can set the property LOG_INTO_DRAWER to overrule this setting for
-a subtree."
+a subtree.
+
+Do not check directly this variable in a Lisp program. Call
+function `org-log-into-drawer' instead."
:group 'org-todo
:group 'org-progress
:type '(choice
@@ -2727,15 +2958,17 @@ a subtree."
(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
(defun org-log-into-drawer ()
- "Return the value of `org-log-into-drawer', but let properties overrule.
-If the current entry has or inherits a LOG_INTO_DRAWER property, it will be
-used instead of the default value."
+ "Name of the log drawer, as a string, or nil.
+This is the value of `org-log-into-drawer'. However, if the
+current entry has or inherits a LOG_INTO_DRAWER property, it will
+be used instead of the default value."
(let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t)))
- (cond
- ((not p) org-log-into-drawer)
- ((equal p "nil") nil)
- ((equal p "t") "LOGBOOK")
- (t p))))
+ (cond ((equal p "nil") nil)
+ ((equal p "t") "LOGBOOK")
+ ((stringp p) p)
+ (p "LOGBOOK")
+ ((stringp org-log-into-drawer) org-log-into-drawer)
+ (org-log-into-drawer "LOGBOOK"))))
(defcustom org-log-state-notes-insert-after-drawers nil
"Non-nil means insert state change notes after any drawers in entry.
@@ -2863,18 +3096,6 @@ as an argument and return the numeric priority."
:tag "Org Time"
:group 'org)
-(defcustom org-insert-labeled-timestamps-at-point nil
- "Non-nil means SCHEDULED and DEADLINE timestamps are inserted at point.
-When nil, these labeled time stamps are forces into the second line of an
-entry, just after the headline. When scheduling from the global TODO list,
-the time stamp will always be forced into the second line."
- :group 'org-time
- :type 'boolean)
-
-(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
- "Formats for `format-time-string' which are used for time stamps.
-It is not recommended to change this constant.")
-
(defcustom org-time-stamp-rounding-minutes '(0 5)
"Number of minutes to round time stamps to.
These are two values, the first applies when first creating a time stamp.
@@ -2890,10 +3111,10 @@ a double prefix argument to a time stamp command like `C-c .' or `C-c !',
and by using a prefix arg to `S-up/down' to specify the exact number
of minutes to shift."
:group 'org-time
- :get #'(lambda (var) ; Make sure both elements are there
- (if (integerp (default-value var))
- (list (default-value var) 5)
- (default-value var)))
+ :get (lambda (var) ; Make sure both elements are there
+ (if (integerp (default-value var))
+ (list (default-value var) 5)
+ (default-value var)))
:type '(list
(integer :tag "when inserting times")
(integer :tag "when modifying times")))
@@ -3049,9 +3270,9 @@ is used."
:group 'org-time
:type '(choice (string :tag "Format string")
(set (group :inline t (const :tag "Years" :years)
- (string :tag "Format string"))
+ (string :tag "Format string"))
(group :inline t (const :tag "Months" :months)
- (string :tag "Format string"))
+ (string :tag "Format string"))
(group :inline t (const :tag "Weeks" :weeks)
(string :tag "Format string"))
(group :inline t (const :tag "Days" :days)
@@ -3257,11 +3478,17 @@ See the manual for details."
(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 "New line" (:newline)))))
(defcustom org-tag-persistent-alist nil
@@ -3542,13 +3769,6 @@ or nil if the normal value should be used."
:group 'org-properties
:type '(choice (const nil) (function)))
-(defcustom org-effort-property "Effort"
- "The property that is being used to keep track of effort estimates.
-Effort estimates given in this property need to have the format H:MM."
- :group 'org-properties
- :group 'org-progress
- :type '(string :tag "Property"))
-
(defconst org-global-properties-fixed
'(("VISIBILITY_ALL" . "folded children content all")
("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
@@ -3603,7 +3823,7 @@ 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))))
+(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.
@@ -3752,12 +3972,17 @@ Replace format-specifiers in the command as noted below and use
`shell-command' to convert LaTeX to MathML.
%j: Executable file in fully expanded form as specified by
`org-latex-to-mathml-jar-file'.
-%I: Input LaTeX file in fully expanded form
-%o: Output MathML file
+%I: Input LaTeX file in fully expanded form.
+%i: The latex fragment to be converted.
+%o: Output MathML file.
+
This command is used by `org-create-math-formula'.
-When using MathToWeb as the converter, set this to
-\"java -jar %j -unicode -force -df %o %I\"."
+When using MathToWeb as the converter, set this option to
+\"java -jar %j -unicode -force -df %o %I\".
+
+When using LaTeXML set this option to
+\"latexmlmath \"%i\" --presentationmathml=%o\"."
:group 'org-latex
:version "24.1"
:type '(choice
@@ -3848,18 +4073,16 @@ header, or they will be appended."
("T1" "fontenc" t)
("" "fixltx2e" nil)
("" "graphicx" t)
+ ("" "grffile" t)
("" "longtable" nil)
- ("" "float" nil)
("" "wrapfig" nil)
("" "rotating" nil)
("normalem" "ulem" t)
("" "amsmath" t)
("" "textcomp" t)
- ("" "marvosym" t)
- ("" "wasysym" t)
("" "amssymb" t)
- ("" "hyperref" nil)
- "\\tolerance=1000")
+ ("" "capt-of" nil)
+ ("" "hyperref" nil))
"Alist of default packages to be inserted in the header.
Change this only if one of the packages here causes an
@@ -3871,14 +4094,16 @@ 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
-- float, wrapfig: for figure placement
+- wrapfig: for figure placement
- rotating: for sideways figures and tables
- ulem: for underline and strike-through
- amsmath: for subscript and superscript and math environments
-- textcomp, marvosymb, wasysym, amssymb: for various symbols used
+- textcomp, amssymb: for various symbols used
for interpreting the entities in `org-entities'. You can skip
some of these packages if you don't use any of their symbols.
+- capt-of: for captions outside of floats
- hyperref: for cross references
Therefore you should not modify this variable unless you know
@@ -3887,9 +4112,9 @@ you might be loading some other package that conflicts with one
of the default packages. Each element is either a cell or
a string.
-A cell is of the format:
+A cell is of the format
- \( \"options\" \"package\" SNIPPET-FLAG).
+ \(\"options\" \"package\" SNIPPET-FLAG)
If SNIPPET-FLAG is non-nil, the package also needs to be included
when compiling LaTeX snippets into images for inclusion into
@@ -3900,7 +4125,8 @@ A string will be inserted as-is in the header of the document."
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
- :version "24.1"
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type '(repeat
(choice
(list :tag "options/package pair"
@@ -4035,6 +4261,11 @@ following symbols:
:group 'org-appearance
:type 'boolean)
+(defcustom org-hide-macro-markers nil
+ "Non-nil mean font-lock should hide the brackets marking macro calls."
+ :group 'org-appearance
+ :type 'boolean)
+
(defcustom org-pretty-entities nil
"Non-nil means show entities as UTF8 characters.
When nil, the \\name form remains in the buffer."
@@ -4121,7 +4352,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
@@ -4213,7 +4444,7 @@ Normal means, no org-mode-specific context."
(defvar mark-active)
;; Various packages
-(declare-function calendar-absolute-from-iso "cal-iso" (date))
+(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" ())
@@ -4255,30 +4486,7 @@ Normal means, no org-mode-specific context."
(defvar texmathp-why)
(declare-function speedbar-line-directory "speedbar" (&optional depth))
(declare-function table--at-cell-p "table" (position &optional object at-column))
-
-(defvar org-latex-regexps)
-
-;;; Autoload and prepare some org modules
-
-;; Some table stuff that needs to be defined here, because it is used
-;; by the functions setting up org-mode or checking for table context.
-
-(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
- "Detect an org-type or table-type table.")
-(defconst org-table-line-regexp "^[ \t]*|"
- "Detect an org-type table line.")
-(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
- "Detect an org-type table line.")
-(defconst org-table-hline-regexp "^[ \t]*|-"
- "Detect an org-type table hline.")
-(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
- "Detect a table-type table hline.")
-(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
- "Detect the first line outside a table when searching from within it.
-This works for both table types.")
-
-(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
- "Detect a #+TBLFM line.")
+(declare-function calc-eval "calc" (str &optional separator &rest args))
;;;###autoload
(defun turn-on-orgtbl ()
@@ -4287,56 +4495,51 @@ This works for both table types.")
(orgtbl-mode 1))
(defun org-at-table-p (&optional table-type)
- "Return t if the cursor is inside an org-type table.
-If TABLE-TYPE is non-nil, also check for table.el-type tables."
- (if org-enable-table-editor
- (save-excursion
- (beginning-of-line 1)
- (looking-at (if table-type org-table-any-line-regexp
- org-table-line-regexp)))
- nil))
+ "Non-nil if the cursor is inside an Org table.
+If TABLE-TYPE is non-nil, also check for table.el-type tables.
+If `org-enable-table-editor' is nil, return nil unconditionally."
+ (and org-enable-table-editor
+ (save-excursion
+ (beginning-of-line)
+ (org-looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|")))
+ (let ((element (org-element-lineage (org-element-at-point) '(table) t)))
+ (and element
+ (or table-type (eq (org-element-property :type element) 'org))))))
(defsubst org-table-p () (org-at-table-p))
(defun org-at-table.el-p ()
- "Return t if and only if we are at a table.el table."
- (and (org-at-table-p 'any)
- (save-excursion
- (goto-char (org-table-begin 'any))
- (looking-at org-table1-hline-regexp))))
+ "Non-nil when point is at a table.el table."
+ (and (save-excursion (beginning-of-line) (looking-at "[ \t]*[|+]"))
+ (let ((element (org-element-at-point)))
+ (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."
- (if org-table-tab-recognizes-table.el
- (if (org-at-table.el-p)
- (progn
- (beginning-of-line 1)
- (if (looking-at org-table-dataline-regexp)
- nil
- (if (looking-at org-table1-hline-regexp)
- (progn
- (beginning-of-line 2)
- (if (looking-at org-table-any-border-regexp)
- (beginning-of-line -1)))))
- (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"))
- t)
- nil)
- nil))
+ (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 ()
- "Return t if the cursor is inside a hline in a table."
- (if org-enable-table-editor
- (save-excursion
- (beginning-of-line 1)
- (looking-at org-table-hline-regexp))
- nil))
+ "Non-nil when point is inside a hline in a table.
+Assume point is already in a table. If `org-enable-table-editor'
+is nil, return nil unconditionally."
+ (and org-enable-table-editor
+ (save-excursion
+ (beginning-of-line)
+ (looking-at org-table-hline-regexp))))
(defun org-table-map-tables (function &optional quietly)
"Apply FUNCTION to the start of all tables in the buffer."
@@ -4346,7 +4549,8 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(goto-char (point-min))
(while (re-search-forward org-table-any-line-regexp nil t)
(unless quietly
- (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))))
+ (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
@@ -4363,12 +4567,12 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(&optional also-non-dangling-p prompt last-valid))
(defun org-at-TBLFM-p (&optional pos)
- "Return t when point (or POS) is in #+TBLFM line."
+ "Non-nil when point (or POS) is in #+TBLFM line."
(save-excursion
- (let ((pos pos)))
(goto-char (or pos (point)))
- (beginning-of-line 1)
- (looking-at org-TBLFM-regexp)))
+ (beginning-of-line)
+ (and (let ((case-fold-search t)) (looking-at org-TBLFM-regexp))
+ (eq (org-element-type (org-element-at-point)) 'table))))
(defvar org-clock-start-time)
(defvar org-clock-marker (make-marker)
@@ -4468,16 +4672,6 @@ the hierarchy, it will be used."
:group 'org-archive
:type 'string)
-(defcustom org-archive-tag "ARCHIVE"
- "The tag that marks a subtree as archived.
-An archived subtree does not open during visibility cycling, and does
-not contribute to the agenda listings.
-After changing this, font-lock must be restarted in the relevant buffers to
-get the proper fontification."
- :group 'org-archive
- :group 'org-keywords
- :type 'string)
-
(defcustom org-agenda-skip-archived-trees t
"Non-nil means the agenda will skip any items located in archived trees.
An archived tree is a tree marked with the tag ARCHIVE. The use of this
@@ -4510,24 +4704,25 @@ collapsed state."
:group 'org-sparse-trees
:type 'boolean)
-(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline
+(defcustom org-sparse-tree-default-date-type nil
"The default date type when building a sparse tree.
When this is nil, a date is a scheduled or a deadline timestamp.
Otherwise, these types are allowed:
all: all timestamps
active: only active timestamps (<...>)
- inactive: only inactive timestamps (<...)
+ inactive: only inactive timestamps ([...])
scheduled: only scheduled timestamps
deadline: only deadline timestamps"
- :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline)
+ :type '(choice (const :tag "Scheduled or deadline" nil)
(const :tag "All timestamps" all)
(const :tag "Only active timestamps" active)
(const :tag "Only inactive timestamps" inactive)
(const :tag "Only scheduled timestamps" scheduled)
(const :tag "Only deadline timestamps" deadline)
(const :tag "Only closed timestamps" closed))
- :version "24.3"
+ :version "25.1"
+ :package-version '(Org . "8.3")
:group 'org-sparse-trees)
(defun org-cycle-hide-archived-subtrees (state)
@@ -4553,13 +4748,14 @@ Otherwise, these types are allowed:
(defun org-hide-archived-subtrees (beg end)
"Re-hide all archived subtrees after a visibility state change."
- (save-excursion
- (let* ((re (concat ":" org-archive-tag ":")))
- (goto-char beg)
- (while (re-search-forward re end t)
- (when (org-at-heading-p)
- (org-flag-subtree t)
- (org-end-of-subtree t))))))
+ (org-with-wide-buffer
+ (let ((case-fold-search nil)
+ (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
+ (goto-char beg)
+ (while (and (< (point) end) (re-search-forward re end t))
+ (when (member org-archive-tag (org-get-tags))
+ (org-flag-subtree t)
+ (org-end-of-subtree t))))))
(declare-function outline-end-of-heading "outline" ())
(declare-function outline-flag-region "outline" (from to flag))
@@ -4588,9 +4784,6 @@ Otherwise, these types are allowed:
;;; Variables for pre-computed regular expressions, all buffer local
-(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$"
- "Matches first line of a hidden block.")
-(make-variable-buffer-local 'org-drawer-regexp)
(defvar org-todo-regexp nil
"Matches any of the TODO state keywords.")
(make-variable-buffer-local 'org-todo-regexp)
@@ -4599,7 +4792,7 @@ Otherwise, these types are allowed:
(make-variable-buffer-local 'org-not-done-regexp)
(defvar org-not-done-heading-regexp nil
"Matches a TODO headline that is not done.")
-(make-variable-buffer-local 'org-not-done-regexp)
+(make-variable-buffer-local 'org-not-done-heading-regexp)
(defvar 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)
@@ -4621,46 +4814,6 @@ TODO state, priority and tags.")
"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)
-(defvar org-ds-keyword-length 12
- "Maximum length of the DEADLINE and SCHEDULED keywords.")
-(make-variable-buffer-local 'org-ds-keyword-length)
-(defvar org-deadline-regexp nil
- "Matches the DEADLINE keyword.")
-(make-variable-buffer-local 'org-deadline-regexp)
-(defvar org-deadline-time-regexp nil
- "Matches the DEADLINE keyword together with a time stamp.")
-(make-variable-buffer-local 'org-deadline-time-regexp)
-(defvar org-deadline-time-hour-regexp nil
- "Matches the DEADLINE keyword together with a time-and-hour stamp.")
-(make-variable-buffer-local 'org-deadline-time-hour-regexp)
-(defvar org-deadline-line-regexp nil
- "Matches the DEADLINE keyword and the rest of the line.")
-(make-variable-buffer-local 'org-deadline-line-regexp)
-(defvar org-scheduled-regexp nil
- "Matches the SCHEDULED keyword.")
-(make-variable-buffer-local 'org-scheduled-regexp)
-(defvar org-scheduled-time-regexp nil
- "Matches the SCHEDULED keyword together with a time stamp.")
-(make-variable-buffer-local 'org-scheduled-time-regexp)
-(defvar org-scheduled-time-hour-regexp nil
- "Matches the SCHEDULED keyword together with a time-and-hour stamp.")
-(make-variable-buffer-local 'org-scheduled-time-hour-regexp)
-(defvar org-closed-time-regexp nil
- "Matches the CLOSED keyword together with a time stamp.")
-(make-variable-buffer-local 'org-closed-time-regexp)
-
-(defvar org-keyword-time-regexp nil
- "Matches any of the 4 keywords, together with the time stamp.")
-(make-variable-buffer-local 'org-keyword-time-regexp)
-(defvar org-keyword-time-not-clock-regexp nil
- "Matches any of the 3 keywords, together with the time stamp.")
-(make-variable-buffer-local 'org-keyword-time-not-clock-regexp)
-(defvar org-maybe-keyword-time-regexp nil
- "Matches a timestamp, possibly preceded by a keyword.")
-(make-variable-buffer-local 'org-maybe-keyword-time-regexp)
-(defvar org-all-time-keywords nil
- "List of time keywords.")
-(make-variable-buffer-local 'org-all-time-keywords)
(defconst org-plain-time-of-day-regexp
(concat
@@ -4766,32 +4919,6 @@ in the #+STARTUP line), the corresponding variable, and the value to set
this variable to if the option is found. An optional forth element PUSH
means to push this value onto the list in the variable.")
-(defun org-update-property-plist (key val props)
- "Update PROPS with KEY and VAL."
- (let* ((appending (string= "+" (substring key (- (length key) 1))))
- (key (if appending (substring key 0 (- (length key) 1)) key))
- (remainder (org-remove-if (lambda (p) (string= (car p) key)) props))
- (previous (cdr (assoc key props))))
- (if appending
- (cons (cons key (if previous (concat previous " " val) val)) remainder)
- (cons (cons key val) remainder))))
-
-(defconst org-block-regexp
- "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
- "Regular expression for hiding blocks.")
-(defconst org-heading-keyword-regexp-format
- "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching a headline with some keyword.
-This regexp will match the headline of any node which has the
-exact keyword that is put into the format. The keyword isn't in
-any group by default, but the stars and the body are.")
-(defconst org-heading-keyword-maybe-regexp-format
- "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching a headline, possibly with some keyword.
-This regexp can match any headline with the specified keyword, or
-without a keyword. The keyword isn't in any group by default,
-but the stars and the body are.")
-
(defcustom org-group-tags t
"When non-nil (the default), use group tags.
This can be turned on/off through `org-toggle-tags-groups'."
@@ -4815,374 +4942,337 @@ Support for group tags is controlled by the option
(message "Groups tags support has been turned %s"
(if org-group-tags "on" "off")))
-(defun org-set-regexps-and-options-for-tags ()
- "Precompute variables used for tags."
- (when (derived-mode-p 'org-mode)
- (org-set-local 'org-file-tags nil)
- (let ((re (org-make-options-regexp '("FILETAGS" "TAGS")))
- (splitre "[ \t]+")
- (start 0)
- tags ftags key value)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (setq key (upcase (org-match-string-no-properties 1))
- value (org-match-string-no-properties 2))
- (if (stringp value) (setq value (org-trim value)))
- (cond
- ((equal key "TAGS")
- (setq tags (append tags (if tags '("\\n") nil)
- (org-split-string value splitre))))
- ((equal key "FILETAGS")
- (when (string-match "\\S-" value)
- (setq ftags
- (append
- ftags
- (apply 'append
- (mapcar (lambda (x) (org-split-string x ":"))
- (org-split-string value)))))))))))
- ;; Process the file tags.
- (and ftags (org-set-local 'org-file-tags
- (mapcar 'org-add-prop-inherited ftags)))
- (org-set-local 'org-tag-groups-alist nil)
- ;; Process the tags.
- (when (and (not tags) org-tag-alist)
- (setq tags
- (mapcar
- (lambda (tg) (cond ((eq (car tg) :startgroup) "{")
- ((eq (car tg) :endgroup) "}")
- ((eq (car tg) :grouptags) ":")
- ((eq (car tg) :newline) "\n")
- (t (concat (car tg)
- (if (characterp (cdr tg))
- (format "(%s)" (char-to-string (cdr tg))) "")))))
- org-tag-alist)))
- (let (e tgs g)
- (while (setq e (pop tags))
- (cond
- ((equal e "{")
- (progn (push '(:startgroup) tgs)
- (when (equal (nth 1 tags) ":")
- (push (list (replace-regexp-in-string
- "(.+)$" "" (nth 0 tags)))
- org-tag-groups-alist)
- (setq g 0))))
- ((equal e ":") (push '(:grouptags) tgs))
- ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil)))
- ((equal e "\\n") (push '(:newline) tgs))
- ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e)
- (push (cons (match-string 1 e)
- (string-to-char (match-string 2 e))) tgs)
- (if (and g (> g 0))
- (setcar org-tag-groups-alist
- (append (car org-tag-groups-alist)
- (list (match-string 1 e)))))
- (if g (setq g (1+ g))))
- (t (push (list e) tgs)
- (if (and g (> g 0))
- (setcar org-tag-groups-alist
- (append (car org-tag-groups-alist) (list e))))
- (if g (setq g (1+ g))))))
- (org-set-local 'org-tag-alist nil)
- (while (setq e (pop tgs))
- (or (and (stringp (car e))
- (assoc (car e) org-tag-alist))
- (push e org-tag-alist)))
- ;; Return a list with tag variables
- (list org-file-tags org-tag-alist org-tag-groups-alist)))))
-
-(defvar org-ota nil)
-(defun org-set-regexps-and-options ()
- "Precompute regular expressions used in the current buffer."
+(defun org-set-regexps-and-options (&optional tags-only)
+ "Precompute regular expressions used in the current buffer.
+When optional argument TAGS-ONLY is non-nil, only compute tags
+related expressions."
(when (derived-mode-p 'org-mode)
- (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)
- (org-set-local 'org-file-properties nil)
- (let ((re (org-make-options-regexp
- '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE"
- "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS"
- "SETUPFILE" "OPTIONS")
- "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)"))
- (splitre "[ \t]+")
- (scripts org-use-sub-superscripts)
- kwds kws0 kwsa key log value cat arch const links hw dws
- tail sep kws1 prio props drawers ext-setup-or-nil setup-contents
- (start 0))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while
- (or (and
- ext-setup-or-nil
- (not org-ota)
- (let (ret)
- (with-temp-buffer
- (insert ext-setup-or-nil)
- (let ((major-mode 'org-mode) org-ota)
- (setq ret (save-match-data
- (org-set-regexps-and-options-for-tags)))))
- ;; Append setupfile tags to existing tags
- (setq org-ota t)
- (setq org-file-tags
- (delq nil (append org-file-tags (nth 0 ret)))
- org-tag-alist
- (delq nil (append org-tag-alist (nth 1 ret)))
- org-tag-groups-alist
- (delq nil (append org-tag-groups-alist (nth 2 ret))))))
- (and ext-setup-or-nil
- (string-match re ext-setup-or-nil start)
- (setq start (match-end 0)))
- (and (setq ext-setup-or-nil nil start 0)
- (re-search-forward re nil t)))
- (setq key (upcase (match-string 1 ext-setup-or-nil))
- value (org-match-string-no-properties 2 ext-setup-or-nil))
- (if (stringp value) (setq value (org-trim value)))
- (cond
- ((equal key "CATEGORY")
- (setq cat value))
- ((member key '("SEQ_TODO" "TODO"))
- (push (cons 'sequence (org-split-string value splitre)) kwds))
- ((equal key "TYP_TODO")
- (push (cons 'type (org-split-string value splitre)) kwds))
- ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key)
- ;; general TODO-like setup
- (push (cons (intern (downcase (match-string 1 key)))
- (org-split-string value splitre)) kwds))
- ((equal key "COLUMNS")
- (org-set-local 'org-columns-default-format value))
- ((equal key "LINK")
- (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value)
- (push (cons (match-string 1 value)
- (org-trim (match-string 2 value)))
- links)))
- ((equal key "PRIORITIES")
- (setq prio (org-split-string value " +")))
- ((equal key "PROPERTY")
- (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
- (setq props (org-update-property-plist (match-string 1 value)
- (match-string 2 value)
- props))))
- ((equal key "DRAWERS")
- (setq drawers (delete-dups (append org-drawers (org-split-string value splitre)))))
- ((equal key "CONSTANTS")
- (org-table-set-constants))
- ((equal key "STARTUP")
- (let ((opts (org-split-string value splitre))
- l var val)
- (while (setq l (pop opts))
- (when (setq l (assoc l org-startup-options))
- (setq var (nth 1 l) val (nth 2 l))
- (if (not (nth 3 l))
- (set (make-local-variable var) val)
- (if (not (listp (symbol-value var)))
- (set (make-local-variable var) nil))
- (set (make-local-variable var) (symbol-value var))
- (add-to-list var val))))))
- ((equal key "ARCHIVE")
- (setq arch value)
- (remove-text-properties 0 (length arch)
- '(face t fontified t) arch))
- ((equal key "OPTIONS")
- (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value)
- (setq scripts (read (match-string 2 value)))))
- ((and (equal key "SETUPFILE")
- ;; Prevent checking in Gnus messages
- (not buffer-read-only))
- (setq setup-contents (org-file-contents
- (expand-file-name
- (org-remove-double-quotes value))
- 'noerror))
- (if (not ext-setup-or-nil)
- (setq ext-setup-or-nil setup-contents start 0)
- (setq ext-setup-or-nil
- (concat (substring ext-setup-or-nil 0 start)
- "\n" setup-contents "\n"
- (substring ext-setup-or-nil start)))))))
- ;; search for property blocks
- (goto-char (point-min))
- (while (re-search-forward org-block-regexp nil t)
- (when (equal "PROPERTY" (upcase (match-string 1)))
- (setq value (replace-regexp-in-string
- "[\n\r]" " " (match-string 4)))
- (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
- (setq props (org-update-property-plist (match-string 1 value)
- (match-string 2 value)
- props)))))))
- (org-set-local 'org-use-sub-superscripts scripts)
- (when cat
- (org-set-local 'org-category (intern cat))
- (push (cons "CATEGORY" cat) props))
- (when prio
- (if (< (length prio) 3) (setq prio '("A" "C" "B")))
- (setq prio (mapcar 'string-to-char prio))
- (org-set-local 'org-highest-priority (nth 0 prio))
- (org-set-local 'org-lowest-priority (nth 1 prio))
- (org-set-local 'org-default-priority (nth 2 prio)))
- (and props (org-set-local 'org-file-properties (nreverse props)))
- (and drawers (org-set-local 'org-drawers drawers))
- (and arch (org-set-local 'org-archive-location arch))
- (and links (setq org-link-abbrev-alist-local (nreverse links)))
- ;; Process the TODO keywords
- (unless kwds
- ;; Use the global values as if they had been given locally.
- (setq kwds (default-value 'org-todo-keywords))
- (if (stringp (car kwds))
- (setq kwds (list (cons org-todo-interpretation
- (default-value 'org-todo-keywords)))))
- (setq kwds (reverse kwds)))
- (setq kwds (nreverse kwds))
- (let (inter kws kw)
- (while (setq kws (pop kwds))
- (let ((kws (or
- (run-hook-with-args-until-success
- 'org-todo-setup-filter-hook kws)
- kws)))
- (setq inter (pop kws) sep (member "|" kws)
- kws0 (delete "|" (copy-sequence kws))
- kwsa nil
- kws1 (mapcar
- (lambda (x)
- ;; 1 2
- (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
- (progn
- (setq kw (match-string 1 x)
- key (and (match-end 2) (match-string 2 x))
- log (org-extract-log-state-settings x))
- (push (cons kw (and key (string-to-char key))) kwsa)
- (and log (push log org-todo-log-states))
- kw)
- (error "Invalid TODO keyword %s" x)))
- kws0)
- kwsa (if kwsa (append '((:startgroup))
- (nreverse kwsa)
- '((:endgroup))))
- hw (car kws1)
- dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
- tail (list inter hw (car dws) (org-last dws))))
- (add-to-list 'org-todo-heads hw 'append)
- (push kws1 org-todo-sets)
- (setq org-done-keywords (append org-done-keywords dws nil))
- (setq org-todo-key-alist (append org-todo-key-alist kwsa))
- (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1)
- (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil)))
+ (let ((alist (org--setup-collect-keywords
+ (org-make-options-regexp
+ (append '("FILETAGS" "TAGS" "SETUPFILE")
+ (and (not tags-only)
+ '("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)))
+ (unless tags-only
+ ;; File properties.
+ (org-set-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)))
+ ;; 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))))
+ ;; Columns.
+ (let ((column (cdr (assq 'columns alist))))
+ (when column (org-set-local 'org-columns-default-format column)))
+ ;; Constants.
+ (setq org-table-formula-constants-local (cdr (assq 'constants alist)))
+ ;; Link abbreviations.
+ (let ((links (cdr (assq 'link alist))))
+ (when links (setq org-link-abbrev-alist-local (nreverse links))))
+ ;; 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))))
+ ;; 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)))))))
+ ;; 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)
+ (let ((todo-sequences
+ (or (nreverse (cdr (assq 'todo alist)))
+ (let ((d (default-value 'org-todo-keywords)))
+ (if (not (stringp (car d))) d
+ ;; XXX: Backward compatibility code.
+ (list (cons org-todo-interpretation d)))))))
+ (dolist (sequence todo-sequences)
+ (let* ((sequence (or (run-hook-with-args-until-success
+ 'org-todo-setup-filter-hook sequence)
+ sequence))
+ (sequence-type (car sequence))
+ (keywords (cdr sequence))
+ (sep (member "|" keywords))
+ names alist)
+ (dolist (k (remove "|" keywords))
+ (unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$"
+ k)
+ (error "Invalid TODO keyword %s" k))
+ (let ((name (match-string 1 k))
+ (key (match-string 2 k))
+ (log (org-extract-log-state-settings k)))
+ (push name names)
+ (push (cons name (and key (string-to-char key))) alist)
+ (when log (push log org-todo-log-states))))
+ (let* ((names (nreverse names))
+ (done (if sep (org-remove-keyword-keys (cdr sep))
+ (last names)))
+ (head (car names))
+ (tail (list sequence-type head (car done) (org-last done))))
+ (add-to-list 'org-todo-heads head 'append)
+ (push names org-todo-sets)
+ (setq org-done-keywords (append org-done-keywords done nil))
+ (setq org-todo-keywords-1 (append org-todo-keywords-1 names nil))
+ (setq org-todo-key-alist
+ (append org-todo-key-alist
+ (and alist
+ (append '((:startgroup))
+ (nreverse alist)
+ '((:endgroup))))))
+ (dolist (k names) (push (cons k tail) org-todo-kwd-alist))))))
(setq org-todo-sets (nreverse org-todo-sets)
org-todo-kwd-alist (nreverse org-todo-kwd-alist)
- org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist))
- org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)))
- ;; 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
- (list (org-last org-todo-keywords-1)))))
- (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string)
- (length org-scheduled-string)
- (length org-clock-string)
- (length org-closed-string)))
- org-drawer-regexp
- (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$")
- org-not-done-keywords
- (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1))
- org-todo-regexp
- (concat "\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- "\\)")
- org-not-done-regexp
- (concat "\\("
- (mapconcat 'regexp-quote org-not-done-keywords "\\|")
- "\\)")
- org-not-done-heading-regexp
- (format org-heading-keyword-regexp-format org-not-done-regexp)
- org-todo-line-regexp
- (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
- org-complex-heading-regexp
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(\\[#.\\]\\)\\)?"
- "\\(?: +\\(.*?\\)\\)??"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
- "[ \t]*$")
- org-complex-heading-regexp-format
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(\\[#.\\]\\)\\)?"
- "\\(?: +"
- ;; Stats cookies can be stuck to body.
- "\\(?:\\[[0-9%%/]+\\] *\\)*"
- "\\(%s\\)"
- "\\(?: *\\[[0-9%%/]+\\]\\)*"
- "\\)"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
- "[ \t]*$")
- org-todo-line-tags-regexp
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(.*?\\)\\)??"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
- "[ \t]*$")
- org-deadline-regexp (concat "\\<" org-deadline-string)
- org-deadline-time-regexp
- (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
- org-deadline-time-hour-regexp
- (concat "\\<" org-deadline-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
- org-deadline-line-regexp
- (concat "\\<\\(" org-deadline-string "\\).*")
- org-scheduled-regexp
- (concat "\\<" org-scheduled-string)
- org-scheduled-time-regexp
- (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
- org-scheduled-time-hour-regexp
- (concat "\\<" org-scheduled-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
- org-closed-time-regexp
- (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
- org-keyword-time-regexp
- (concat "\\<\\(" org-scheduled-string
- "\\|" org-deadline-string
- "\\|" org-closed-string
- "\\|" org-clock-string "\\)"
- " *[[<]\\([^]>]+\\)[]>]")
- org-keyword-time-not-clock-regexp
- (concat "\\<\\(" org-scheduled-string
- "\\|" org-deadline-string
- "\\|" org-closed-string
- "\\)"
- " *[[<]\\([^]>]+\\)[]>]")
- org-maybe-keyword-time-regexp
- (concat "\\(\\<\\(" org-scheduled-string
- "\\|" org-deadline-string
- "\\|" org-closed-string
- "\\|" org-clock-string "\\)\\)?"
- " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
- org-all-time-keywords
- (mapcar (lambda (w) (substring w 0 -1))
- (list org-scheduled-string org-deadline-string
- org-clock-string org-closed-string)))
- (setq org-ota nil)
- (org-compute-latex-and-related-regexp))))
+ org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist))
+ org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))
+ ;; 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))))
+ (setq org-not-done-keywords
+ (org-delete-all org-done-keywords
+ (copy-sequence org-todo-keywords-1))
+ org-todo-regexp (regexp-opt org-todo-keywords-1 t)
+ org-not-done-regexp (regexp-opt org-not-done-keywords t)
+ org-not-done-heading-regexp
+ (format org-heading-keyword-regexp-format org-not-done-regexp)
+ org-todo-line-regexp
+ (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
+ org-complex-heading-regexp
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
+ "[ \t]*$")
+ org-complex-heading-regexp-format
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +"
+ ;; Stats cookies can be stuck to body.
+ "\\(?:\\[[0-9%%/]+\\] *\\)*"
+ "\\(%s\\)"
+ "\\(?: *\\[[0-9%%/]+\\]\\)*"
+ "\\)"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
+ "[ \t]*$")
+ org-todo-line-tags-regexp
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
+ "[ \t]*$"))
+ (org-compute-latex-and-related-regexp)))))
+
+(defun org--setup-collect-keywords (regexp &optional files alist)
+ "Return setup keywords values as an alist.
+
+REGEXP matches a subset of setup keywords. FILES is a list of
+file names already visited. It is used to avoid circular setup
+files. ALIST, when non-nil, is the alist computed so far.
+
+Return value contains the following keys: `archive', `category',
+`columns', `constants', `filetags', `link', `priorities',
+`property', `scripts', `startup', `tags' and `todo'."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (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))
+ (value (org-element-property :value element)))
+ (cond
+ ((equal key "ARCHIVE")
+ (when (org-string-nw-p value)
+ (push (cons 'archive value) alist)))
+ ((equal key "CATEGORY") (push (cons 'category value) alist))
+ ((equal key "COLUMNS") (push (cons 'columns value) alist))
+ ((equal key "CONSTANTS")
+ (let* ((constants (assq 'constants alist))
+ (store (cdr constants)))
+ (dolist (pair (org-split-string value))
+ (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)"
+ pair)
+ (let* ((name (match-string 1 pair))
+ (value (match-string 2 pair))
+ (old (assoc name store)))
+ (if old (setcdr old value)
+ (push (cons name value) store)))))
+ (if constants (setcdr constants store)
+ (push (cons 'constants store) alist))))
+ ((equal key "FILETAGS")
+ (when (org-string-nw-p value)
+ (let ((old (assq 'filetags alist))
+ (new (apply #'nconc
+ (mapcar (lambda (x) (org-split-string x ":"))
+ (org-split-string value)))))
+ (if old (setcdr old (append new (cdr old)))
+ (push (cons 'filetags new) alist)))))
+ ((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))))
+ (if links (push pair (cdr links))
+ (push (list 'link pair) alist)))))
+ ((equal key "OPTIONS")
+ (when (and (org-string-nw-p value)
+ (string-match "\\^:\\(t\\|nil\\|{}\\)" value))
+ (push (cons 'scripts (read (match-string 1 value))) alist)))
+ ((equal key "PRIORITIES")
+ (push (cons 'priorities
+ (let ((prio (org-split-string value)))
+ (if (< (length prio) 3) '(?A ?C ?B)
+ (mapcar #'string-to-char prio))))
+ alist))
+ ((equal key "PROPERTY")
+ (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)
+ (cdr property))))
+ (if property (setcdr property value)
+ (push (cons 'property value) alist)))))
+ ((equal key "STARTUP")
+ (let ((startup (assq 'startup alist)))
+ (if startup
+ (setcdr startup
+ (append (cdr startup) (org-split-string value)))
+ (push (cons 'startup (org-split-string value)) alist))))
+ ((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))))
+ ((member key '("TODO" "SEQ_TODO" "TYP_TODO"))
+ (let ((todo (assq 'todo alist))
+ (value (cons (if (equal key "TYP_TODO") 'type 'sequence)
+ (org-split-string value))))
+ (if todo (push value (cdr todo))
+ (push (list 'todo value) alist))))
+ ((equal key "SETUPFILE")
+ (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)))))
+ (when (and f (file-readable-p f) (not (member f files)))
+ (with-temp-buffer
+ (insert-file-contents f)
+ (setq alist
+ ;; Fake Org mode to benefit from cache
+ ;; without recurring needlessly.
+ (let ((major-mode 'org-mode))
+ (org--setup-collect-keywords
+ 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-file-contents (file &optional noerror)
"Return the contents of FILE, as a string."
- (if (or (not file) (not (file-readable-p file)))
- (if (not noerror)
- (error "Cannot read file \"%s\"" file)
- (message "Cannot read file \"%s\"" file)
- "")
- (with-temp-buffer
- (insert-file-contents file)
- (buffer-string))))
+ (if (and file (file-readable-p file))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (buffer-string))
+ (funcall (if noerror 'message 'error)
+ "Cannot read file \"%s\"%s"
+ file
+ (let ((from (buffer-file-name (buffer-base-buffer))))
+ (if from (concat " (referenced in file \"" from "\")") "")))))
(defun org-extract-log-state-settings (x)
"Extract the log state setting from a TODO keyword string.
@@ -5279,6 +5369,7 @@ This variable is set by `org-before-change-function'.
(require 'time-date)
(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
(require 'easymenu)
+(autoload 'easy-menu-add "easymenu")
(require 'overlay)
;; (require 'org-macs) moved higher up in the file before it is first used
@@ -5349,10 +5440,9 @@ The following commands are available:
org-display-table 4
(vconcat (mapcar
(lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis))
- org-ellipsis)))
+ org-ellipsis)))
(if (stringp org-ellipsis) org-ellipsis "..."))))
(setq buffer-display-table org-display-table))
- (org-set-regexps-and-options-for-tags)
(org-set-regexps-and-options)
(org-set-font-lock-defaults)
(when (and org-tag-faces (not org-tags-special-faces-re))
@@ -5386,6 +5476,8 @@ The following commands are available:
(org-setup-filling)
;; Comments.
(org-setup-comments-handling)
+ ;; 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
@@ -5413,7 +5505,7 @@ The following commands are available:
(org-set-local
'align-mode-rules-list
'((org-in-buffer-settings
- (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
+ (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
(modes . '(org-mode)))))
;; Imenu
@@ -5455,9 +5547,10 @@ The following commands are available:
(when org-startup-with-inline-images
(org-display-inline-images))
(when org-startup-with-latex-preview
- (org-preview-latex-fragment))
+ (org-toggle-latex-fragment))
(unless org-inhibit-startup-visibility-stuff
- (org-set-startup-visibility))))
+ (org-set-startup-visibility))
+ (org-refresh-effort-properties)))
;; Try to set org-hide correctly
(let ((foreground (org-find-invisible-foreground)))
(if foreground
@@ -5467,10 +5560,10 @@ The following commands are available:
(add-to-list 'customize-package-emacs-version-alist
'(Org ("6.21b" . "23.1") ("6.33x" . "23.2")
("7.8.11" . "24.1") ("7.9.4" . "24.3")
- ("8.2.6" . "24.4")))
+ ("8.2.6" . "24.4") ("8.3" . "25.1")))
(defvar org-mode-transpose-word-syntax-table
- (let ((st (make-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)
@@ -5480,8 +5573,6 @@ The following commands are available:
(abbrev-table-put org-mode-abbrev-table
:parents (list text-mode-abbrev-table)))
-(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
-
(defun org-find-invisible-foreground ()
(let ((candidates (remove
"unspecified-bg"
@@ -5534,8 +5625,9 @@ 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" "news"
- "shell" "elisp" "doi" "message"))
+(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
@@ -5584,21 +5676,20 @@ stacked delimiters is N. Escaping delimiters is not possible."
next (concat "\\(?:" nothing left next right "\\)+" nothing)))
(concat left "\\(" re "\\)" right)))
-(defvar org-match-substring-regexp
+(defconst org-match-substring-regexp
(concat
"\\(\\S-\\)\\([_^]\\)\\("
- "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
+ "\\(?:" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\|"
- "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
+ "\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
"\\|"
- "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
+ "\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)")
"The regular expression matching a sub- or superscript.")
-(defvar org-match-substring-with-braces-regexp
+(defconst org-match-substring-with-braces-regexp
(concat
- "\\(\\S-\\)\\([_^]\\)\\("
- "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
- "\\)")
+ "\\(\\S-\\)\\([_^]\\)"
+ "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)")
"The regular expression matching a sub- or superscript, forcing braces.")
(defun org-make-link-regexps ()
@@ -5622,10 +5713,7 @@ This should be called after the variable `org-link-types' has changed."
"\\([^" org-non-link-chars " ]"
"[^\t\n\r]*\\)")
org-angle-link-re
- (concat "<" types-re ":"
- "\\([^" org-non-link-chars " ]"
- "[^" org-non-link-chars "]*"
- "\\)>")
+ (format "<%s:\\(\n?\\(?:[^>\n]+\n?\\)*\\)>" types-re)
org-plain-link-re
(concat
"\\<" types-re ":"
@@ -5656,39 +5744,10 @@ This should be called after the variable `org-link-types' has changed."
(org-make-link-regexps)
-(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
- "Regular expression for fast time stamp matching.")
-(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
- "Regular expression for fast time stamp matching.")
-(defconst org-ts-regexp0
- "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
- "Regular expression matching time strings for analysis.
-This one does not require the space after the date, so it can be used
-on a string that terminates immediately after the date.")
-(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
- "Regular expression matching time strings for analysis.")
-(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
- "Regular expression matching time stamps, with groups.")
-(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
- "Regular expression matching time stamps (also [..]), with groups.")
-(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
- "Regular expression matching a time stamp range.")
-(defconst org-tr-regexp-both
- (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
- "Regular expression matching a time stamp range.")
-(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
- org-ts-regexp "\\)?")
- "Regular expression matching a time stamp or time stamp range.")
-(defconst org-tsr-regexp-both
- (concat org-ts-regexp-both "\\(--?-?"
- org-ts-regexp-both "\\)?")
- "Regular expression matching a time stamp or time stamp range.
-The time stamps may be either active or inactive.")
-
(defvar org-emph-face nil)
(defun org-do-emphasis-faces (limit)
- "Run through the buffer and add overlays to emphasized strings."
+ "Run through the buffer and emphasize strings."
(let (rtn a)
(while (and (not rtn) (re-search-forward org-emph-re limit t))
(let* ((border (char-after (match-beginning 3)))
@@ -5769,9 +5828,11 @@ prompted for."
(add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
(defun org-activate-plain-links (limit)
- "Run through the buffer and add overlays to links."
+ "Add link properties for plain links."
(let (f hl)
(when (and (re-search-forward (concat org-plain-link-re) limit t)
+ (not (member 'org-tag
+ (get-text-property (1- (match-beginning 0)) 'face)))
(not (org-in-src-block-p)))
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(setq f (get-text-property (match-beginning 0) 'face))
@@ -5795,10 +5856,11 @@ prompted for."
'(display t invisible t intangible t))
t)))
-(defcustom org-src-fontify-natively nil
+(defcustom org-src-fontify-natively t
"When non-nil, fontify code in code blocks."
:type 'boolean
- :version "24.1"
+ :version "24.4"
+ :package-version '(Org . "8.3")
:group 'org-appearance
:group 'org-babel)
@@ -5830,17 +5892,6 @@ by a #."
(dc3 (downcase (match-string 3)))
end end1 quoting block-type ovl)
(cond
- ((member dc1 '("+html:" "+ascii:" "+latex:"))
- ;; a single line of backend-specific content
- (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 (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))
- ; for backend-specific code
- t)
((and (match-end 4) (equal dc3 "+begin"))
;; Truly a block
(setq block-type (downcase (match-string 5))
@@ -5852,26 +5903,20 @@ by a #."
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))
+ beg end '(font-lock-fontified t font-lock-multiline t))
(add-text-properties beg beg1 '(face org-meta-line))
- (add-text-properties end1 (min (point-max) (1+ end))
- '(face org-meta-line)) ; for end_src
+ (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)
- ;; remove old background overlays
- (mapc (lambda (ov)
- (if (eq (overlay-get ov 'face) 'org-block-background)
- (delete-overlay ov)))
- (overlays-at (/ (+ beg1 block-end) 2)))
- ;; add a background overlay
- (setq ovl (make-overlay beg1 block-end))
- (overlay-put ovl 'face 'org-block-background)
- (overlay-put ovl 'evaporate t)) ;; make it go away when empty
+ (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
@@ -5880,11 +5925,14 @@ by a #."
(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))
+ (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)
@@ -5893,60 +5941,91 @@ by a #."
(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-title)
'(font-lock-fontified t face org-document-info))))
- ((or (equal dc1 "+results")
- (member dc1 '("+begin:" "+end:" "+caption:" "+label:"
- "+orgtbl:" "+tblfm:" "+tblname:" "+results:"
- "+call:" "+header:" "+headers:" "+name:"))
- (and (match-end 4) (equal dc3 "+attr")))
- (add-text-properties
- beg (match-end 0)
- '(font-lock-fontified t face org-meta-line))
+ ((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))
(add-text-properties
beg (match-end 0)
'(font-lock-fontified t face font-lock-comment-face)))
- ((not (member (char-after beg) '(?\ ?\t)))
- ;; just any other in-buffer setting, but not indented
- (add-text-properties
- beg (match-end 0)
- '(font-lock-fontified t face org-meta-line))
- t)
- (t nil))))))
+ (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."
+ (when (re-search-forward org-drawer-regexp limit t)
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ '(font-lock-fontified t face org-special-keyword))
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ t))
+
+(defun org-fontify-macros (limit)
+ "Fontify macros."
+ (when (re-search-forward "\\({{{\\).+?\\(}}}\\)" limit t)
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ '(font-lock-fontified t face org-macro))
+ (when org-hide-macro-markers
+ (add-text-properties (match-end 2) (match-beginning 2)
+ '(invisible t))
+ (add-text-properties (match-beginning 1) (match-end 1)
+ '(invisible t)))
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ t))
(defun org-activate-angle-links (limit)
- "Run through the buffer and add overlays to links."
+ "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))
+ 'keymap org-mouse-map
+ 'font-lock-multiline t))
(org-rear-nonsticky-at (match-end 0))
t)))
(defun org-activate-footnote-links (limit)
- "Run through the buffer and add overlays to footnotes."
+ "Add text properties for footnotes."
(let ((fn (org-footnote-next-reference-or-definition limit)))
(when fn
- (let ((beg (nth 1 fn)) (end (nth 2 fn)))
- (org-remove-flyspell-overlays-in beg end)
+ (let* ((beg (nth 1 fn))
+ (end (nth 2 fn))
+ (label (car fn))
+ (referencep (/= (line-beginning-position) beg)))
+ (when (and referencep (nth 3 fn))
+ (save-excursion
+ (goto-char beg)
+ (search-forward (or label "fn:"))
+ (org-remove-flyspell-overlays-in beg (match-end 0))))
(add-text-properties beg end
(list 'mouse-face 'highlight
'keymap org-mouse-map
'help-echo
- (if (= (point-at-bol) beg)
- "Footnote definition"
- "Footnote reference")
+ (if referencep "Footnote reference"
+ "Footnote definition")
'font-lock-fontified t
'font-lock-multiline t
'face 'org-footnote))))))
(defun org-activate-bracket-links (limit)
- "Run through the buffer and add overlays to bracketed links."
+ "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))
@@ -5981,7 +6060,7 @@ by a #."
t)))
(defun org-activate-dates (limit)
- "Run through the buffer and add overlays to dates."
+ "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
@@ -5999,35 +6078,82 @@ by a #."
(defvar org-target-link-regexp nil
"Regular expression matching radio targets in plain text.")
(make-variable-buffer-local 'org-target-link-regexp)
-(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>"
+
+(defconst org-target-regexp (let ((border "[^<>\n\r \t]"))
+ (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>"
+ border border border))
"Regular expression matching a link target.")
-(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>"
+
+(defconst org-radio-target-regexp (format "<%s>" org-target-regexp)
"Regular expression matching a radio target.")
-(defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target.
+
+(defconst org-any-target-regexp
+ (format "%s\\|%s" org-radio-target-regexp org-target-regexp)
"Regular expression matching any target.")
(defun org-activate-target-links (limit)
- "Run through the buffer and add overlays to target matches."
+ "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 0) (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
+ (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 0))
+ (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."
+ "Find all radio targets in this file and update the regular expression.
+Also refresh fontification if needed."
(interactive)
- (when (memq 'radio org-activate-links)
+ (let ((old-regexp org-target-link-regexp)
+ (before-re "\\(?:^\\|[^[:alnum:]]\\)\\(")
+ (after-re "\\)\\(?:$\\|[^[:alnum:]]\\)")
+ (targets
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (rtn)
+ (while (re-search-forward org-radio-target-regexp nil t)
+ ;; Make sure point is really within the object.
+ (backward-char)
+ (let ((obj (org-element-context)))
+ (when (eq (org-element-type obj) 'radio-target)
+ (add-to-list 'rtn (org-element-property :value obj)))))
+ rtn))))
(setq org-target-link-regexp
- (org-make-target-link-regexp (org-all-targets 'radio)))
- (org-restart-font-lock)))
+ (and targets
+ (concat before-re
+ (mapconcat
+ (lambda (x)
+ (replace-regexp-in-string
+ " +" "\\s-+" (regexp-quote x) t t))
+ targets
+ "\\|")
+ after-re)))
+ (unless (equal old-regexp org-target-link-regexp)
+ ;; Clean-up cache.
+ (let ((regexp (cond ((not old-regexp) org-target-link-regexp)
+ ((not org-target-link-regexp) old-regexp)
+ (t
+ (concat before-re
+ (mapconcat
+ (lambda (re)
+ (substring re (length before-re)
+ (- (length after-re))))
+ (list old-regexp org-target-link-regexp)
+ "\\|")
+ after-re)))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (org-element-cache-refresh (match-beginning 1)))))
+ ;; Re fontify buffer.
+ (when (memq 'radio org-highlight-links)
+ (org-restart-font-lock)))))
(defun org-hide-wide-columns (limit)
(let (s e)
@@ -6041,8 +6167,6 @@ by a #."
(defvar org-latex-and-related-regexp nil
"Regular expression for highlighting LaTeX, entities and sub/superscript.")
-(defvar org-match-substring-regexp)
-(defvar org-match-substring-with-braces-regexp)
(defun org-compute-latex-and-related-regexp ()
"Compute regular expression for LaTeX, entities and sub/superscript.
@@ -6095,38 +6219,6 @@ done, nil otherwise."
(font-lock-mode -1)
(font-lock-mode 1)))
-(defun org-all-targets (&optional radio)
- "Return a list of all targets in this file.
-When optional argument RADIO is non-nil, only find radio
-targets."
- (let ((re (if radio org-radio-target-regexp org-target-regexp)) rtn)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- ;; Make sure point is really within the object.
- (backward-char)
- (let ((obj (org-element-context)))
- (when (memq (org-element-type obj) '(radio-target target))
- (add-to-list 'rtn (downcase (org-element-property :value obj))))))
- rtn)))
-
-(defun org-make-target-link-regexp (targets)
- "Make regular expression matching all strings in TARGETS.
-The regular expression finds the targets also if there is a line break
-between words."
- (and targets
- (concat
- "\\_<\\("
- (mapconcat
- (lambda (x)
- (setq x (regexp-quote x))
- (while (string-match " +" x)
- (setq x (replace-match "\\s-+" t t x)))
- x)
- targets
- "\\|")
- "\\)\\_>")))
-
(defun org-activate-tags (limit)
(if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t)
(progn
@@ -6139,19 +6231,20 @@ between words."
(defun org-outline-level ()
"Compute the outline level of the heading at point.
-If this is called at a normal headline, the level is the number of stars.
-Use `org-reduced-level' to remove the effect of `org-odd-levels'."
- (save-excursion
- (if (not (condition-case nil
- (org-back-to-heading t)
- (error nil)))
- 0
- (looking-at org-outline-regexp)
- (1- (- (match-end 0) (match-beginning 0))))))
+
+If this is called at a normal headline, the level is the number
+of stars. Use `org-reduced-level' to remove the effect of
+`org-odd-levels'. Unlike to `org-current-level', this function
+takes into consideration inlinetasks."
+ (org-with-wide-buffer
+ (end-of-line)
+ (if (re-search-backward org-outline-regexp-bol nil t)
+ (1- (- (match-end 0) (match-beginning 0)))
+ 0)))
(defvar org-font-lock-keywords nil)
-(defsubst org-re-property (property &optional literal allow-null)
+(defsubst org-re-property (property &optional literal allow-null value)
"Return a regexp matching a PROPERTY line.
When optional argument LITERAL is non-nil, do not quote PROPERTY.
@@ -6159,17 +6252,25 @@ This is useful when PROPERTY is a regexp. When ALLOW-NULL is
non-nil, match properties even without a value.
Match group 3 is set to the value when it exists. If there is no
-value and ALLOW-NULL is non-nil, it is set to the empty string."
+value and ALLOW-NULL is non-nil, it is set to the empty string.
+
+With optional argument VALUE, match only property lines with
+that value; in this case, ALLOW-NULL is ignored. VALUE is quoted
+unless LITERAL is non-nil."
(concat
"^\\(?4:[ \t]*\\)"
(format "\\(?1::\\(?2:%s\\):\\)"
(if literal property (regexp-quote property)))
- (if allow-null
- "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$"
- "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$")))
+ (cond (value
+ (format "[ \t]+\\(?3:%s\\)\\(?5:[ \t]*\\)$"
+ (if literal value (regexp-quote value))))
+ (allow-null
+ "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$")
+ (t
+ "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$"))))
(defconst org-property-re
- (org-re-property ".*?" 'literal t)
+ (org-re-property "\\S-+" 'literal t)
"Regular expression matching a property line.
There are four matching groups:
1: :PROPKEY: including the leading and trailing colon,
@@ -6194,7 +6295,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
(defun org-set-font-lock-defaults ()
"Set font lock defaults for the current buffer."
(let* ((em org-fontify-emphasized-text)
- (lk org-activate-links)
+ (lk org-highlight-links)
(org-font-lock-extra-keywords
(list
;; Call the hook
@@ -6215,8 +6316,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
'("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
'("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
;; Drawers
- (list org-drawer-regexp '(0 'org-special-keyword t))
- (list "^[ \t]*:END:" '(0 'org-special-keyword t))
+ '(org-fontify-drawers)
;; Properties
(list org-property-re
'(1 'org-special-keyword t)
@@ -6226,7 +6326,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
(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 (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))
;; Targets.
@@ -6234,7 +6334,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; Diary sexps.
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
;; Macro
- '("{{{.+}}}" (0 'org-macro t))
+ '(org-fontify-macros)
'(org-hide-wide-columns (0 nil append))
;; TODO keyword
(list (format org-heading-keyword-regexp-format
@@ -6260,6 +6360,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
":\\).*$")
'(1 'org-tag-group prepend)))
;; Special keywords
+ (list (concat "\\<" org-comment-string) '(0 'org-special-keyword t))
(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))
@@ -6290,11 +6391,11 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; Code
'(org-activate-code (1 'org-code t))
;; COMMENT
- (list (format org-heading-keyword-regexp-format
- (concat "\\("
- org-comment-string "\\|" org-quote-string
- "\\)"))
- '(2 'org-special-keyword t))
+ (list (format
+ "^\\*\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)"
+ org-todo-regexp
+ org-comment-string)
+ '(9 'org-special-keyword t))
;; Blocks and meta lines
'(org-fontify-meta-lines-and-blocks))))
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
@@ -6325,31 +6426,41 @@ needs to be inserted at a specific position in the font-lock sequence.")
"Display or hide properties in `org-custom-properties'."
(interactive)
(if org-custom-properties-overlays
- (progn (mapc 'delete-overlay org-custom-properties-overlays)
+ (progn (mapc #'delete-overlay org-custom-properties-overlays)
(setq org-custom-properties-overlays nil))
- (unless (not org-custom-properties)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward org-property-re nil t)
- (mapc (lambda(p)
- (when (equal p (substring (match-string 1) 1 -1))
- (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
- (overlay-put o 'invisible t)
- (overlay-put o 'org-custom-property t)
- (push o org-custom-properties-overlays))))
- org-custom-properties)))))))
+ (when org-custom-properties
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t)))
+ (while (re-search-forward regexp nil t)
+ (let ((end (cdr (save-match-data (org-get-property-block)))))
+ (when (and end (< (point) end))
+ ;; Hide first custom property in current drawer.
+ (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
+ (overlay-put o 'invisible t)
+ (overlay-put o 'org-custom-property t)
+ (push o org-custom-properties-overlays))
+ ;; Hide additional custom properties in the same drawer.
+ (while (re-search-forward regexp end t)
+ (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
+ (overlay-put o 'invisible t)
+ (overlay-put o 'org-custom-property t)
+ (push o org-custom-properties-overlays)))))
+ ;; Each entry is limited to a single property drawer.
+ (outline-next-heading)))))))
(defun org-fontify-entities (limit)
"Find an entity to fontify."
(let (ee)
(when org-pretty-entities
(catch 'match
+ ;; "\_ "-family is left out on purpose. Only the first one,
+ ;; i.e., "\_ ", could be fontified anyway, and it would be
+ ;; confusing when adding a second white space character.
(while (re-search-forward
"\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
limit t)
- (if (and (not (org-in-indented-comment-line))
+ (if (and (not (org-at-comment-p))
(setq ee (org-entity-get (match-string 1)))
(= (length (nth 6 ee)) 1))
(let*
@@ -6371,7 +6482,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
(insert s)
(let ((org-odd-levels-only odd-levels))
(org-mode)
- (font-lock-fontify-buffer)
+ (font-lock-ensure)
(buffer-string))))
(defvar org-m nil)
@@ -6449,7 +6560,7 @@ If KWD is a number, get the corresponding match group."
(remove-text-properties beg end
'(mouse-face t keymap t org-linked-text t
invisible t intangible t
- org-no-flyspell t org-emphasis t))
+ org-emphasis t))
(org-remove-font-lock-display-properties beg end)))
(defconst org-script-display '(((raise -0.3) (height 0.7))
@@ -6637,11 +6748,10 @@ in special contexts.
((eq arg t) (org-cycle-internal-global))
;; Drawers: delegate to `org-flag-drawer'.
- ((and org-drawers org-drawer-regexp
- (save-excursion
- (beginning-of-line 1)
- (looking-at org-drawer-regexp)))
- (org-flag-drawer ; toggle block visibility
+ ((save-excursion
+ (beginning-of-line 1)
+ (looking-at org-drawer-regexp))
+ (org-flag-drawer ; toggle block visibility
(not (get-char-property (match-end 0) 'invisible))))
;; Show-subtree, ARG levels up from here.
@@ -6660,7 +6770,7 @@ in special contexts.
;; At an item/headline: delegate to `org-cycle-internal-local'.
((and (or (and org-cycle-include-plain-lists (org-at-item-p))
- (save-excursion (beginning-of-line 1)
+ (save-excursion (move-beginning-of-line 1)
(looking-at org-outline-regexp)))
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-cycle-internal-local))
@@ -6878,34 +6988,33 @@ 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 state)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)"
- nil t)
- (setq state (match-string 1))
- (save-excursion
- (org-back-to-heading t)
- (hide-subtree)
- (org-reveal)
- (cond
- ((equal state '("fold" "folded"))
- (hide-subtree))
- ((equal state "children")
- (org-show-hidden-entry)
- (show-children))
- ((equal state "content")
- (save-excursion
- (save-restriction
- (org-narrow-to-subtree)
- (org-content))))
- ((member state '("all" "showall"))
- (show-subtree)))))
- (unless no-cleanup
- (org-cycle-hide-archived-subtrees 'all)
- (org-cycle-hide-drawers 'all)
- (org-cycle-show-empty-lines 'all)))))
+ (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)
+ (hide-subtree)
+ (org-reveal)
+ (cond
+ ((equal state "folded")
+ (hide-subtree))
+ ((equal state "children")
+ (org-show-hidden-entry)
+ (show-children))
+ ((equal state "content")
+ (save-excursion
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-content))))
+ ((member state '("all" "showall"))
+ (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
@@ -7005,7 +7114,7 @@ The region to be covered depends on STATE when called through
`org-cycle-hook'. Lisp program can use t for STATE to get the
entire buffer covered. Note that an empty line is only shown if there
are at least `org-cycle-separator-lines' empty lines before the headline."
- (when (not (= org-cycle-separator-lines 0))
+ (when (/= org-cycle-separator-lines 0)
(save-excursion
(let* ((n (abs org-cycle-separator-lines))
(re (cond
@@ -7014,30 +7123,26 @@ are at least `org-cycle-separator-lines' empty lines before the headline."
(t (let ((ns (number-to-string (- n 2))))
(concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
"[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
- beg end b e)
+ beg end)
(cond
((memq state '(overview contents t))
(setq beg (point-min) end (point-max)))
((memq state '(children folded))
- (setq beg (point) end (progn (org-end-of-subtree t t)
- (beginning-of-line 2)
- (point)))))
+ (setq beg (point)
+ end (progn (org-end-of-subtree t t)
+ (line-beginning-position 2)))))
(when beg
(goto-char beg)
(while (re-search-forward re end t)
(unless (get-char-property (match-end 1) 'invisible)
- (setq e (match-end 1))
- (if (< org-cycle-separator-lines 0)
- (setq b (save-excursion
- (goto-char (match-beginning 0))
- (org-back-over-empty-lines)
- (if (save-excursion
- (goto-char (max (point-min) (1- (point))))
- (org-at-heading-p))
- (1- (point))
- (point))))
- (setq b (match-beginning 1)))
- (outline-flag-region b e nil)))))))
+ (let ((e (match-end 1))
+ (b (if (>= org-cycle-separator-lines 0)
+ (match-beginning 1)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t\n")
+ (line-end-position)))))
+ (outline-flag-region b e nil))))))))
;; Never hide empty lines at the end of the file.
(save-excursion
(goto-char (point-max))
@@ -7074,8 +7179,10 @@ open and agenda-wise Org files."
"Return the end position of the current entry."
(save-excursion (outline-next-heading) (point)))
-(defun org-cycle-hide-drawers (state)
- "Re-hide all drawers after a visibility state change."
+(defun org-cycle-hide-drawers (state &optional exceptions)
+ "Re-hide all drawers after a visibility state change.
+When non-nil, optional argument EXCEPTIONS is a list of strings
+specifying which drawers should not be hidden."
(when (and (derived-mode-p 'org-mode)
(not (memq state '(overview folded contents))))
(save-excursion
@@ -7086,36 +7193,38 @@ open and agenda-wise Org files."
(save-excursion (outline-next-heading) (point))
(org-end-of-subtree t)))))
(goto-char beg)
- (while (re-search-forward org-drawer-regexp end t)
- (org-flag-drawer t))))))
-
-(defun org-cycle-hide-inline-tasks (state)
- "Re-hide inline tasks when switching to 'contents or 'children
-visibility state."
- (case state
- (contents
- (when (org-bound-and-true-p org-inlinetask-min-level)
- (hide-sublevels (1- org-inlinetask-min-level))))
- (children
- (when (featurep 'org-inlinetask)
- (save-excursion
- (while (and (outline-next-heading)
- (org-inlinetask-at-task-p))
- (org-inlinetask-toggle-visibility)
- (org-inlinetask-goto-end)))))))
-
-(defun org-flag-drawer (flag)
- "When FLAG is non-nil, hide the drawer we are within.
-Otherwise make it visible."
- (save-excursion
- (beginning-of-line 1)
- (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:")
- (let ((b (match-end 0)))
- (if (re-search-forward
- "^[ \t]*:END:"
- (save-excursion (outline-next-heading) (point)) t)
- (outline-flag-region b (point-at-eol) flag)
- (user-error ":END: line missing at position %s" b))))))
+ (while (re-search-forward org-drawer-regexp (max end (point)) t)
+ (unless (member-ignore-case (match-string 1) exceptions)
+ (let ((drawer (org-element-at-point)))
+ (when (memq (org-element-type drawer) '(drawer property-drawer))
+ (org-flag-drawer t drawer)
+ ;; Make sure to skip drawer entirely or we might flag
+ ;; it another time when matching its ending line with
+ ;; `org-drawer-regexp'.
+ (goto-char (org-element-property :end drawer))))))))))
+
+(defun org-flag-drawer (flag &optional element)
+ "When FLAG is non-nil, hide the drawer we are at.
+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)))))))
(defun org-subtree-end-visible-p ()
"Is the end of the current subtree visible?"
@@ -7147,8 +7256,8 @@ If USE-MARKERS is set, return the positions as markers."
end (overlay-end o))
(and beg end (> end beg)
(if use-markers
- (cons (move-marker (make-marker) beg)
- (move-marker (make-marker) end))
+ (cons (copy-marker beg)
+ (copy-marker end t))
(cons beg end)))))
(overlays-in (point-min) (point-max))))))))
@@ -7185,13 +7294,13 @@ Optional arguments START and END can be used to limit the range."
(defun org-hide-block-toggle-all ()
"Toggle the visibility of all blocks in the current buffer."
- (org-block-map #'org-hide-block-toggle))
+ (org-block-map 'org-hide-block-toggle))
(defun org-hide-block-all ()
"Fold all blocks in the current buffer."
(interactive)
(org-show-block-all)
- (org-block-map #'org-hide-block-toggle-maybe))
+ (org-block-map 'org-hide-block-toggle-maybe))
(defun org-show-block-all ()
"Unfold all blocks in the current buffer."
@@ -7200,52 +7309,65 @@ Optional arguments START and END can be used to limit the range."
(setq org-hide-block-overlays nil))
(defun org-hide-block-toggle-maybe ()
- "Toggle visibility of block at point."
+ "Toggle visibility of block at point.
+Unlike to `org-hide-block-toggle', this function does not throw
+an error. Return a non-nil value when toggling is successful."
(interactive)
- (let ((case-fold-search t))
- (if (save-excursion
- (beginning-of-line 1)
- (looking-at org-block-regexp))
- (progn (org-hide-block-toggle)
- t) ;; to signal that we took action
- nil))) ;; to signal that we did not
+ (ignore-errors (org-hide-block-toggle)))
(defun org-hide-block-toggle (&optional force)
- "Toggle the visibility of the current block."
+ "Toggle the visibility of the current block.
+When optional argument FORCE is `off', make block visible. If it
+is non-nil, hide it unconditionally. Throw an error when not at
+a block. Return a non-nil value when toggling is successful."
(interactive)
- (save-excursion
- (beginning-of-line)
- (if (re-search-forward org-block-regexp nil t)
- (let ((start (- (match-beginning 4) 1)) ;; beginning of body
- (end (match-end 0)) ;; end of entire body
- ov)
- (if (memq t (mapcar (lambda (overlay)
- (eq (overlay-get overlay 'invisible)
- 'org-hide-block))
- (overlays-at start)))
- (if (or (not force) (eq force 'off))
- (mapc (lambda (ov)
- (when (member ov org-hide-block-overlays)
- (setq org-hide-block-overlays
- (delq ov org-hide-block-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-hide-block)
- (delete-overlay ov)))
- (overlays-at start)))
- (setq ov (make-overlay start end))
- (overlay-put ov 'invisible 'org-hide-block)
- ;; make the block accessible to isearch
- (overlay-put
- ov 'isearch-open-invisible
- (lambda (ov)
- (when (member ov org-hide-block-overlays)
- (setq org-hide-block-overlays
- (delq ov org-hide-block-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-hide-block)
- (delete-overlay ov))))
- (push ov org-hide-block-overlays)))
- (user-error "Not looking at a source block"))))
+ (let ((element (org-element-at-point)))
+ (unless (memq (org-element-type element)
+ '(center-block comment-block dynamic-block example-block
+ export-block quote-block special-block
+ src-block verse-block))
+ (user-error "Not at a block"))
+ (let* ((start (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (line-end-position)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position)))
+ (overlays (overlays-at start)))
+ (cond
+ ;; Do nothing when not before or at the block opening line or
+ ;; at the block closing line.
+ ((let ((eol (line-end-position))) (and (> eol start) (/= eol end))) nil)
+ ((and (not (eq force 'off))
+ (not (memq t (mapcar
+ (lambda (o)
+ (eq (overlay-get o 'invisible) 'org-hide-block))
+ overlays))))
+ (let ((ov (make-overlay start end)))
+ (overlay-put ov 'invisible 'org-hide-block)
+ ;; Make the block accessible to `isearch'.
+ (overlay-put
+ ov 'isearch-open-invisible
+ (lambda (ov)
+ (when (memq ov org-hide-block-overlays)
+ (setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
+ (when (eq (overlay-get ov 'invisible) 'org-hide-block)
+ (delete-overlay ov))))
+ (push ov org-hide-block-overlays)
+ ;; When the block is hidden away, make sure point is left in
+ ;; a visible part of the buffer.
+ (when (> (line-beginning-position) start)
+ (goto-char start)
+ (beginning-of-line))
+ ;; Signal successful toggling.
+ t))
+ ((or (not force) (eq force 'off))
+ (dolist (ov overlays t)
+ (when (memq ov org-hide-block-overlays)
+ (setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
+ (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)
@@ -7384,11 +7506,9 @@ or nil."
(setq buffer-read-only t)
(if (and (boundp 'org-goto-start-pos)
(integer-or-marker-p org-goto-start-pos))
- (let ((org-show-hierarchy-above t)
- (org-show-siblings t)
- (org-show-following-heading t))
- (goto-char org-goto-start-pos)
- (and (outline-invisible-p) (org-show-context)))
+ (progn (goto-char org-goto-start-pos)
+ (when (outline-invisible-p)
+ (org-show-set-visibility 'lineage)))
(goto-char (point-min)))
(let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
@@ -7399,8 +7519,14 @@ or nil."
(defvar org-goto-local-auto-isearch-map (make-sparse-keymap))
(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map)
-(define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
-(define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)
+;; `isearch-other-control-char' was removed in Emacs 24.4.
+(if (fboundp 'isearch-other-control-char)
+ (progn
+ (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
+ (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char))
+ (define-key org-goto-local-auto-isearch-map "\C-i" nil)
+ (define-key org-goto-local-auto-isearch-map "\C-m" nil)
+ (define-key org-goto-local-auto-isearch-map [return] nil))
(defun org-goto-local-search-headings (string bound noerror)
"Search and make sure that any matches are in headlines."
@@ -7408,9 +7534,12 @@ or nil."
(while (if isearch-forward
(search-forward string bound noerror)
(search-backward string bound noerror))
- (when (let ((context (mapcar 'car (save-match-data (org-context)))))
- (and (member :headline context)
- (not (member :tags context))))
+ (when (save-match-data
+ (and (save-excursion
+ (beginning-of-line)
+ (looking-at org-complex-heading-regexp))
+ (or (not (match-beginning 5))
+ (< (point) (match-beginning 5)))))
(throw 'return (point))))))
(defun org-goto-local-auto-isearch ()
@@ -7499,7 +7628,7 @@ frame is not changed."
(not (eq org-indirect-buffer-display 'new-frame))
(not arg))
(kill-buffer org-last-indirect-buffer))
- (setq ibuf (org-get-indirect-buffer cbuf)
+ (setq ibuf (org-get-indirect-buffer cbuf heading)
org-last-indirect-buffer ibuf)
(cond
((or (eq org-indirect-buffer-display 'new-frame)
@@ -7530,11 +7659,15 @@ frame is not changed."
(run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
-(defun org-get-indirect-buffer (&optional buffer)
+(defun org-get-indirect-buffer (&optional buffer heading)
(setq buffer (or buffer (current-buffer)))
(let ((n 1) (base (buffer-name buffer)) bname)
(while (buffer-live-p
- (get-buffer (setq bname (concat base "-" (number-to-string n)))))
+ (get-buffer
+ (setq bname
+ (concat base "-"
+ (if heading (concat heading "-" (number-to-string n))
+ (number-to-string n))))))
(setq n (1+ n)))
(condition-case nil
(make-indirect-buffer buffer bname 'clone)
@@ -7559,7 +7692,7 @@ When NEXT is non-nil, check the next line instead."
(save-match-data
(looking-at "[ \t]*$")))))
-(defun org-insert-heading (&optional arg invisible-ok)
+(defun org-insert-heading (&optional arg invisible-ok top-level)
"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
@@ -7571,7 +7704,7 @@ 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 prefirx argument, set the user option
+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
@@ -7582,17 +7715,28 @@ 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.
+
When INVISIBLE-OK is set, stop at invisible headlines when going
back. This is important for non-interactive uses of the
-command."
+command.
+
+When optional argument TOP-LEVEL is non-nil, insert a level 1
+heading, unconditionally."
(interactive "P")
(if (org-called-interactively-p 'any) (org-reveal))
- (let ((itemp (org-in-item-p))
+ (let ((itemp (and (not top-level) (org-in-item-p)))
(may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
(respect-content (or org-insert-heading-respect-content
(equal arg '(4))))
- (initial-content "")
- (adjust-empty-lines t))
+ (initial-content ""))
(cond
@@ -7615,9 +7759,7 @@ command."
(insert "\n* ")))
(run-hooks 'org-insert-heading-hook))
- ((and itemp (not (member arg '((4) (16)))))
- ;; Insert an item
- (org-insert-item))
+ ((and itemp (not (member arg '((4) (16)))) (org-insert-item)))
(t
;; Maybe move at the end of the subtree
@@ -7633,7 +7775,7 @@ command."
(org-previous-line-empty-p)
;; We will decide later
nil))
- ;; Get a level string to fall back on
+ ;; Get a level string to fall back on.
(fix-level
(if (org-before-first-heading-p) "*"
(save-excursion
@@ -7644,14 +7786,15 @@ command."
(stars
(save-excursion
(condition-case nil
- (progn
+ (if top-level "* "
(org-back-to-heading invisible-ok)
(when (and (not on-heading)
(featurep 'org-inlinetask)
(integerp org-inlinetask-min-level)
(>= (length (match-string 0))
org-inlinetask-min-level))
- ;; Find a heading level before the inline task
+ ;; Find a heading level before the inline
+ ;; task.
(while (and (setq level (org-up-heading-safe))
(>= level org-inlinetask-min-level)))
(if (org-at-heading-p)
@@ -7671,27 +7814,30 @@ command."
(blank (if (eq blank-a 'auto) empty-line-p blank-a))
pos hide-previous previous-pos)
- ;; If we insert after content, move there and clean up whitespace
+ ;; If we insert after content, move there and clean up
+ ;; whitespace.
(when (and respect-content
(not (org-looking-at-p org-outline-regexp-bol)))
(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\n")
- (and (not (looking-back "^\*+"))
+ (skip-chars-backward " \r\t\n")
+ (and (not (looking-back "^\\*+" (line-beginning-position)))
(looking-at "[ \t]+") (replace-match ""))
(unless (eobp) (forward-char 1))
(when (looking-at "^\\*")
(unless (bobp) (backward-char 1))
(insert "\n")))
- ;; If we are splitting, grab the text that should be moved to the new headline
+ ;; If we are splitting, grab the text that should be moved
+ ;; to the new headline.
(when may-split
(if (org-on-heading-p)
- ;; This is a heading, we split intelligently (keeping tags)
+ ;; This is a heading: split intelligently (keeping
+ ;; tags).
(let ((pos (point)))
- (goto-char (point-at-bol))
+ (beginning-of-line)
(unless (looking-at org-complex-heading-regexp)
(error "This should not happen"))
(when (and (match-beginning 4)
@@ -7702,31 +7848,35 @@ command."
(delete-region (point) (match-end 4))
(if (looking-at "[ \t]*$")
(replace-match "")
- (insert (make-string (length initial-content) ?\ )))
+ (insert (make-string (length initial-content) ?\s)))
(setq initial-content (org-trim initial-content)))
(goto-char pos))
- ;; a normal line
+ ;; A normal line.
(setq initial-content
- (org-trim (buffer-substring (point) (point-at-eol))))
- (delete-region (point) (point-at-eol))))
+ (org-trim
+ (delete-and-extract-region (point) (line-end-position))))))
- ;; If we are at the beginning of the line, insert before it. Else after
+ ;; If we are at the beginning of the line, insert before it.
+ ;; Otherwise, after it.
(cond
((and (bolp) (looking-at "[ \t]*$")))
- ((and (bolp) (not (looking-at "[ \t]*$")))
- (open-line 1))
- (t
- (goto-char (point-at-eol))
- (insert "\n")))
+ ((bolp) (save-excursion (insert "\n")))
+ (t (end-of-line)
+ (insert "\n")))
;; Insert the new heading
(insert stars)
(just-one-space)
(insert initial-content)
- (when adjust-empty-lines
- (if (or (not blank)
- (and blank (not (org-previous-line-empty-p))))
- (org-N-empty-lines-before-current (if blank 1 0))))
+ (unless (and blank (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank 1 0)))
+ ;; Adjust visibility, which may be messed up if we removed
+ ;; blank lines while previous entry was hidden.
+ (let ((bol (line-beginning-position)))
+ (dolist (o (overlays-at (1- bol)))
+ (when (and (eq (overlay-get o 'invisible) 'outline)
+ (eq (overlay-end o) bol))
+ (move-overlay o (overlay-start o) (1- bol)))))
(run-hooks 'org-insert-heading-hook)))))))
(defun org-N-empty-lines-before-current (N)
@@ -7932,11 +8082,12 @@ in the region."
(defun org-current-level ()
"Return the level of the current entry, or nil if before the first headline.
-The level is the number of stars at the beginning of the headline."
- (save-excursion
- (org-with-limited-levels
- (if (ignore-errors (org-back-to-heading t))
- (funcall outline-level)))))
+The level is the number of stars at the beginning of the
+headline. Use `org-reduced-level' to remove the effect of
+`org-odd-levels'. Unlike to `org-outline-level', this function
+ignores inlinetasks."
+ (let ((level (org-with-limited-levels (org-outline-level))))
+ (and (> level 0) level)))
(defun org-get-previous-line-level ()
"Return the outline depth of the last headline before the current line.
@@ -7980,42 +8131,38 @@ even level numbers will become the next higher odd number."
'org-get-valid-level "23.1")))
(defun org-promote ()
- "Promote the current heading higher up the tree.
-If the region is active in `transient-mark-mode', promote all headings
-in the region."
- (org-back-to-heading t)
- (let* ((level (save-match-data (funcall outline-level)))
- (after-change-functions (remove 'flyspell-after-change-function
- after-change-functions))
- (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
- (diff (abs (- level (length up-head) -1))))
- (cond ((and (= level 1) org-called-with-limited-levels
- org-allow-promoting-top-level-subtree)
- (replace-match "# " nil t))
- ((= level 1)
- (user-error "Cannot promote to level 0. UNDO to recover if necessary"))
- (t (replace-match up-head nil t)))
- ;; Fixup tag positioning
- (unless (= level 1)
- (and org-auto-align-tags (org-set-tags nil 'ignore-column))
- (if org-adapt-indentation (org-fixup-indentation (- diff))))
- (run-hooks 'org-after-promote-entry-hook)))
+ "Promote the current heading higher up the tree."
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let* ((after-change-functions (remq 'flyspell-after-change-function
+ after-change-functions))
+ (level (save-match-data (funcall outline-level)))
+ (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
+ (diff (abs (- level (length up-head) -1))))
+ (cond
+ ((and (= level 1) org-allow-promoting-top-level-subtree)
+ (replace-match "# " nil t))
+ ((= level 1)
+ (user-error "Cannot promote to level 0. UNDO to recover if necessary"))
+ (t (replace-match up-head nil t)))
+ (unless (= level 1)
+ (when org-auto-align-tags (org-set-tags nil 'ignore-column))
+ (when org-adapt-indentation (org-fixup-indentation (- diff))))
+ (run-hooks 'org-after-promote-entry-hook))))
(defun org-demote ()
- "Demote the current heading lower down the tree.
-If the region is active in `transient-mark-mode', demote all headings
-in the region."
- (org-back-to-heading t)
- (let* ((level (save-match-data (funcall outline-level)))
- (after-change-functions (remove 'flyspell-after-change-function
- after-change-functions))
- (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
- (diff (abs (- level (length down-head) -1))))
- (replace-match down-head nil t)
- ;; Fixup tag positioning
- (and org-auto-align-tags (org-set-tags nil 'ignore-column))
- (if org-adapt-indentation (org-fixup-indentation diff))
- (run-hooks 'org-after-demote-entry-hook)))
+ "Demote the current heading lower down the tree."
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let* ((after-change-functions (remq 'flyspell-after-change-function
+ after-change-functions))
+ (level (save-match-data (funcall outline-level)))
+ (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
+ (diff (abs (- level (length down-head) -1))))
+ (replace-match down-head nil t)
+ (when org-auto-align-tags (org-set-tags nil 'ignore-column))
+ (when org-adapt-indentation (org-fixup-indentation diff))
+ (run-hooks 'org-after-demote-entry-hook))))
(defun org-cycle-level ()
"Cycle the level of an empty headline through possible states.
@@ -8080,27 +8227,111 @@ After top level, it switches back to sibling level."
(not (eobp)))
(funcall fun)))))
-(defvar org-property-end-re) ; silence byte-compiler
(defun org-fixup-indentation (diff)
"Change the indentation in the current entry by DIFF.
-However, if any line in the current entry has no indentation, or if it
-would end up with no indentation after the change, nothing at all is done."
- (save-excursion
- (let ((end (save-excursion (outline-next-heading)
- (point-marker)))
- (prohibit (if (> diff 0)
- "^\\S-"
- (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-")))
- col)
- (unless (save-excursion (end-of-line 1)
- (re-search-forward prohibit end t))
- (while (and (< (point) end)
- (re-search-forward "^[ \t]+" end t))
- (goto-char (match-end 0))
- (setq col (current-column))
- (if (< diff 0) (replace-match ""))
- (org-indent-to-column (+ diff col))))
- (move-marker end nil))))
+
+DIFF is an integer. Indentation is done according to the
+following rules:
+
+ - Planning information and property drawers are always indented
+ according to the new level of the headline;
+
+ - Footnote definitions and their contents are ignored;
+
+ - Inlinetasks' boundaries are not shifted;
+
+ - Empty lines are ignored;
+
+ - Other lines' indentation are shifted by DIFF columns, unless
+ it would introduce a structural change in the document, in
+ which case no shifting is done at all.
+
+Assume point is at a heading or an inlinetask beginning."
+ (org-with-wide-buffer
+ (narrow-to-region (line-beginning-position)
+ (save-excursion
+ (if (org-with-limited-levels (org-at-heading-p))
+ (org-with-limited-levels (outline-next-heading))
+ (org-inlinetask-goto-end))
+ (point)))
+ (forward-line)
+ ;; Indent properly planning info and property drawer.
+ (when (org-looking-at-p org-planning-line-re)
+ (org-indent-line)
+ (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (forward-line)
+ (save-excursion (org-indent-region (match-beginning 0) (match-end 0))))
+ (catch 'no-shift
+ (when (zerop diff) (throw 'no-shift nil))
+ ;; If DIFF is negative, first check if a shift is possible at all
+ ;; (e.g., it doesn't break structure). This can only happen if
+ ;; some contents are not properly indented.
+ (let ((case-fold-search t))
+ (when (< diff 0)
+ (let ((diff (- diff))
+ (forbidden-re (concat org-outline-regexp
+ "\\|"
+ (substring org-footnote-definition-re 1))))
+ (save-excursion
+ (while (not (eobp))
+ (cond
+ ((org-looking-at-p "[ \t]*$") (forward-line))
+ ((and (org-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))
+ ;; Give up if shifting would move before column 0 or
+ ;; if it would introduce a headline or a footnote
+ ;; definition.
+ (t
+ (skip-chars-forward " \t")
+ (let ((ind (current-column)))
+ (when (or (< ind diff)
+ (and (= ind diff) (org-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\\)")
+ (let ((e (org-element-at-point)))
+ (and (memq (org-element-type e)
+ '(example-block src-block))
+ (or org-src-preserve-indentation
+ (org-element-property :preserve-indent e))
+ (goto-char (org-element-property :end e))
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ t))))
+ (forward-line))))))))
+ ;; Shift lines but footnote definitions, inlinetasks boundaries
+ ;; by DIFF. Also skip contents of source or example blocks
+ ;; when indentation is meant to be preserved.
+ (while (not (eobp))
+ (cond
+ ((and (org-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))
+ (t
+ (org-indent-line-to (+ (org-get-indentation) diff))
+ (beginning-of-line)
+ (or (and (org-looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
+ (let ((e (org-element-at-point)))
+ (and (memq (org-element-type e)
+ '(example-block src-block))
+ (or org-src-preserve-indentation
+ (org-element-property :preserve-indent e))
+ (goto-char (org-element-property :end e))
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ t))))
+ (forward-line)))))))))
(defun org-convert-to-odd-levels ()
"Convert an org-mode file with all levels allowed to one with odd levels.
@@ -8128,7 +8359,7 @@ case."
(goto-char (point-min))
;; First check if there are no even levels
(when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
- (org-show-context t)
+ (org-show-set-visibility 'canonical)
(error "Not all levels are odd in this file. Conversion not possible"))
(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
(let ((outline-regexp org-outline-regexp)
@@ -8268,10 +8499,13 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(outline-next-heading)
(save-excursion (outline-end-of-heading)
(setq folded (outline-invisible-p)))
- (condition-case nil
- (org-forward-heading-same-level (1- n) t)
- (error nil))
+ (ignore-errors (org-forward-heading-same-level (1- n) t))
(org-end-of-subtree t t)))
+ ;; Include the end of an inlinetask
+ (when (and (featurep 'org-inlinetask)
+ (looking-at-p (concat (org-inlinetask-outline-regexp)
+ "END[ \t]*$")))
+ (end-of-line))
(setq end (point))
(goto-char beg0)
(when (> end beg)
@@ -8284,7 +8518,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(if cut "Cut" "Copied")
(length org-subtree-clip)))))
-(defun org-paste-subtree (&optional level tree for-yank)
+(defun org-paste-subtree (&optional level tree for-yank remove)
"Paste the clipboard as a subtree, with modification of headline level.
The entire subtree is promoted or demoted in order to match a new headline
level.
@@ -8307,13 +8541,15 @@ If optional TREE is given, use this text instead of the kill ring.
When FOR-YANK is set, this is called by `org-yank'. In this case, do not
move back over whitespace before inserting, and move point to the end of
-the inserted text when done."
+the inserted text when done.
+
+When REMOVE is non-nil, remove the subtree from the clipboard."
(interactive "P")
(setq tree (or tree (and kill-ring (current-kill 0))))
(unless (org-kill-is-subtree-p tree)
(user-error "%s"
- (substitute-command-keys
- "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
+ (substitute-command-keys
+ "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
(org-with-limited-levels
(let* ((visp (not (outline-invisible-p)))
(txt tree)
@@ -8391,7 +8627,8 @@ the inserted text when done."
org-subtree-clip-folded)
;; The tree was folded before it was killed/copied
(hide-subtree))
- (and for-yank (goto-char newend)))))
+ (and for-yank (goto-char newend))
+ (and remove (setq kill-ring (cdr kill-ring))))))
(defun org-kill-is-subtree-p (&optional txt)
"Check if the current kill is an outline subtree, or a set of trees.
@@ -8474,10 +8711,6 @@ If yes, remember the marker and the distance to BEG."
(narrow-to-region (car blockp) (cdr blockp))
(user-error "Not in a block"))))
-(eval-when-compile
- (defvar org-property-drawer-re))
-
-(defvar org-property-start-re) ;; defined below
(defun org-clone-subtree-with-time-shift (n &optional shift)
"Clone the task (subtree) at point N times.
The clones will be inserted as siblings.
@@ -8504,7 +8737,12 @@ the following will happen:
- the start days in the repeater in the original entry will be shifted
to past the last clone.
In this way you can spell out a number of instances of a repeating task,
-and still retain the repeater to cover future instances of the task."
+and still retain the repeater to cover future instances of the task.
+
+As described above, N+1 clones are produced when the original
+subtree has a repeater. Setting N to 0, then, can be used to
+remove the repeater from a subtree and create a shifted clone
+with the original repeater."
(interactive "nNumber of clones to produce: ")
(let ((shift
(or shift
@@ -8519,14 +8757,15 @@ and still retain the repeater to cover future instances of the task."
""))) ;; No time shift
(n-no-remove -1)
(drawer-re org-drawer-regexp)
+ (org-clock-re (format "^[ \t]*%s.*$" org-clock-string))
beg end template task idprop
shift-n shift-what doshift nmin nmax)
- (if (not (and (integerp n) (> n 0)))
- (error "Invalid number of replications %s" n))
+ (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)))
- (error "Invalid shift specification %s" 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)
@@ -8558,12 +8797,11 @@ and still retain the repeater to cover future instances of the task."
(org-entry-delete nil "ID")
(org-id-get-create t)))
(unless (= n 0)
- (while (re-search-forward "^[ \t]*CLOCK:.*$" nil t)
+ (while (re-search-forward org-clock-re nil t)
(kill-whole-line))
(goto-char (point-min))
(while (re-search-forward drawer-re nil t)
- (mapc (lambda (d)
- (org-remove-empty-drawer-at d (point))) org-drawers)))
+ (org-remove-empty-drawer-at (point))))
(goto-char (point-min))
(when doshift
(while (re-search-forward org-ts-regexp-both nil t)
@@ -8613,7 +8851,7 @@ hook gets called. When a region or a plain list is sorted, the cursor
will be in the first entry of the sorted region/list.")
(defun org-sort-entries
- (&optional with-case sorting-type getkey-func compare-func property)
+ (&optional with-case sorting-type getkey-func compare-func property)
"Sort entries on a certain level of an outline tree.
If there is an active region, the entries in the region are sorted.
Else, if the cursor is before the first entry, sort the top-level items.
@@ -8624,20 +8862,21 @@ a time stamp, by a property, by priority order, or by a custom function.
The command prompts for the sorting type unless it has been given to the
function through the SORTING-TYPE argument, which needs to be a character,
-\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F). Here is the
-precise meaning of each character:
+\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F ?k ?K). Here is
+the precise meaning of each character:
-n Numerically, by converting the beginning of the entry/item to a number.
a Alphabetically, ignoring the TODO keyword and the priority, if any.
-o By order of TODO keywords.
-t By date/time, either the first active time stamp in the entry, or, if
- none exist, by the first inactive one.
-s By the scheduled date/time.
-d By deadline date/time.
c By creation time, which is assumed to be the first inactive time stamp
at the beginning of a line.
+d By deadline date/time.
+k By clocking time.
+n Numerically, by converting the beginning of the entry/item to a number.
+o By order of TODO keywords.
p By priority according to the cookie.
r By the value of a property.
+s By scheduled date/time.
+t By date/time, either the first active time stamp in the entry, or, if
+ none exist, by the first inactive one.
Capital letters will reverse the sort order.
@@ -8649,7 +8888,9 @@ Comparing entries ignores case by default. However, with an optional argument
WITH-CASE, the sorting considers case as well.
Sorting is done against the visible part of the headlines, it ignores hidden
-links."
+links.
+
+When sorting is done, call `org-after-sorting-entries-or-items-hook'."
(interactive "P")
(let ((case-func (if with-case 'identity 'downcase))
(cmstr
@@ -8658,7 +8899,8 @@ links."
(when (equal (marker-buffer org-clock-marker) (current-buffer))
(save-excursion
(goto-char org-clock-marker)
- (looking-back "^.*") (match-string-no-properties 0))))
+ (buffer-substring-no-properties (line-beginning-position)
+ (point)))))
start beg end stars re re2
txt what tmp)
;; Find beginning and end of region to sort
@@ -8671,7 +8913,7 @@ links."
(if (not (org-at-heading-p)) (outline-next-heading))
(setq start (point)))
((or (org-at-heading-p)
- (condition-case nil (progn (org-back-to-heading) t) (error nil)))
+ (ignore-errors (progn (org-back-to-heading) t)))
;; we will sort the children of the current headline
(org-back-to-heading)
(setq start (point)
@@ -8715,8 +8957,8 @@ links."
(unless sorting-type
(message
"Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc
- [t]ime [s]cheduled [d]eadline [c]reated
- A/N/P/R/O/F/T/S/D/C means reversed:"
+ [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing
+ A/N/P/R/O/F/T/S/D/C/K means reversed:"
what)
(setq sorting-type (read-char-exclusive))
@@ -8734,6 +8976,7 @@ links."
(mapcar 'list (org-buffer-property-keys t))
nil t))))
+ (when (member sorting-type '(?k ?K)) (org-clock-sum))
(message "Sorting entries...")
(save-restriction
@@ -8768,6 +9011,8 @@ links."
(if (looking-at org-complex-heading-regexp)
(funcall case-func (org-sort-remove-invisible (match-string 4)))
nil))
+ ((= dcst ?k)
+ (or (get-text-property (point) :org-clock-minutes) 0))
((= dcst ?t)
(let ((end (save-excursion (outline-next-heading) (point))))
(if (or (re-search-forward org-ts-regexp end t)
@@ -8799,8 +9044,9 @@ links."
(or (org-entry-get nil property) ""))
((= dcst ?o)
(if (looking-at org-complex-heading-regexp)
- (- 9999 (length (member (match-string 2)
- org-todo-keywords-1)))))
+ (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
@@ -8813,7 +9059,7 @@ links."
(cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
- ((member dcst '(?p ?t ?s ?d ?c)) '<)))))
+ ((member dcst '(?p ?t ?s ?d ?c ?k)) '<)))))
(run-hooks 'org-after-sorting-entries-or-items-hook)
;; Reset the clock marker if needed
(when cmstr
@@ -8823,48 +9069,6 @@ links."
(move-marker org-clock-marker (point))))
(message "Sorting entries...done")))
-(defun org-do-sort (table what &optional with-case sorting-type)
- "Sort TABLE of WHAT according to SORTING-TYPE.
-The user will be prompted for the SORTING-TYPE if the call to this
-function does not specify it. WHAT is only for the prompt, to indicate
-what is being sorted. The sorting key will be extracted from
-the car of the elements of the table.
-If WITH-CASE is non-nil, the sorting will be case-sensitive."
- (unless sorting-type
- (message
- "Sort %s: [a]lphabetic, [n]umeric, [t]ime. A/N/T means reversed:"
- what)
- (setq sorting-type (read-char-exclusive)))
- (let ((dcst (downcase sorting-type))
- extractfun comparefun)
- ;; Define the appropriate functions
- (cond
- ((= dcst ?n)
- (setq extractfun 'string-to-number
- comparefun (if (= dcst sorting-type) '< '>)))
- ((= dcst ?a)
- (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x))
- (lambda(x) (downcase (org-sort-remove-invisible x))))
- comparefun (if (= dcst sorting-type)
- 'string<
- (lambda (a b) (and (not (string< a b))
- (not (string= a b)))))))
- ((= dcst ?t)
- (setq extractfun
- (lambda (x)
- (if (or (string-match org-ts-regexp x)
- (string-match org-ts-regexp-both x))
- (org-float-time
- (org-time-string-to-time (match-string 0 x)))
- 0))
- comparefun (if (= dcst sorting-type) '< '>)))
- (t (error "Invalid sorting type `%c'" sorting-type)))
-
- (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
- table)
- (lambda (a b) (funcall comparefun (car a) (car b))))))
-
-
;;; The orgstruct minor mode
;; Define a minor mode which can be used in other modes in order to
@@ -9040,11 +9244,11 @@ buffer. It will also recognize item context in multiline items."
(dolist (binding new-bindings)
(let ((key (lookup-key orgstruct-mode-map binding)))
(when (or (not key) (numberp key))
- (condition-case nil
- (org-defkey orgstruct-mode-map
- binding
- (orgstruct-make-binding f binding disable-when-heading-prefix))
- (error nil)))))))))
+ (ignore-errors
+ (org-defkey orgstruct-mode-map
+ binding
+ (orgstruct-make-binding
+ f binding disable-when-heading-prefix))))))))))
(run-hooks 'orgstruct-setup-hook))
(defun orgstruct-make-binding (fun key disable-when-heading-prefix)
@@ -9187,23 +9391,23 @@ definitions."
(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)))
+ (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))))
(delete-dups (delq nil res))))
@@ -9274,8 +9478,6 @@ call CMD."
(eval `(let ,binds
(call-interactively (quote ,cmd))))))
-;;;; Archiving
-
(defun org-get-category (&optional pos force-refresh)
"Get the category applying to position POS."
(save-match-data
@@ -9285,56 +9487,109 @@ call CMD."
(progn (org-refresh-category-properties)
(get-text-property pos 'org-category))))))
-(defun org-refresh-category-properties ()
- "Refresh category text properties in the buffer."
+;;; Refresh properties
+
+(defun org-refresh-properties (dprop tprop)
+ "Refresh buffer text properties.
+DPROP is the drawer property and TPROP is either the
+corresponding text property to set, or an alist with each element
+being a text property (as a symbol) and a function to apply to
+the value of the drawer property."
(let ((case-fold-search t)
- (inhibit-read-only t)
- (def-cat (cond
- ((null org-category)
- (if buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- "???"))
- ((symbolp org-category) (symbol-name org-category))
- (t org-category)))
- beg end cat pos optionp)
+ (inhibit-read-only t))
(org-with-silent-modifications
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
- (put-text-property (point) (point-max) 'org-category def-cat)
- (while (re-search-forward
- "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t)
- (setq pos (match-end 0)
- optionp (equal (char-after (match-beginning 0)) ?#)
- cat (org-trim (match-string 2)))
- (if optionp
- (setq beg (point-at-bol) end (point-max))
- (org-back-to-heading t)
- (setq beg (point) end (org-end-of-subtree t t)))
- (put-text-property beg end 'org-category cat)
- (put-text-property beg end 'org-category-position beg)
- (goto-char pos)))))))
+ (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t)
+ (org-refresh-property tprop (org-match-string-no-properties 1))))))))
-(defun org-refresh-properties (dprop tprop)
- "Refresh buffer text properties.
-DPROP is the drawer property and TPROP is the corresponding text
-property to set."
+(defun org-refresh-property (tprop p)
+ "Refresh the buffer text property TPROP from the drawer property P.
+The refresh happens only for the current tree (not subtree)."
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (org-back-to-heading t)
+ (if (symbolp tprop)
+ ;; TPROP is a text property symbol
+ (put-text-property
+ (point) (or (outline-next-heading) (point-max)) tprop p)
+ ;; TPROP is an alist with (properties . function) elements
+ (dolist (al tprop)
+ (save-excursion
+ (put-text-property
+ (line-beginning-position) (or (outline-next-heading) (point-max))
+ (car al)
+ (funcall (cdr al) p))))))))
+
+(defun org-refresh-category-properties ()
+ "Refresh category text properties in the buffer."
(let ((case-fold-search t)
- (inhibit-read-only t) p)
+ (inhibit-read-only t)
+ (default-category
+ (cond ((null org-category)
+ (if buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ "???"))
+ ((symbolp org-category) (symbol-name org-category))
+ (t org-category))))
+ (org-with-silent-modifications
+ (org-with-wide-buffer
+ ;; Set buffer-wide category. Search last #+CATEGORY keyword.
+ ;; This is the default category for the buffer. If none is
+ ;; found, fall-back to `org-category' or buffer file name.
+ (put-text-property
+ (point-min) (point-max)
+ 'org-category
+ (catch 'buffer-category
+ (goto-char (point-max))
+ (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (throw 'buffer-category
+ (org-element-property :value element)))))
+ default-category))
+ ;; Set sub-tree specific categories.
+ (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)))
+ (when (org-at-property-p)
+ (put-text-property
+ (save-excursion (org-back-to-heading t) (point))
+ (save-excursion (org-end-of-subtree t t) (point))
+ 'org-category
+ value)))))))))
+
+(defun org-refresh-stats-properties ()
+ "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 "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t)
- (setq p (org-match-string-no-properties 1))
- (save-excursion
- (org-back-to-heading t)
- (put-text-property
- (point-at-bol) (or (outline-next-heading) (point-max)) tprop p))))))))
-
+ (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"
+ (org-refresh-properties
+ org-effort-property
+ '((effort . identity)
+ (effort-minutes . org-duration-string-to-minutes))))
;;;; Link Stuff
@@ -9411,20 +9666,20 @@ 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, or a description added by
- org-export-normalize-links if there is none
- format the export format, a symbol like `html' or `latex' or `ascii'..
+ 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
+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)))
@@ -9436,16 +9691,16 @@ type. For a simple example of an export function, see `org-bbdb.el'."
(defun org-store-link (arg)
"\\<org-mode-map>Store an org-link to the current location.
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].
-For some link types, a 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'.
+For some link types, a 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
+A double prefix ARG force skipping storing functions that are not
part of Org's core.
-A triple prefix arg force storing a link for each line in the
+A triple prefix ARG force storing a link for each line in the
active region."
(interactive "P")
(org-load-modules-maybe)
@@ -9484,25 +9739,32 @@ active region."
desc (or (plist-get org-store-link-plist
:description) link))))
- ;; Store a link from a source code buffer
+ ;; Store a link from a source code buffer.
((org-src-edit-buffer-p)
- (let (label gc)
- (while (or (not label)
- (save-excursion
- (save-restriction
- (widen)
- (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 1)
- (setq link (format org-coderef-label-format label))
- (setq gc (- 79 (length link)))
- (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
- (insert link)
- (setq link (concat "(" label ")") desc nil)))
+ (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))
@@ -9547,7 +9809,7 @@ active region."
(org-store-link-props :type "image" :file buffer-file-name))
;; In dired, store a link to the file of the current line
- ((eq major-mode 'dired-mode)
+ ((derived-mode-p 'dired-mode)
(let ((file (dired-get-filename nil t)))
(setq file (if file
(abbreviate-file-name
@@ -9748,44 +10010,42 @@ according to FMT (default from `org-email-link-description-format')."
(defun org-make-link-string (link &optional description)
"Make a link with brackets, consisting of LINK and DESCRIPTION."
- (unless (string-match "\\S-" link)
- (error "Empty link"))
- (when (and description
- (stringp description)
- (not (string-match "\\S-" description)))
- (setq description nil))
- (when (stringp description)
- ;; Remove brackets from the description, they are fatal.
- (while (string-match "\\[" description)
- (setq description (replace-match "{" t t description)))
- (while (string-match "\\]" description)
- (setq description (replace-match "}" t t description))))
- (when (equal link description)
- ;; No description needed, it is identical
- (setq description nil))
- (when (and (not description)
- (not (string-match (org-image-file-name-regexp) link))
- (not (equal link (org-link-escape link))))
- (setq description (org-extract-attributes link)))
- (setq link
- (cond ((string-match (org-image-file-name-regexp) link) link)
- ((string-match org-link-types-re link)
- (concat (match-string 1 link)
- (org-link-escape (substring link (match-end 1)))))
- (t (org-link-escape link))))
- (concat "[[" link "]"
- (if description (concat "[" description "]") "")
- "]"))
+ (unless (org-string-nw-p link) (error "Empty link"))
+ (let ((uri (cond ((string-match org-link-types-re link)
+ (concat (match-string 1 link)
+ (org-link-escape (substring link (match-end 1)))))
+ ;; For readability, url-encode internal links only
+ ;; when absolutely needed (i.e, when they contain
+ ;; square brackets). File links however, are
+ ;; encoded since, e.g., spaces are significant.
+ ((or (file-name-absolute-p link)
+ (org-string-match-p "\\`\\.\\.?/\\|[][]" link))
+ (org-link-escape link))
+ (t link)))
+ (description
+ (and (org-string-nw-p description)
+ ;; Remove brackets from description, as they are fatal.
+ (replace-regexp-in-string
+ "[][]" (lambda (m) (if (equal "[" m) "{" "}"))
+ (org-trim description)))))
+ (format "[[%s]%s]"
+ uri
+ (if description (format "[%s]" description) ""))))
(defconst org-link-escape-chars
- '(?\ ?\[ ?\] ?\; ?\= ?\+)
- "List of characters that should be escaped in link.
+ ;;%20 %5B %5D %25
+ '(?\s ?\[ ?\] ?%)
+ "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
- '(?\ ?\")
- "List of escapes for characters that are problematic in links.
-This is the list that is used before handing over to the 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.
@@ -9794,35 +10054,52 @@ Optional argument TABLE is a list with characters that should be
escaped. When nil, `org-link-escape-chars' is used.
If optional argument MERGE is set, merge TABLE into
`org-link-escape-chars'."
- (cond
- ((and table merge)
- (mapc (lambda (defchr)
- (unless (member defchr table)
- (setq table (cons defchr table)))) org-link-escape-chars))
- ((null table)
- (setq table org-link-escape-chars)))
- (mapconcat
- (lambda (char)
- (if (or (member char table)
- (and (or (< char 32) (= char 37) (> char 126))
- org-url-hexify-p))
- (mapconcat (lambda (sequence-element)
- (format "%%%.2X" sequence-element))
- (or (encode-coding-char char 'utf-8)
- (error "Unable to percent escape character: %s"
- (char-to-string char))) "")
- (char-to-string char))) text ""))
+ (let ((characters-to-encode
+ (cond ((null table) org-link-escape-chars)
+ (merge (append org-link-escape-chars table))
+ (t table))))
+ (mapconcat
+ (lambda (c)
+ (if (or (memq c characters-to-encode)
+ (and org-url-hexify-p (or (< c 32) (> c 126))))
+ (mapconcat (lambda (e) (format "%%%.2X" e))
+ (or (encode-coding-char c 'utf-8)
+ (error "Unable to percent escape character: %c" c))
+ "")
+ (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 strings as returned from the JavaScript function
-encodeURIComponent. E.g. `%C3%B6' is the german o-Umlaut."
- (unless (and (null str) (string= "" str))
- (let ((pos 0) (case-fold-search t) unhexed)
- (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos))
- (setq unhexed (org-link-unescape-compound (match-string 0 str)))
- (setq str (replace-match unhexed t t str))
- (setq pos (+ pos (length unhexed))))))
- str)
+ "Unhex hexified Unicode parts in string STR.
+E.g. `%C3%B6' becomes the german o-Umlaut. This is the
+reciprocal of `org-link-escape', which see."
+ (if (org-string-nw-p str)
+ (replace-regexp-in-string
+ "\\(%[0-9A-Za-z]\\{2\\}\\)+" #'org-link-unescape-compound str t t)
+ str))
(defun org-link-unescape-compound (hex)
"Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut.
@@ -9854,9 +10131,8 @@ Note: this function also decodes single byte encodings like
(setq ret (concat ret (org-char-to-string sum)))
(setq sum 0))
((not bytes) ; single byte(s)
- (setq ret (org-link-unescape-single-byte-sequence hex))))
- )) ;; end (while bytes
- ret )))
+ (setq ret (org-link-unescape-single-byte-sequence hex))))))
+ ret)))
(defun org-link-unescape-single-byte-sequence (hex)
"Unhexify hex-encoded single byte character sequences."
@@ -9886,8 +10162,8 @@ Note: this function also decodes single byte encodings like
(defun org-link-prettify (link)
"Return a human-readable representation of LINK.
-The car of LINK must be a raw link the cdr of LINK must be either
-a link description or nil."
+The car of LINK must be a raw link.
+The cdr of LINK must be either a link description or nil."
(let ((desc (or (cadr link) "<no description>")))
(concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
"<" (car link) ">")))
@@ -9900,14 +10176,33 @@ This command can be called in any mode to insert a link in Org-mode syntax."
(org-load-modules-maybe)
(org-run-like-in-org-mode 'org-insert-link))
-(defun org-insert-all-links (&optional keep)
- "Insert all links in `org-stored-links'."
+(defun org-insert-all-links (arg &optional pre post)
+ "Insert all links in `org-stored-links'.
+When a universal prefix, do not delete the links from `org-stored-links'.
+When `ARG' is a number, insert the last N link(s).
+`PRE' and `POST' are optional arguments to define a string to
+prepend or to append."
(interactive "P")
- (let ((links (copy-sequence org-stored-links)) l)
- (while (setq l (if keep (pop links) (pop org-stored-links)))
- (insert "- ")
- (org-insert-link nil (car l) (or (cadr l) "<no description>"))
- (insert "\n"))))
+ (let ((org-keep-stored-link-after-insertion (equal arg '(4)))
+ (links (copy-seq org-stored-links))
+ (pr (or pre "- "))
+ (po (or post "\n"))
+ (cnt 1) l)
+ (if (null org-stored-links)
+ (message "No link to insert")
+ (while (and (or (listp arg) (>= arg cnt))
+ (setq l (if (listp arg)
+ (pop links)
+ (pop org-stored-links))))
+ (setq cnt (1+ cnt))
+ (insert pr)
+ (org-insert-link nil (car l) (or (cadr l) "<no description>"))
+ (insert po)))))
+
+(defun org-insert-last-stored-link (arg)
+ "Insert the last link stored in `org-stored-links'."
+ (interactive "p")
+ (org-insert-all-links arg "" "\n"))
(defun org-link-fontify-links-to-this-file ()
"Fontify links to the current file in `org-stored-links'."
@@ -10132,24 +10427,22 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(defun org-file-complete-link (&optional arg)
"Create a file link using completion."
- (let (file link)
- (setq file (org-iread-file-name "File: "))
- (let ((pwd (file-name-as-directory (expand-file-name ".")))
- (pwd1 (file-name-as-directory (abbreviate-file-name
- (expand-file-name ".")))))
- (cond
- ((equal arg '(16))
- (setq link (concat
- "file:"
- (abbreviate-file-name (expand-file-name file)))))
- ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
- (setq link (concat "file:" (match-string 1 file))))
- ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
- (expand-file-name file))
- (setq link (concat
- "file:" (match-string 1 (expand-file-name file)))))
- (t (setq link (concat "file:" file)))))
- link))
+ (let ((file (org-iread-file-name "File: "))
+ (pwd (file-name-as-directory (expand-file-name ".")))
+ (pwd1 (file-name-as-directory (abbreviate-file-name
+ (expand-file-name ".")))))
+ (cond ((equal arg '(16))
+ (concat "file:"
+ (abbreviate-file-name (expand-file-name file))))
+ ((string-match
+ (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
+ (concat "file:" (match-string 1 file)))
+ ((string-match
+ (concat "^" (regexp-quote pwd) "\\(.+\\)")
+ (expand-file-name file))
+ (concat "file:"
+ (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.
@@ -10158,11 +10451,11 @@ See `read-file-name' for a description of parameters."
(org-without-partial-completion
(if (and org-completion-use-ido
(fboundp 'ido-read-file-name)
- (boundp 'ido-mode) ido-mode
- (listp (second args)))
+ (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))))
+ (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."
@@ -10189,40 +10482,24 @@ from."
(iswitchb-read-buffer prompt)))
(defun org-icompleting-read (&rest args)
- "Completing-read using `ido-mode' or `iswitchb' speedups if available."
+ "Completing-read using `ido-mode' or `iswitchb' speedups if available.
+Should be called like `completing-read'."
(org-without-partial-completion
- (if (and org-completion-use-ido
- (fboundp 'ido-completing-read)
- (boundp 'ido-mode) ido-mode
- (listp (second args)))
- (let ((ido-enter-matching-directory nil))
- (apply 'ido-completing-read (concat (car args))
- (if (consp (car (nth 1 args)))
- (mapcar 'car (nth 1 args))
- (nth 1 args))
- (cddr args)))
- (if (and org-completion-use-iswitchb
- (boundp 'iswitchb-mode) iswitchb-mode
- (listp (second args)))
- (apply 'org-iswitchb-completing-read (concat (car args))
- (if (consp (car (nth 1 args)))
- (mapcar 'car (nth 1 args))
- (nth 1 args))
- (cddr args))
- (apply 'completing-read args)))))
-
-(defun org-extract-attributes (s)
- "Extract the attributes cookie from a string and set as text property."
- (let (a attr (start 0) key value)
- (save-match-data
- (when (string-match "{{\\([^}]+\\)}}$" s)
- (setq a (match-string 1 s) s (substring s 0 (match-beginning 0)))
- (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start)
- (setq key (match-string 1 a) value (match-string 2 a)
- start (match-end 0)
- attr (plist-put attr (intern key) value))))
- (org-add-props s nil 'org-attr attr))
- s))
+ (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)))))
;;; Opening/following a link
@@ -10326,9 +10603,6 @@ See the docstring of `org-open-file' for details."
"The window configuration before following a link.
This is saved in case the need arises to restore it.")
-(defvar org-open-link-marker (make-marker)
- "Marker pointing to the location where `org-open-at-point' was called.")
-
;;;###autoload
(defun org-open-at-point-global ()
"Follow a link like Org-mode does.
@@ -10363,264 +10637,231 @@ they must return nil.")
(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el
(defun org-open-at-point (&optional arg reference-buffer)
- "Open link at or after point.
-If there is no link at point, this function will search forward up to
-the end of the current line.
-Normally, files will be opened by an appropriate application. If the
-optional prefix argument ARG is non-nil, Emacs will visit the file.
-With a double prefix argument, try to open outside of Emacs, in the
-application the system uses for this file type."
- (interactive "P")
- ;; if in a code block, then open the block's results
- (unless (call-interactively #'org-babel-open-src-block-result)
- (org-load-modules-maybe)
- (move-marker org-open-link-marker (point))
- (setq org-window-config-before-follow-link (current-window-configuration))
- (org-remove-occur-highlights nil nil t)
- (cond
- ((and (org-at-heading-p)
- (not (org-at-timestamp-p t))
- (not (org-in-regexp
- (concat org-plain-link-re "\\|"
- org-bracket-link-regexp "\\|"
- org-angle-link-re "\\|"
- "[ \t]:[^ \t\n]+:[ \t]*$")))
- (not (get-text-property (point) 'org-linked-text)))
- (or (let* ((lkall (org-offer-links-in-entry (current-buffer) (point) arg))
- (lk0 (car lkall))
- (lk (if (stringp lk0) (list lk0) lk0))
- (lkend (cdr lkall)))
- (mapcar (lambda(l)
- (search-forward l nil lkend)
- (goto-char (match-beginning 0))
- (org-open-at-point))
- lk))
- (progn (require 'org-attach) (org-attach-reveal 'if-exists))))
- ((run-hook-with-args-until-success 'org-open-at-point-functions))
- ((and (org-at-timestamp-p t)
- (not (org-in-regexp org-bracket-link-regexp)))
- (org-follow-timestamp-link))
- ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
- (not (org-in-regexp org-any-link-re)))
- (org-footnote-action))
- (t
- (let (type path link line search (pos (point)))
- (catch 'match
- (save-excursion
- (or (org-in-regexp org-plain-link-re)
- (skip-chars-forward "^]\n\r"))
- (when (org-in-regexp org-bracket-link-regexp 1)
- (setq link (org-extract-attributes
- (org-link-unescape (org-match-string-no-properties 1))))
- (while (string-match " *\n *" link)
- (setq link (replace-match " " t t link)))
- (setq link (org-link-expand-abbrev link))
- (cond
- ((or (file-name-absolute-p link)
- (string-match "^\\.\\.?/" link))
- (setq type "file" path link))
- ((string-match org-link-re-with-space3 link)
- (setq type (match-string 1 link) path (match-string 2 link)))
- ((string-match "^help:+\\(.+\\)" link)
- (setq type "help" path (match-string 1 link)))
- (t (setq type "thisfile" path link)))
- (throw 'match t)))
-
- (when (get-text-property (point) 'org-linked-text)
- (setq type "thisfile"
- pos (if (get-text-property (1+ (point)) 'org-linked-text)
- (1+ (point)) (point))
- path (buffer-substring
- (or (previous-single-property-change pos 'org-linked-text)
- (point-min))
- (or (next-single-property-change pos 'org-linked-text)
- (point-max)))
- ;; Ensure we will search for a <<<radio>>> link, not
- ;; a simple reference like <<ref>>
- path (concat "<" path))
- (throw 'match t))
+ "Open link, timestamp, footnote or tags at point.
- (save-excursion
- (when (or (org-in-regexp org-angle-link-re)
- (let ((match (org-in-regexp org-plain-link-re)))
- ;; Check a plain link is not within a bracket link
- (and match
- (save-excursion
- (save-match-data
- (progn
- (goto-char (car match))
- (not (org-in-regexp org-bracket-link-regexp)))))))
- (let ((line_ending (save-excursion (end-of-line) (point))))
- ;; We are in a line before a plain or bracket link
- (or (re-search-forward org-plain-link-re line_ending t)
- (re-search-forward org-bracket-link-regexp line_ending t))))
- (setq type (match-string 1)
- path (org-link-unescape (match-string 2)))
- (throw 'match t)))
- (save-excursion
- (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$"))
- (setq type "tags"
- path (match-string 1))
- (while (string-match ":" path)
- (setq path (replace-match "+" t t path)))
- (throw 'match t)))
- (when (org-in-regexp "<\\([^><\n]+\\)>")
- (setq type "tree-match"
- path (match-string 1))
- (throw 'match t)))
- (unless path
- (user-error "No link found"))
+When point is on a link, follow it. Normally, files will be
+opened by an appropriate application. If the optional prefix
+argument ARG is non-nil, Emacs will visit the file. With
+a double prefix argument, try to open outside of Emacs, in the
+application the system uses for this file type.
- ;; switch back to reference buffer
- ;; needed when if called in a temporary buffer through
- ;; org-open-link-from-string
- (with-current-buffer (or reference-buffer (current-buffer))
+When point is on a timestamp, open the agenda at the day
+specified.
- ;; Remove any trailing spaces in path
- (if (string-match " +\\'" path)
- (setq path (replace-match "" t t path)))
- (if (and org-link-translation-function
- (fboundp org-link-translation-function))
- ;; Check if we need to translate the link
- (let ((tmp (funcall org-link-translation-function type path)))
- (setq type (car tmp) path (cdr tmp))))
+When point is a footnote definition, move to the first reference
+found. If it is on a reference, move to the associated
+definition.
- (cond
+When point is on a headline, display a list of every link in the
+entry, so it is possible to pick one, or all, of them. If point
+is on a tag, call `org-tags-view' instead.
- ((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")))))
-
- ((equal type "mailto")
- (let ((cmd (car org-link-mailto-program))
- (args (cdr org-link-mailto-program)) args1
- (address path) (subject "") a)
- (if (string-match "\\(.*\\)::\\(.*\\)" path)
- (setq address (match-string 1 path)
- subject (org-link-escape (match-string 2 path))))
- (while args
- (cond
- ((not (stringp (car args))) (push (pop args) args1))
- (t (setq a (pop args))
- (if (string-match "%a" a)
- (setq a (replace-match address t t a)))
- (if (string-match "%s" a)
- (setq a (replace-match subject t t a)))
- (push a args1))))
- (apply cmd (nreverse args1))))
-
- ((member type '("http" "https" "ftp" "news"))
- (browse-url
- (concat type ":"
- (if (org-string-match-p
- (concat "[[:nonascii:]"
- org-link-escape-chars-browser "]")
- path)
- (org-link-escape path org-link-escape-chars-browser)
- path))))
-
- ((string= type "doi")
- (browse-url
- (concat org-doi-server-url
- (if (org-string-match-p
- (concat "[[:nonascii:]"
- org-link-escape-chars-browser "]")
- path)
- (org-link-escape path org-link-escape-chars-browser)
- path))))
-
- ((member type '("message"))
- (browse-url (concat type ":" path)))
-
- ((string= type "tags")
- (org-tags-view arg path))
-
- ((string= type "tree-match")
- (org-occur (concat "\\[" (regexp-quote path) "\\]")))
-
- ((string= type "file")
- (if (string-match "::\\([0-9]+\\)\\'" path)
- (setq line (string-to-number (match-string 1 path))
- path (substring path 0 (match-beginning 0)))
- (if (string-match "::\\(.+\\)\\'" path)
- (setq search (match-string 1 path)
- path (substring path 0 (match-beginning 0)))))
- (if (string-match "[*?{]" (file-name-nondirectory path))
- (dired path)
- (org-open-file path arg line search)))
-
- ((string= type "shell")
- (let ((buf (generate-new-buffer "*Org Shell Output"))
- (cmd path))
- (if (or (and (not (string= 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)
- (if (featurep 'midnight)
- (setq clean-buffer-list-kill-buffer-names
- (cons buf clean-buffer-list-kill-buffer-names))))
- (error "Abort"))))
-
- ((string= type "elisp")
- (let ((cmd path))
- (if (or (and (not (string= org-confirm-elisp-link-not-regexp ""))
- (string-match 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 (equal (string-to-char cmd) ?\()
- (eval (read cmd))
- (call-interactively (read cmd))))
- (error "Abort"))))
-
- ((and (string= type "thisfile")
- (or (run-hook-with-args-until-success
- 'org-open-link-functions path)
- (and link
- (string-match "^id:" link)
- (or (featurep 'org-id) (require 'org-id))
- (progn
- (funcall (nth 1 (assoc "id" org-link-protocols))
- (substring path 3))
- t)))))
-
- ((string= type "thisfile")
- (if arg
- (switch-to-buffer-other-window
- (org-get-buffer-for-internal-link (current-buffer)))
- (org-mark-ring-push))
- (let ((cmd `(org-link-search
- ,path
- ,(cond ((equal arg '(4)) ''occur)
- ((equal arg '(16)) ''org-occur))
- ,pos)))
- (condition-case nil (let ((org-link-search-inhibit-query t))
- (eval cmd))
- (error (progn (widen) (eval cmd))))))
-
- (t (browse-url-at-point)))))))
- (move-marker org-open-link-marker nil)
- (run-hook-with-args 'org-follow-link-hook)))
+When optional argument REFERENCE-BUFFER is non-nil, it should
+specify a buffer from where the link search should happen. This
+is used internally by `org-open-link-from-string'.
-(defsubst org-uniquify (list)
- "Non-destructively remove duplicate elements from LIST."
- (let ((res (copy-sequence list))) (delete-dups res)))
+On top of syntactically correct links, this function will open
+the link at point in comments or comment blocks and the first
+link in a property drawer line."
+ (interactive "P")
+ ;; On a code block, open block's results.
+ (unless (call-interactively 'org-babel-open-src-block-result)
+ (org-load-modules-maybe)
+ (setq org-window-config-before-follow-link (current-window-configuration))
+ (org-remove-occur-highlights nil nil t)
+ (unless (run-hook-with-args-until-success 'org-open-at-point-functions)
+ (let* ((context
+ ;; Only consider supported types, even if they are not
+ ;; the closest one.
+ (org-element-lineage
+ (org-element-context)
+ '(comment comment-block footnote-definition footnote-reference
+ headline inlinetask keyword link node-property
+ timestamp)
+ t))
+ (type (org-element-type context))
+ (value (org-element-property :value context)))
+ (cond
+ ((not context) (user-error "No link found"))
+ ;; 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"))))
+ ;; 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* ((data (org-offer-links-in-entry (current-buffer) (point) arg))
+ (links (car data))
+ (links-end (cdr data)))
+ (if links
+ (dolist (link (if (stringp links) (list links) links))
+ (search-forward link nil links-end)
+ (goto-char (match-beginning 0))
+ (org-open-at-point))
+ (require 'org-attach)
+ (org-attach-reveal 'if-exists))))
+ ;; 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)))
+ (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)))))
+ (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))))
+ ;; 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))
+ (cond
+ ((equal type "file")
+ (if (string-match "[*?{]" (file-name-nondirectory path))
+ (dired path)
+ ;; Look into `org-link-protocols' 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))))
+ (if dedicated-function
+ (funcall dedicated-function
+ (concat path
+ (and option (concat "::" option))))
+ (apply #'org-open-file
+ path
+ (cond (arg)
+ ((equal app "emacs") 'emacs)
+ ((equal app "sys") 'system))
+ (cond ((not option) nil)
+ ((org-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 'ord-id)
+ (funcall (nth 1 (assoc "id" org-link-protocols)) path))
+ ((member type '("coderef" "custom-id" "fuzzy" "radio"))
+ (unless (run-hook-with-args-until-success
+ 'org-open-link-functions path)
+ (if (not arg) (org-mark-ring-push)
+ (switch-to-buffer-other-window
+ (org-get-buffer-for-internal-link (current-buffer))))
+ (let ((destination
+ (org-with-wide-buffer
+ (if (equal type "radio")
+ (org-search-radio-target
+ (org-element-property :path link))
+ (org-link-search
+ (if (member type '("custom-id" "coderef"))
+ (org-element-property :raw-link link)
+ path)
+ ;; Prevent fuzzy links from matching
+ ;; themselves.
+ (and (equal type "fuzzy")
+ (+ 2 (org-element-property :begin link)))))
+ (point))))
+ (unless (and (<= (point-min) destination)
+ (>= (point-max) destination))
+ (widen))
+ (goto-char destination))))
+ (t (browse-url-at-point))))))
+ ;; On a footnote reference or at a footnote definition's label.
+ ((or (eq type 'footnote-reference)
+ (and (eq type 'footnote-definition)
+ (save-excursion
+ ;; Do not validate action when point is on the
+ ;; spaces right after the footnote label, in
+ ;; order to be on par with behaviour on links.
+ (skip-chars-forward " \t")
+ (let ((begin
+ (org-element-property :contents-begin context)))
+ (if begin (< (point) begin)
+ (= (org-element-property :post-affiliated context)
+ (line-beginning-position)))))))
+ (org-footnote-action))
+ (t (user-error "No link found")))))
+ (run-hook-with-args 'org-follow-link-hook)))
(defun org-offer-links-in-entry (buffer marker &optional nth zero)
"Offer links in the current entry and return the selected link.
@@ -10633,10 +10874,7 @@ there is one, return it."
(save-restriction
(widen)
(goto-char marker)
- (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|"
- "\\(" org-angle-link-re "\\)\\|"
- "\\(" org-plain-link-re "\\)"))
- (cnt ?0)
+ (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))
@@ -10645,7 +10883,7 @@ there is one, return it."
(save-excursion
(org-back-to-heading t)
(setq end (save-excursion (outline-next-heading) (point)))
- (while (re-search-forward re end t)
+ (while (re-search-forward org-any-link-re end t)
(push (match-string 0) links))
(setq links (org-uniquify (reverse links))))
(cond
@@ -10674,7 +10912,7 @@ there is one, return it."
(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) (error "Abort"))
+ (when (equal c ?q) (user-error "Abort"))
(if (equal c ?\C-m)
(setq link links)
(setq nth (- c ?0))
@@ -10684,10 +10922,8 @@ there is one, return it."
(setq link (nth (1- nth) links)))))
(cons link end))))))
-;; Add special file links that specify the way of opening
-
-(org-add-link-type "file+sys" 'org-open-file-with-system)
-(org-add-link-type "file+emacs" 'org-open-file-with-emacs)
+;; TODO: These functions are deprecated since `org-open-at-point'
+;; hard-codes behaviour for "file+emacs" and "file+sys" types.
(defun org-open-file-with-system (path)
"Open file at PATH using the system way of opening it."
(org-open-file path 'system))
@@ -10742,173 +10978,205 @@ the window configuration before `org-open-at-point' was called using:
(set-window-configuration org-window-config-before-follow-link)")
-(defun org-link-search (s &optional type avoid-pos stealth)
- "Search for a link search option.
-If S is surrounded by forward slashes, it is interpreted as a
-regular expression. In org-mode files, this will create an `org-occur'
-sparse tree. In ordinary files, `occur' will be used to list matches.
-If the current buffer is in `dired-mode', grep will be used to search
-in all files. If AVOID-POS is given, ignore matches near that position.
+(defun org-search-radio-target (target)
+ "Search a radio target matching TARGET in current buffer.
+White spaces are not significant."
+ (let ((re (format "<<<%s>>>"
+ (mapconcat #'regexp-quote
+ (org-split-string target "[ \t\n]+")
+ "[ \t]+\\(?:\n[ \t]*\\)?")))
+ (origin (point)))
+ (goto-char (point-min))
+ (catch :radio-match
+ (while (re-search-forward re nil t)
+ (backward-char)
+ (let ((object (org-element-context)))
+ (when (eq (org-element-type object) 'radio-target)
+ (goto-char (org-element-property :begin object))
+ (org-show-context 'link-search)
+ (throw :radio-match nil))))
+ (goto-char origin)
+ (user-error "No match for radio target: %s" target))))
+
+(defun org-link-search (s &optional avoid-pos stealth)
+ "Search for a search string S.
+
+If S starts with \"#\", it triggers a custom ID search.
+
+If S is enclosed within parenthesis, it initiates a coderef
+search.
+
+If S is surrounded by forward slashes, it is interpreted as
+a regular expression. In Org mode files, this will create an
+`org-occur' sparse tree. In ordinary files, `occur' will be used
+to list matches. If the current buffer is in `dired-mode', grep
+will be used to search in all files.
+
+When AVOID-POS is given, ignore matches near that position.
When optional argument STEALTH is non-nil, do not modify
-visibility around point, thus ignoring
-`org-show-hierarchy-above', `org-show-following-heading' and
-`org-show-siblings' variables."
- (let ((case-fold-search t)
- (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
- (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
- (append '(("") (" ") ("\t") ("\n"))
- org-emphasis-alist)
- "\\|") "\\)"))
- (pos (point))
- (pre nil) (post nil)
- words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall)
+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'."
+ (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
+ (let* ((case-fold-search t)
+ (origin (point))
+ (normalized (replace-regexp-in-string "\n[ \t]*" " " s))
+ (words (org-split-string s "[ \t\n]+"))
+ (s-multi-re (mapconcat #'regexp-quote words "[ \t]+\\(?:\n[ \t]*\\)?"))
+ (s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
+ type)
(cond
- ;; First check if there are any special search functions
+ ;; Check if there are any special search functions.
((run-hook-with-args-until-success 'org-execute-file-search-functions s))
- ;; Now try the builtin stuff
- ((and (equal (string-to-char s0) ?#)
- (> (length s0) 1)
- (save-excursion
- (goto-char (point-min))
- (and
- (re-search-forward
- (concat "^[ \t]*:CUSTOM_ID:[ \t]+"
- (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
- (setq type 'dedicated
- pos (match-beginning 0))))
- ;; There is an exact target for this
- (goto-char pos)
- (org-back-to-heading t)))
- ((save-excursion
+ ((eq (string-to-char s) ?#)
+ ;; Look for a custom ID S if S starts with "#".
+ (let* ((id (substring normalized 1))
+ (match (org-find-property "CUSTOM_ID" id)))
+ (if match (progn (goto-char match) (setf type 'dedicated))
+ (error "No match for custom ID: %s" id))))
+ ((string-match "\\`(\\(.*\\))\\'" normalized)
+ ;; Look for coderef targets if S is enclosed within parenthesis.
+ (let ((coderef (match-string-no-properties 1 normalized))
+ (re (substring s-single-re 1 -1)))
(goto-char (point-min))
- (and
- (re-search-forward
- (concat "<<" (regexp-quote s0) ">>") nil t)
- (setq type 'dedicated
- pos (match-beginning 0))))
- ;; There is an exact target for this
- (goto-char pos))
- ((save-excursion
- (goto-char (point-min))
- (and
- (re-search-forward
- (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t)
- (setq type 'dedicated pos (match-beginning 0))))
- ;; Found an element with a matching #+name affiliated keyword.
- (goto-char pos))
- ((and (string-match "^(\\(.*\\))$" s0)
- (save-excursion
- (goto-char (point-min))
- (and
- (re-search-forward
- (concat "[^[]" (regexp-quote
- (format org-coderef-label-format
- (match-string 1 s0))))
- nil t)
- (setq type 'dedicated
- pos (1+ (match-beginning 0))))))
- ;; There is a coderef target for this
- (goto-char pos))
- ((string-match "^/\\(.*\\)/$" s)
- ;; A regular expression
- (cond
- ((derived-mode-p 'org-mode)
- (org-occur (match-string 1 s)))
- (t (org-do-occur (match-string 1 s)))))
- ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline)
- (and (equal (string-to-char s) ?*) (setq s (substring s 1)))
- (goto-char (point-min))
- (cond
- ((let (case-fold-search)
- (re-search-forward (format org-complex-heading-regexp-format
- (regexp-quote s))
- nil t))
- ;; OK, found a match
- (setq type 'dedicated)
- (goto-char (match-beginning 0)))
- ((and (not org-link-search-inhibit-query)
- (eq org-link-search-must-match-exact-headline 'query-to-create)
- (y-or-n-p "No match - create this as a new heading? "))
- (goto-char (point-max))
- (or (bolp) (newline))
- (insert "* " s "\n")
- (beginning-of-line 0))
- (t
- (goto-char pos)
- (error "No match"))))
+ (catch :coderef-match
+ (while (re-search-forward re nil t)
+ (let ((element (org-element-at-point)))
+ (when (and (memq (org-element-type element)
+ '(example-block src-block))
+ ;; Build proper regexp according to current
+ ;; block's label format.
+ (let ((label-fmt
+ (regexp-quote
+ (or (org-element-property :label-fmt element)
+ org-coderef-label-format))))
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (format ".*?\\(%s\\)[ \t]*$"
+ (format label-fmt coderef))))))
+ (setq type 'dedicated)
+ (goto-char (match-beginning 1))
+ (throw :coderef-match nil))))
+ (goto-char origin)
+ (error "No match for coderef: %s" coderef))))
+ ((string-match "\\`/\\(.*\\)/\\'" normalized)
+ ;; Look for a regular expression.
+ (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur)
+ (match-string 1 s)))
+ ;; Fuzzy links.
(t
- ;; A normal search string
- (when (equal (string-to-char s) ?*)
- ;; Anchor on headlines, post may include tags.
- (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*"
- post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$")
- s (substring s 1)))
- (remove-text-properties
- 0 (length s)
- '(face nil mouse-face nil keymap nil fontified nil) s)
- ;; Make a series of regular expressions to find a match
- (setq words (org-split-string s "[ \n\r\t]+")
-
- re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
- re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+")
- "\\)" markers)
- re2a_ (concat "\\(" (mapconcat 'downcase words
- "[ \t\r\n]+") "\\)[ \t\r\n]")
- re2a (concat "[ \t\r\n]" re2a_)
- re4_ (concat "\\(" (mapconcat 'downcase words
- "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
- re4 (concat "[^a-zA-Z_]" re4_)
-
- re1 (concat pre re2 post)
- re3 (concat pre (if pre re4_ re4) post)
- re5 (concat pre ".*" re4)
- re2 (concat pre re2)
- re2a (concat pre (if pre re2a_ re2a))
- re4 (concat pre (if pre re4_ re4))
- reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
- "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
- re5 "\\)"))
- (cond
- ((eq type 'org-occur) (org-occur reall))
- ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
- (t (goto-char (point-min))
- (setq type 'fuzzy)
- (if (or (and (org-search-not-self 1 re0 nil t)
- (setq type 'dedicated))
- (org-search-not-self 1 re1 nil t)
- (org-search-not-self 1 re2 nil t)
- (org-search-not-self 1 re2a nil t)
- (org-search-not-self 1 re3 nil t)
- (org-search-not-self 1 re4 nil t)
- (org-search-not-self 1 re5 nil t))
- (goto-char (match-beginning 1))
- (goto-char pos)
- (error "No match"))))))
- (and (derived-mode-p 'org-mode)
- (not stealth)
- (org-show-context 'link-search))
+ (let* ((starred (eq (string-to-char normalized) ?*))
+ (headline-search (and (derived-mode-p 'org-mode)
+ (or org-link-search-must-match-exact-headline
+ starred))))
+ (cond
+ ;; Look for targets, only if not in a headline search.
+ ((and (not starred)
+ (let ((target (format "<<%s>>" s-multi-re)))
+ (catch :target-match
+ (goto-char (point-min))
+ (while (re-search-forward target nil t)
+ (backward-char)
+ (let ((context (org-element-context)))
+ (when (eq (org-element-type context) 'target)
+ (setq type 'dedicated)
+ (goto-char (org-element-property :begin context))
+ (throw :target-match t))))
+ nil))))
+ ;; Look for elements named after S, only if not in a headline
+ ;; search.
+ ((and (not starred)
+ (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re)))
+ (catch :name-match
+ (goto-char (point-min))
+ (while (re-search-forward name nil t)
+ (let ((element (org-element-at-point)))
+ (when (equal (org-split-string
+ (org-element-property :name element)
+ "[ \t]+")
+ words)
+ (setq type 'dedicated)
+ (beginning-of-line)
+ (throw :name-match t))))
+ nil))))
+ ;; Regular text search. Prefer headlines in Org mode
+ ;; buffers.
+ ((and (derived-mode-p 'org-mode)
+ (let* ((wspace "[ \t]")
+ (wspaceopt (concat wspace "*"))
+ (cookie (concat "\\(?:"
+ wspaceopt
+ "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]"
+ wspaceopt
+ "\\)"))
+ (sep (concat "\\(?:" wspace "+\\|" cookie "+\\)"))
+ (re (concat
+ org-outline-regexp-bol
+ "\\(?:" org-todo-regexp "[ \t]+\\)?"
+ "\\(?:\\[#.\\][ \t]+\\)?"
+ "\\(?:" org-comment-string "[ \t]+\\)?"
+ sep "*"
+ (let ((title (mapconcat #'regexp-quote
+ words
+ (concat sep "+"))))
+ (if starred (substring title 1) title))
+ sep "*"
+ (org-re "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?")
+ "[ \t]*$")))
+ (goto-char (point-min))
+ (re-search-forward re nil t)))
+ (goto-char (match-beginning 0))
+ (setq type 'dedicated))
+ ;; Offer to create non-existent headline depending on
+ ;; `org-link-search-must-match-exact-headline'.
+ ((and (derived-mode-p 'org-mode)
+ (not org-link-search-inhibit-query)
+ (eq org-link-search-must-match-exact-headline 'query-to-create)
+ (yes-or-no-p "No match - create this as a new heading? "))
+ (goto-char (point-max))
+ (unless (bolp) (newline))
+ (org-insert-heading nil t t)
+ (insert s "\n")
+ (beginning-of-line 0))
+ ;; Only headlines are looked after. No need to process
+ ;; further: throw an error.
+ ((and (derived-mode-p 'org-mode)
+ (or starred org-link-search-must-match-exact-headline))
+ (goto-char origin)
+ (error "No match for fuzzy expression: %s" normalized))
+ ;; Regular text search.
+ ((catch :fuzzy-match
+ (goto-char (point-min))
+ (while (re-search-forward s-multi-re nil t)
+ ;; Skip match if it contains AVOID-POS or it is included
+ ;; in a link with a description but outside the
+ ;; description.
+ (unless (or (and avoid-pos
+ (<= (match-beginning 0) avoid-pos)
+ (> (match-end 0) avoid-pos))
+ (and (save-match-data
+ (org-in-regexp org-bracket-link-regexp))
+ (match-beginning 3)
+ (or (> (match-beginning 3) (point))
+ (<= (match-end 3) (point)))
+ (org-element-lineage
+ (save-match-data (org-element-context))
+ '(link) t)))
+ (goto-char (match-beginning 0))
+ (setq type 'fuzzy)
+ (throw :fuzzy-match t)))
+ nil))
+ ;; All failed. Throw an error.
+ (t (goto-char origin)
+ (error "No match for fuzzy expression: %s" normalized))))))
+ ;; Disclose surroundings of match, if appropriate.
+ (when (and (derived-mode-p 'org-mode) (not stealth))
+ (org-show-context 'link-search))
type))
-(defun org-search-not-self (group &rest args)
- "Execute `re-search-forward', but only accept matches that do not
-enclose the position of `org-open-link-marker'."
- (let ((m org-open-link-marker))
- (catch 'exit
- (while (apply 're-search-forward args)
- (unless (get-text-property (match-end group) 'intangible) ; Emacs 21
- (goto-char (match-end group))
- (if (and (or (not (eq (marker-buffer m) (current-buffer)))
- (> (match-beginning 0) (marker-position m))
- (< (match-end 0) (marker-position m)))
- (save-match-data
- (or (not (org-in-regexp
- org-bracket-link-analytic-regexp 1))
- (not (match-end 4)) ; no description
- (and (<= (match-beginning 4) (point))
- (>= (match-end 4) (point))))))
- (throw 'exit (point))))))))
-
(defun org-get-buffer-for-internal-link (buffer)
"Return a buffer to be used for displaying the link target of internal links."
(cond
@@ -11154,7 +11422,9 @@ 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 (org-goto-line line)
+ (if line (progn (org-goto-line line)
+ (if (derived-mode-p 'org-mode)
+ (org-reveal)))
(if search (org-link-search search))))
((consp cmd)
(let ((file (convert-standard-filename file)))
@@ -11534,30 +11804,29 @@ the *old* location.")
(let ((org-refile-keep t))
(funcall 'org-refile nil nil nil "Copy")))
-(defun org-refile (&optional goto default-buffer rfloc msg)
+(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.
-At the target location, the entry is filed as a subitem of the target
-heading. Depending on `org-reverse-note-order', the new subitem will
-either be the first or the last subitem.
+At the target location, the entry is filed as a subitem of the
+target heading. Depending on `org-reverse-note-order', the new
+subitem will either be the first or the last subitem.
-If there is an active region, all entries in that region will be moved.
-However, the region must fulfill the requirement that the first heading
-is the first one sets the top-level of the moved text - at most siblings
-below it are allowed.
+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 GOTO, the command will only visit the target location
-and not actually move anything.
+With prefix arg 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 refiling operation has put the subtree.
+With a double prefix arg \\[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.
With a numeric prefix argument of `3', emulate `org-refile-keep'
-being set to `t' and copy to the target location, don't move it.
+being set to t and copy to the target location, don't move it.
Beware that keeping refiled entries may result in duplicated ID
properties.
@@ -11568,23 +11837,22 @@ another verb. E.g. `org-copy' sets this parameter to \"Copy\".
See also `org-refile-use-outline-path' and `org-completion-use-ido'.
-If you are using target caching (see `org-refile-use-cache'),
-you have to clear the target cache in order to find new targets.
+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
prefix argument (`C-u C-u C-u C-c C-w')."
-
(interactive "P")
- (if (member goto '(0 (64)))
+ (if (member arg '(0 (64)))
(org-refile-cache-clear)
(let* ((actionmsg (cond (msg msg)
- ((equal goto 3) "Refile (and keep)")
+ ((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 goto 3) t org-refile-keep))
+ (org-refile-keep (if (equal arg 3) t org-refile-keep))
pos it nbuf file re level reversed)
(setq last-command nil)
(when regionp
@@ -11598,10 +11866,10 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(org-toggle-heading)
(setq region-end (+ (- (point-at-eol) s) region-end)))))
(user-error "The region is not a (sequence of) subtree(s)")))
- (if (equal goto '(16))
+ (if (equal arg '(16))
(org-refile-goto-last-stored)
(when (or
- (and (equal goto 2)
+ (and (equal arg 2)
org-clock-hd-marker (marker-buffer org-clock-hd-marker)
(prog1
(setq it (list (or org-clock-heading "running clock")
@@ -11609,28 +11877,30 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(marker-buffer org-clock-hd-marker))
""
(marker-position org-clock-hd-marker)))
- (setq goto nil)))
+ (setq arg nil)))
(setq it (or rfloc
(let (heading-text)
(save-excursion
- (unless (and goto (listp goto))
+ (unless (and arg (listp arg))
(org-back-to-heading t)
(setq heading-text
- (nth 4 (org-heading-components))))
-
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ "\\3"
+ (nth 4 (org-heading-components)))))
(org-refile-get-location
- (cond ((and goto (listp goto)) "Goto")
+ (cond ((and arg (listp arg)) "Goto")
(regionp (concat actionmsg " region to"))
(t (concat actionmsg " subtree \""
heading-text "\" to")))
default-buffer
- (and (not (equal '(4) goto))
+ (and (not (equal '(4) arg))
org-refile-allow-creating-parent-nodes)
- goto))))))
+ arg))))))
(setq file (nth 1 it)
re (nth 2 it)
pos (nth 3 it))
- (if (and (not goto)
+ (if (and (not arg)
pos
(equal (buffer-file-name) file)
(if regionp
@@ -11640,10 +11910,9 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(< 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 goto (not (equal goto 3)))
+ (if (and arg (not (equal arg 3)))
(progn
(org-pop-to-buffer-same-window nbuf)
(goto-char pos)
@@ -11676,7 +11945,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(goto-char (point-min))
(or (outline-next-heading) (goto-char (point-max)))))
(if (not (bolp)) (newline))
- (org-paste-subtree level)
+ (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)
@@ -11688,7 +11957,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
:last-refile)))
(when bookmark-name
(with-demoted-errors
- (bookmark-set bookmark-name))))
+ (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)
@@ -11696,7 +11965,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
:last-capture-marker)))
(when bookmark-name
(with-demoted-errors
- (bookmark-set bookmark-name))))
+ (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))))
@@ -11714,7 +11983,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(defun org-refile-goto-last-stored ()
"Go to the location where the last refile was stored."
(interactive)
- (bookmark-jump "org-refile-last-stored")
+ (bookmark-jump (plist-get org-bookmark-names-plist :last-refile))
(message "This is the location of the last refile"))
(defun org-refile--get-location (refloc tbl)
@@ -11815,7 +12084,7 @@ this is used for the GOTO interface."
(pos (nth 3 refile-pointer))
buffer)
(if (and (not (markerp pos)) (not file))
- (user-error "Please save the buffer to a file before refiling")
+ (user-error "Please indicate a target file in the refile path")
(when (org-string-nw-p re)
(setq buffer (if (markerp pos)
(marker-buffer pos)
@@ -11861,31 +12130,25 @@ this is used for the GOTO interface."
(let ((thetable collection)
(org-completion-use-ido nil) ; does not work with ido.
(org-completion-use-iswitchb nil)) ; or iswitchb
- (apply
- 'org-icompleting-read prompt
- (lambda (string predicate &optional flag)
- (let (rtn r f (l (length string)))
- (cond
- ((eq flag nil)
- ;; try completion
- (try-completion string thetable))
- ((eq flag t)
- ;; all-completions
- (setq rtn (all-completions string thetable predicate))
- (mapcar
- (lambda (x)
- (setq r (substring x l))
- (if (string-match " ([^)]*)$" x)
- (setq f (match-string 0 x))
- (setq f ""))
- (if (string-match "/" r)
- (concat string (substring r 0 (match-end 0)) f)
- x))
- rtn))
- ((eq flag 'lambda)
- ;; exact match?
- (assoc string thetable)))))
- args)))
+ (apply #'org-icompleting-read
+ prompt
+ (lambda (string predicate &optional flag)
+ (cond
+ ((eq flag nil) (try-completion string thetable))
+ ((eq flag t)
+ (let ((l (length string)))
+ (mapcar (lambda (x)
+ (let ((r (substring x l))
+ (f (if (string-match " ([^)]*)$" x)
+ (match-string 0 x)
+ "")))
+ (if (string-match "/" r)
+ (concat string (substring r 0 (match-end 0)) f)
+ x)))
+ (all-completions string thetable predicate))))
+ ;; Exact match?
+ ((eq flag 'lambda) (assoc string thetable))))
+ args)))
;;;; Dynamic blocks
@@ -11901,16 +12164,9 @@ If not found, stay at current position and return nil."
(if pos (goto-char pos))
pos))
-(defconst org-dblock-start-re
- "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
- "Matches the start line of a dynamic block, with parameters.")
-
-(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
- "Matches the end of a dynamic block.")
-
(defun org-create-dblock (plist)
"Create a dynamic block section, with parameters taken from PLIST.
-PLIST must contain a :name entry which is used as name of the block."
+PLIST must contain a :name entry which is used as the name of the block."
(when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol)))
(end-of-line 1)
(newline))
@@ -12038,7 +12294,7 @@ 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)
+ (org-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)
@@ -12054,29 +12310,26 @@ keywords relative to each registered export back-end."
"TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
(defcustom org-structure-template-alist
- '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "<src lang=\"?\">\n\n</src>")
- ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "<example>\n?\n</example>")
- ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "<quote>\n?\n</quote>")
- ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "<verse>\n?\n</verse>")
- ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "<verbatim>\n?\n</verbatim>")
- ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "<center>\n?\n</center>")
- ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX"
- "<literal style=\"latex\">\n?\n</literal>")
- ("L" "#+LaTeX: " "<literal style=\"latex\">?</literal>")
- ("h" "#+BEGIN_HTML\n?\n#+END_HTML"
- "<literal style=\"html\">\n?\n</literal>")
- ("H" "#+HTML: " "<literal style=\"html\">?</literal>")
- ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII" "")
- ("A" "#+ASCII: " "")
- ("i" "#+INDEX: ?" "#+INDEX: ?")
- ("I" "#+INCLUDE: %file ?"
- "<include file=%file markup=\"?\">"))
+ '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC")
+ ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE")
+ ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE")
+ ("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" "#+LaTeX: ")
+ ("h" "#+BEGIN_HTML\n?\n#+END_HTML")
+ ("H" "#+HTML: ")
+ ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII")
+ ("A" "#+ASCII: ")
+ ("i" "#+INDEX: ?")
+ ("I" "#+INCLUDE: %file ?"))
"Structure completion elements.
This is a list of abbreviation keys and values. The value gets inserted
if you type `<' followed by the key and then press the completion key,
-usually `M-TAB'. %file will be replaced by a file name after prompting
+usually `TAB'. %file will be replaced by a file name after prompting
for the file using completion. The cursor will be placed at the position
-of the `?` in the template.
+of the `?' in the template.
There are two templates for each key, the first uses the original Org syntax,
the second uses Emacs Muse-like syntax tags. These Muse-like tags become
the default when the /org-mtags.el/ module has been loaded. See also the
@@ -12085,8 +12338,9 @@ variable `org-mtags-prefer-muse-templates'."
:type '(repeat
(list
(string :tag "Key")
- (string :tag "Template")
- (string :tag "Muse Template"))))
+ (string :tag "Template")))
+ :version "25.1"
+ :package-version '(Org . "8.3"))
(defun org-try-structure-completion ()
"Try to complete a structure template before point.
@@ -12103,11 +12357,10 @@ expands them."
(defun org-complete-expand-structure-template (start cell)
"Expand a structure template."
- (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates))
- (rpl (nth (if musep 2 1) cell))
- (ind ""))
+ (let ((rpl (nth 1 cell))
+ (ind ""))
(delete-region start (point))
- (when (string-match "\\`#\\+" rpl)
+ (when (string-match "\\`[ \t]*#\\+" rpl)
(cond
((bolp))
((not (string-match "\\S-" (buffer-substring (point-at-bol) (point))))
@@ -12134,17 +12387,17 @@ expands them."
(interactive)
(save-excursion
(org-back-to-heading)
- (let (case-fold-search)
- (cond
- ((looking-at (format org-heading-keyword-regexp-format
- org-comment-string))
- (goto-char (match-end 1))
- (looking-at (concat " +" org-comment-string))
- (replace-match "" t t)
- (when (eolp) (insert " ")))
- ((looking-at org-outline-regexp)
- (goto-char (match-end 0))
- (insert org-comment-string " "))))))
+ (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 " "))
+ (if (org-in-commented-heading-p t)
+ (delete-region (point)
+ (progn (search-forward " " (line-end-position) 'move)
+ (skip-chars-forward " \t")
+ (point)))
+ (insert org-comment-string)
+ (unless (eolp) (insert " ")))))
(defvar org-last-todo-state-is-todo nil
"This is non-nil when the last TODO state change led to a TODO state.
@@ -12183,7 +12436,8 @@ nil or a string to be used for the todo mark." )
(interactive "P")
(if (eq major-mode 'org-agenda-mode)
(apply 'org-agenda-todo-yesterday arg)
- (let* ((hour (third (decode-time
+ (let* ((org-use-effective-time t)
+ (hour (third (decode-time
(org-current-time))))
(org-extend-today-until (1+ hour)))
(org-todo arg))))
@@ -12191,6 +12445,21 @@ nil or a string to be used for the todo mark." )
(defvar org-block-entry-blocking ""
"First entry preventing the TODO state change.")
+(defun org-cancel-repeater ()
+ "Cancel a repeater by setting its numeric value to zero."
+ (interactive)
+ (save-excursion
+ (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))))))
+
(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,
@@ -12211,8 +12480,9 @@ With a double \\[universal-argument] prefix, switch to the next set of TODO \
keywords (nextset).
With a triple \\[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.
-For calling through lisp, arg is also interpreted in the following way:
+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
@@ -12230,6 +12500,7 @@ For calling through lisp, arg is also interpreted in the following way:
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))
+ (when (equal arg -1) (org-cancel-repeater) (setq arg nil))
(let ((org-blocker-hook org-blocker-hook)
commentp
case-fold-search)
@@ -12242,7 +12513,7 @@ For calling through lisp, arg is also interpreted in the following way:
(save-excursion
(catch 'exit
(org-back-to-heading t)
- (when (looking-at (concat "^\\*+ " org-comment-string))
+ (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))))
@@ -12352,8 +12623,10 @@ For calling through lisp, arg is also interpreted in the following way:
(throw 'exit nil))))
(store-match-data match-data)
(replace-match next t t)
- (unless (pos-visible-in-window-p hl-pos)
- (message "TODO state changed to %s" (org-trim next)))
+ (cond ((equal this org-state)
+ (message "TODO state was already %s" (org-trim next)))
+ ((pos-visible-in-window-p hl-pos)
+ (message "TODO state changed to %s" (org-trim next))))
(unless head
(setq head (org-get-todo-sequence-head org-state)
ass (assoc head org-todo-kwd-alist)
@@ -12523,7 +12796,7 @@ See variable `org-track-ordered-property-with-tag'."
(org-back-to-heading)
(if (org-entry-get nil "ORDERED")
(progn
- (org-delete-property "ORDERED" "PROPERTIES")
+ (org-delete-property "ORDERED")
(and tag (org-toggle-tag tag 'off))
(message "Subtasks can be completed in arbitrary order"))
(org-entry-put nil "ORDERED" "t")
@@ -12667,18 +12940,35 @@ statistics everywhere."
(setq kwd (and (or recursive (= l1 ltoggle))
(match-string 2)))
(if (or (eq org-provide-todo-statistics 'all-headlines)
+ (and (eq org-provide-todo-statistics t)
+ (or (member kwd org-done-keywords)))
(and (listp org-provide-todo-statistics)
+ (stringp (car org-provide-todo-statistics))
(or (member kwd org-provide-todo-statistics)
- (member kwd org-done-keywords))))
+ (member kwd org-done-keywords)))
+ (and (listp org-provide-todo-statistics)
+ (listp (car org-provide-todo-statistics))
+ (or (member kwd (car org-provide-todo-statistics))
+ (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 (member kwd org-done-keywords)
- (setq cnt-done (1+ cnt-done)))
+ (when (or (and (member org-provide-todo-statistics '(t all-headlines))
+ (member kwd org-done-keywords))
+ (and (listp org-provide-todo-statistics)
+ (listp (car org-provide-todo-statistics))
+ (member kwd org-done-keywords)
+ (member kwd (cadr org-provide-todo-statistics)))
+ (and (listp org-provide-todo-statistics)
+ (stringp (car org-provide-todo-statistics))
+ (member kwd org-done-keywords)))
+ (setq cnt-done (1+ cnt-done)))
(outline-next-heading)))
(setq new
(if is-percent
- (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
+ (format "[%d%%]" (floor (* 100.0 cnt-done)
+ (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
@@ -12878,7 +13168,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(defvar org-last-inserted-timestamp)
(defvar org-log-post-message)
(defvar org-log-note-purpose)
-(defvar org-log-note-how)
+(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.
@@ -12895,7 +13185,7 @@ This function is run automatically after each state change to a DONE state."
(org-log-done nil)
(org-todo-log-states nil)
re type n what ts time to-state)
- (when repeat
+ (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))
@@ -12948,7 +13238,7 @@ This function is run automatically after each state change to a DONE state."
(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))
- (error "Abort")))
+ (user-error "Abort")))
(org-timestamp-change n (cdr (assoc what whata)))
(org-at-timestamp-p t)
(setq ts (match-string 1))
@@ -13165,16 +13455,28 @@ nil."
(defvar org-time-was-given) ; dynamically scoped parameter
(defvar org-end-time-was-given) ; dynamically scoped parameter
-(defun org-add-planning-info (what &optional time &rest remove)
- "Insert new timestamp with keyword in the line directly after the headline.
-WHAT indicates what kind of time stamp to add. TIME indicates the time to use.
-If non is given, the user is prompted for a date.
-REMOVE indicates what kind of entries to remove. An old WHAT entry will also
-be removed."
- (interactive)
- (let (org-time-was-given org-end-time-was-given ts
- end default-time default-input)
+(defun org-at-planning-p ()
+ "Non-nil when point is on a planning info line."
+ ;; This is as accurate and faster than `org-element-at-point' since
+ ;; planning info location is fixed in the section.
+ (org-with-wide-buffer
+ (beginning-of-line)
+ (and (org-looking-at-p org-planning-line-re)
+ (eq (point)
+ (ignore-errors
+ (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
+ (org-back-to-heading t)
+ (org-with-limited-levels (org-back-to-heading t)))
+ (line-beginning-position 2))))))
+(defun org-add-planning-info (what &optional time &rest remove)
+ "Insert new timestamp with keyword in the planning line.
+WHAT indicates what kind of time stamp to add. It is a symbol
+among `closed', `deadline', `scheduled' and nil. TIME indicates
+the time to use. If none is given, the user is prompted for
+a date. REMOVE indicates what kind of entries to remove. An old
+WHAT entry will also be removed."
+ (let (org-time-was-given org-end-time-was-given default-time default-input)
(catch 'exit
(when (and (memq what '(scheduled deadline))
(or (not time)
@@ -13183,101 +13485,83 @@ be removed."
;; Try to get a default date/time from existing timestamp
(save-excursion
(org-back-to-heading t)
- (setq end (save-excursion (outline-next-heading) (point)))
- (when (re-search-forward (if (eq what 'scheduled)
- org-scheduled-time-regexp
- org-deadline-time-regexp)
- end t)
- (setq ts (match-string 1)
- default-time
- (apply 'encode-time (org-parse-time-string ts))
- default-input (and ts (org-get-compact-tod ts))))))
+ (let ((end (save-excursion (outline-next-heading) (point))) ts)
+ (when (re-search-forward (if (eq what 'scheduled)
+ org-scheduled-time-regexp
+ org-deadline-time-regexp)
+ end t)
+ (setq ts (match-string 1)
+ default-time (apply 'encode-time (org-parse-time-string ts))
+ default-input (and ts (org-get-compact-tod ts)))))))
(when what
(setq time
(if (stringp time)
- ;; This is a string (relative or absolute), set proper date
- (apply 'encode-time
+ ;; This is a string (relative or absolute), set
+ ;; proper date.
+ (apply #'encode-time
(org-read-date-analyze
time default-time (decode-time default-time)))
;; If necessary, get the time from the user
(or time (org-read-date nil 'to-time nil nil
default-time default-input)))))
- (when (and org-insert-labeled-timestamps-at-point
- (member what '(scheduled deadline)))
- (insert
- (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
- (org-insert-time-stamp time org-time-was-given
- nil nil nil (list org-end-time-was-given))
- (setq what nil))
- (save-excursion
- (save-restriction
- (let (col list elt ts buffer-invisibility-spec)
- (org-back-to-heading t)
- (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"))
- (goto-char (match-end 1))
- (setq col (current-column))
- (goto-char (match-end 0))
- (if (eobp) (insert "\n") (forward-char 1))
- (when (and (not what)
- (not (looking-at
- (concat "[ \t]*"
- org-keyword-time-not-clock-regexp))))
- ;; Nothing to add, nothing to remove...... :-)
- (throw 'exit nil))
- (if (and (not (looking-at org-outline-regexp))
- (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
- "[^\r\n]*"))
- (not (equal (match-string 1) org-clock-string)))
- (narrow-to-region (match-beginning 0) (match-end 0))
- (insert-before-markers "\n")
- (backward-char 1)
- (narrow-to-region (point) (point))
- (and org-adapt-indentation (org-indent-to-column col)))
- ;; Check if we have to remove something.
- (setq list (cons what remove))
- (while list
- (setq elt (pop list))
- (when (or (and (eq elt 'scheduled)
- (re-search-forward org-scheduled-time-regexp nil t))
- (and (eq elt 'deadline)
- (re-search-forward org-deadline-time-regexp nil t))
- (and (eq elt 'closed)
- (re-search-forward org-closed-time-regexp nil t)))
- (replace-match "")
- (if (looking-at "--+<[^>]+>") (replace-match ""))))
- (and (looking-at "[ \t]+") (replace-match ""))
- (and org-adapt-indentation (bolp) (org-indent-to-column col))
- (when what
- (insert
- (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
- (cond ((eq what 'scheduled) org-scheduled-string)
- ((eq what 'deadline) org-deadline-string)
- ((eq what 'closed) org-closed-string))
- " ")
- (setq ts (org-insert-time-stamp
- time
- (or org-time-was-given
- (and (eq what 'closed) org-log-done-with-time))
- (eq what 'closed)
- nil nil (list org-end-time-was-given)))
- (insert
- (if (not (or (bolp) (eq (char-before) ?\ )
- (memq (char-after) '(32 10))
- (eobp))) " " ""))
- (end-of-line 1))
- (goto-char (point-min))
- (widen)
- (if (and (looking-at "[ \t]*\n")
- (equal (char-before) ?\n))
- (delete-region (1- (point)) (point-at-eol)))
- ts))))))
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (forward-line)
+ (unless (bolp) (insert "\n"))
+ (cond ((org-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
+ (concat
+ " *"
+ (case type
+ (closed org-closed-time-regexp)
+ (deadline org-deadline-time-regexp)
+ (scheduled org-scheduled-time-regexp)
+ (otherwise
+ (error "Invalid planning type: %s" type))))
+ (line-end-position) t)
+ (replace-match "")
+ (when (looking-at "--+<[^>]+>") (replace-match ""))
+ (when (and (not what) (eq type 'closed))
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at "[ \t]*$")
+ (delete-region (point)
+ (line-beginning-position 2)))))))
+ ;; Remove leading white spaces.
+ (when (looking-at "[ \t]+") (replace-match ""))))
+ ((not what) (throw 'exit nil)) ; Nothing to do.
+ (t (insert-before-markers "\n")
+ (backward-char 1)
+ (when org-adapt-indentation
+ (org-indent-to-column (1+ (org-outline-level))))))
+ (when what
+ ;; Insert planning keyword.
+ (insert (case what
+ (closed org-closed-string)
+ (deadline org-deadline-string)
+ (scheduled org-scheduled-string)
+ (otherwise (error "Invalid planning type: %s" what)))
+ " ")
+ ;; Insert associated timestamp.
+ (let ((ts (org-insert-time-stamp
+ time
+ (or org-time-was-given
+ (and (eq what 'closed) org-log-done-with-time))
+ (eq what 'closed)
+ nil nil (list org-end-time-was-given))))
+ (unless (eolp) (insert " "))
+ ts))))))
(defvar org-log-note-marker (make-marker))
(defvar org-log-note-purpose nil)
(defvar org-log-note-state nil)
(defvar org-log-note-previous-state nil)
-(defvar org-log-note-how nil)
(defvar org-log-note-extra nil)
(defvar org-log-note-window-configuration nil)
(defvar org-log-note-return-to (make-marker))
@@ -13296,73 +13580,89 @@ This is done in the same way as adding a state change note."
(interactive)
(org-add-log-setup 'note nil nil 'findpos nil))
-(defvar org-property-end-re)
-(defun org-add-log-setup (&optional purpose state prev-state
- findpos how extra)
+(defun org-log-beginning (&optional create)
+ "Return expected start of log notes in current entry.
+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)))
+ (cond
+ (drawer
+ (let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))
+ (case-fold-search t))
+ (catch 'exit
+ ;; Try to find existing drawer.
+ (while (re-search-forward regexp end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'drawer)
+ (let ((cend (org-element-property :contents-end element)))
+ (when (and (not org-log-states-order-reversed) cend)
+ (goto-char cend)))
+ (throw 'exit nil))))
+ ;; No drawer found. Create one, if permitted.
+ (when create
+ (unless (bolp) (insert "\n"))
+ (let ((beg (point)))
+ (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)))
+ (forward-line)))))
+ (if (bolp) (point) (line-beginning-position 2))))
+
+(defun org-add-log-setup (&optional purpose state prev-state findpos 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."
- (let* ((org-log-into-drawer (org-log-into-drawer))
- (drawer (cond ((stringp org-log-into-drawer)
- org-log-into-drawer)
- (org-log-into-drawer "LOGBOOK"))))
- (save-restriction
- (save-excursion
- (when findpos
- (org-back-to-heading t)
- (narrow-to-region (point) (save-excursion
- (outline-next-heading) (point)))
- (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"
- "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
- "[^\r\n]*\\)?"))
- (goto-char (match-end 0))
- (cond
- (drawer
- (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$")
- nil t)
- (progn
- (goto-char (match-end 0))
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (1- (match-beginning 0))))))
- (insert "\n:" drawer ":\n:END:")
- (beginning-of-line 0)
- (org-indent-line)
- (beginning-of-line 2)
- (org-indent-line)
- (end-of-line 0)))
- ((and org-log-state-notes-insert-after-drawers
- (save-excursion
- (forward-line) (looking-at org-drawer-regexp)))
- (forward-line)
- (while (looking-at org-drawer-regexp)
- (goto-char (match-end 0))
- (re-search-forward org-property-end-re (point-max) t)
- (forward-line))
- (forward-line -1)))
- (unless org-log-states-order-reversed
- (and (= (char-after) ?\n) (forward-char 1))
- (org-skip-over-state-notes)
- (skip-chars-backward " \t\n\r")))
- (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)))))
+ (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)))
(defun org-skip-over-state-notes ()
"Skip past the list of State notes in an entry."
- (if (looking-at "\n[ \t]*- State") (forward-char 1))
(when (ignore-errors (goto-char (org-in-item-p)))
(let* ((struct (org-list-struct))
- (prevs (org-list-prevs-alist struct)))
- (while (looking-at "[ \t]*- State")
+ (prevs (org-list-prevs-alist struct))
+ (regexp
+ (concat "[ \t]*- +"
+ (replace-regexp-in-string
+ " +" " +"
+ (org-replace-escapes
+ (regexp-quote (cdr (assq 'state org-log-note-headings)))
+ `(("%d" . ,org-ts-regexp-inactive)
+ ("%D" . ,org-ts-regexp)
+ ("%s" . "\"\\S-+\"")
+ ("%S" . "\"\\S-+\"")
+ ("%t" . ,org-ts-regexp-inactive)
+ ("%T" . ,org-ts-regexp)
+ ("%u" . ".*?")
+ ("%U" . ".*?")))))))
+ (while (org-looking-at-p regexp)
(goto-char (or (org-list-get-next-item (point) struct prevs)
(org-list-get-item-end (point) struct)))))))
@@ -13410,80 +13710,84 @@ EXTRA is additional text that will be inserted into the notes buffer."
"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 ind bul)
- (while (string-match "\\`# .*\n[ \t\n]*" txt)
- (setq txt (replace-match "" t t txt)))
- (if (string-match "\\s-+\\'" txt)
+ (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)))
- (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" (if org-log-note-state
- (concat "\"" org-log-note-state "\"")
- ""))
- (cons "%S" (if org-log-note-previous-state
- (concat "\"" org-log-note-previous-state "\"")
- "\"\"")))))
- (if 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
- (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK")
- org-log-note-marker))
- (setq lines nil))
- (when lines
- (with-current-buffer (marker-buffer org-log-note-marker)
- (save-excursion
- (goto-char org-log-note-marker)
- (move-marker org-log-note-marker nil)
- (end-of-line 1)
- (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
- (setq ind (save-excursion
- (if (ignore-errors (goto-char (org-in-item-p)))
- (let ((struct (org-list-struct)))
- (org-list-get-ind
- (org-list-get-top-point struct) struct))
- (skip-chars-backward " \r\t\n")
- (cond
- ((and (org-at-heading-p)
- org-adapt-indentation)
- (1+ (org-current-level)))
- ((org-at-heading-p) 0)
- (t (org-get-indentation))))))
- (setq bul (org-list-bullet-string "-"))
- (org-indent-line-to ind)
- (insert bul (pop lines))
- (let ((ind-body (+ (length bul) ind)))
- (while lines
- (insert "\n")
- (org-indent-line-to ind-body)
- (insert (pop lines))))
- (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)))))))
+ (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 ((buffer-undo-list (eq this-command 'org-agenda-todo)))
(set-window-configuration org-log-note-window-configuration)
@@ -13492,17 +13796,20 @@ EXTRA is additional text that will be inserted into the notes buffer."
(move-marker org-log-note-return-to nil)
(and org-log-post-message (message "%s" org-log-post-message))))
-(defun org-remove-empty-drawer-at (drawer pos)
- "Remove an empty drawer DRAWER at position POS.
+(defun org-remove-empty-drawer-at (pos)
+ "Remove an empty drawer at position POS.
POS may also be a marker."
(with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (if (org-in-regexp
- (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
- (replace-match ""))))))
+ (org-with-wide-buffer
+ (goto-char pos)
+ (let ((drawer (org-element-at-point)))
+ (when (and (memq (org-element-type drawer) '(drawer property-drawer))
+ (not (org-element-property :contents-begin drawer)))
+ (delete-region (org-element-property :begin drawer)
+ (progn (goto-char (org-element-property :end drawer))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))))))
(defvar org-ts-type nil)
(defun org-sparse-tree (&optional arg type)
@@ -13532,7 +13839,6 @@ D Show deadlines and scheduled items between a date range."
(deadline "only deadline")
(active "only active timestamps")
(inactive "only inactive timestamps")
- (scheduled-or-deadline "scheduled/deadline")
(closed "with a closed time-stamp")
(otherwise "scheduled/deadline")))
(let ((answer (read-char-exclusive)))
@@ -13540,24 +13846,24 @@ D Show deadlines and scheduled items between a date range."
(?c
(org-sparse-tree
arg
- (cadr (memq type '(scheduled-or-deadline all scheduled deadline active
- inactive closed)))))
- (?d (call-interactively #'org-check-deadlines))
- (?b (call-interactively #'org-check-before-date))
- (?a (call-interactively #'org-check-after-date))
- (?D (call-interactively #'org-check-dates-range))
- (?t (call-interactively #'org-show-todo-tree))
+ (cadr
+ (memq type '(nil all scheduled deadline active inactive closed)))))
+ (?d (call-interactively 'org-check-deadlines))
+ (?b (call-interactively 'org-check-before-date))
+ (?a (call-interactively 'org-check-after-date))
+ (?D (call-interactively 'org-check-dates-range))
+ (?t (call-interactively 'org-show-todo-tree))
(?T (org-show-todo-tree '(4)))
- (?m (call-interactively #'org-match-sparse-tree))
+ (?m (call-interactively 'org-match-sparse-tree))
((?p ?P)
(let* ((kwd (org-icompleting-read
- "Property: " (mapcar #'list (org-buffer-property-keys))))
+ "Property: " (mapcar 'list (org-buffer-property-keys))))
(value (org-icompleting-read
- "Value: " (mapcar #'list (org-property-values kwd)))))
+ "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))
+ ((?r ?R ?/) (call-interactively 'org-occur))
(otherwise (user-error "No such sparse tree command \"%c\"" answer)))))
(defvar org-occur-highlights nil
@@ -13631,7 +13937,7 @@ starting point when no match is found."
(while (setq p1 (funcall search-func (point) 'org-type))
(when (equal p1 limit)
(goto-char pos)
- (error "No more matches"))
+ (user-error "No more matches"))
(when (equal (get-char-property p1 'org-type) 'org-occur)
(setq n (1- n))
(when (= n 0)
@@ -13639,65 +13945,71 @@ starting point when no match is found."
(throw 'exit (point))))
(goto-char p1))
(goto-char p1)
- (error "No more matches"))))
+ (user-error "No more matches"))))
(defun org-show-context (&optional key)
"Make sure point and context are visible.
-How much context is shown depends upon the variables
-`org-show-hierarchy-above', `org-show-following-heading',
-`org-show-entry-below' and `org-show-siblings'."
- (let ((heading-p (org-at-heading-p t))
- (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
- (following-p (org-get-alist-option org-show-following-heading key))
- (entry-p (org-get-alist-option org-show-entry-below key))
- (siblings-p (org-get-alist-option org-show-siblings key)))
- ;; Show heading or entry text
- (if (and heading-p (not entry-p))
- (org-flag-heading nil) ; only show the heading
- (and (or entry-p (outline-invisible-p) (org-invisible-p2))
- (org-show-hidden-entry))) ; show entire entry
- (when following-p
- ;; Show next sibling, or heading below text
- (save-excursion
- (and (if heading-p (org-goto-sibling) (outline-next-heading))
- (org-flag-heading nil))))
- (when siblings-p (org-show-siblings))
- (when hierarchy-p
- ;; show all higher headings, possibly with siblings
+Optional argument KEY, when non-nil, is a symbol. See
+`org-show-context-detail' for allowed values and how much is to
+be shown."
+ (org-show-set-visibility
+ (cond ((symbolp org-show-context-detail) org-show-context-detail)
+ ((cdr (assq key org-show-context-detail)))
+ (t (cdr (assq 'default org-show-context-detail))))))
+
+(defun org-show-set-visibility (detail)
+ "Set visibility around point according to DETAIL.
+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)
+ (org-with-limited-levels
+ (case detail
+ ((tree canonical t) (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 (and (condition-case nil
- (progn (org-up-heading-all 1) t)
- (error nil))
- (not (bobp)))
+ (while (org-up-heading-safe)
(org-flag-heading nil)
- (when siblings-p (org-show-siblings)))))))
+ (when (memq detail '(canonical t)) (org-show-entry))
+ (when (memq detail '(tree canonical t)) (show-children)))))))
(defvar org-reveal-start-hook nil
"Hook run before revealing a location.")
(defun org-reveal (&optional siblings)
"Show current entry, hierarchy above it, and the following headline.
-This can be used to show a consistent set of context around locations
-exposed with `org-show-hierarchy-above' or `org-show-following-heading'
-not t for the search context.
+
+This can be used to show a consistent set of context around
+locations exposed with `org-show-context'.
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."
(interactive "P")
(run-hooks 'org-reveal-start-hook)
- (let ((org-show-hierarchy-above t)
- (org-show-following-heading t)
- (org-show-siblings (if siblings t org-show-siblings)))
- (org-show-context nil))
- (when (equal siblings '(16))
- (save-excursion
- (when (org-up-heading-safe)
- (org-show-subtree)
- (run-hook-with-args 'org-cycle-hook 'subtree)))))
+ (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
+ ((equal siblings '(16))
+ (save-excursion
+ (when (org-up-heading-safe)
+ (org-show-subtree)
+ (run-hook-with-args 'org-cycle-hook 'subtree))))
+ (t (org-show-set-visibility 'lineage))))
(defun org-highlight-new-match (beg end)
"Highlight from BEG to END and mark the highlight is an occur headline."
@@ -13742,83 +14054,83 @@ ACTION can be `set', `up', `down', or a character."
(interactive "P")
(if (equal action '(4))
(org-show-priority)
- (unless org-enable-priority-commands
- (user-error "Priority commands are disabled"))
- (setq action (or action 'set))
- (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))
- (cond
- ((eq action 'remove)
- (setq remove t new ?\ ))
- ((or (eq action 'set)
- (if (featurep 'xemacs) (characterp 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)))
- (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'"
- org-highest-priority org-lowest-priority))))
- ((eq action 'up)
- (setq new (if have
- (1- current) ; normal cycling
- ;; last priority was empty
- (if (eq last-command this-command)
- org-lowest-priority ; wrap around empty to lowest
- ;; default
- (if org-priority-start-cycle-with-default
- org-default-priority
- (1- org-default-priority))))))
- ((eq action 'down)
- (setq new (if have
- (1+ current) ; normal cycling
- ;; last priority was empty
- (if (eq last-command this-command)
- org-highest-priority ; wrap around empty to highest
- ;; default
- (if org-priority-start-cycle-with-default
- 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)))
- (setq news (format "%c" new))
- (if have
+ (unless org-enable-priority-commands
+ (user-error "Priority commands are disabled"))
+ (setq action (or action 'set))
+ (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))
+ (cond
+ ((eq action 'remove)
+ (setq remove t new ?\ ))
+ ((or (eq action 'set)
+ (if (featurep 'xemacs) (characterp 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)))
+ (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'"
+ org-highest-priority org-lowest-priority))))
+ ((eq action 'up)
+ (setq new (if have
+ (1- current) ; normal cycling
+ ;; last priority was empty
+ (if (eq last-command this-command)
+ org-lowest-priority ; wrap around empty to lowest
+ ;; default
+ (if org-priority-start-cycle-with-default
+ org-default-priority
+ (1- org-default-priority))))))
+ ((eq action 'down)
+ (setq new (if have
+ (1+ current) ; normal cycling
+ ;; last priority was empty
+ (if (eq last-command this-command)
+ org-highest-priority ; wrap around empty to highest
+ ;; default
+ (if org-priority-start-cycle-with-default
+ 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)))
+ (setq news (format "%c" new))
+ (if have
+ (if remove
+ (replace-match "" t t nil 1)
+ (replace-match news t t nil 2))
(if remove
- (replace-match "" t t nil 1)
- (replace-match news t t nil 2))
- (if remove
- (user-error "No priority cookie found in line")
- (let ((case-fold-search nil))
- (looking-at org-todo-line-regexp))
- (if (match-end 2)
- (progn
- (goto-char (match-end 2))
- (insert " [#" news "]"))
- (goto-char (match-beginning 3))
- (insert "[#" news "] "))))
- (org-preserve-lc (org-set-tags nil 'align)))
- (if remove
- (message "Priority removed")
- (message "Priority of current item set to %s" news)))))
+ (user-error "No priority cookie found in line")
+ (let ((case-fold-search nil))
+ (looking-at org-todo-line-regexp))
+ (if (match-end 2)
+ (progn
+ (goto-char (match-end 2))
+ (insert " [#" news "]"))
+ (goto-char (match-beginning 3))
+ (insert "[#" news "] "))))
+ (org-set-tags nil 'align))
+ (if remove
+ (message "Priority removed")
+ (message "Priority of current item set to %s" news)))))
(defun org-show-priority ()
"Show the priority of the current item.
@@ -13905,7 +14217,8 @@ headlines matching this string."
lspos tags tags-list
(tags-alist (list (cons 0 org-file-tags)))
(llast 0) rtn rtn1 level category i txt
- todo marker entry priority)
+ todo marker entry priority
+ ts-date ts-date-type ts-date-pair)
(when (not (or (member action '(agenda sparse-tree)) (functionp action)))
(setq action (list 'lambda nil action)))
(save-excursion
@@ -13922,6 +14235,10 @@ headlines matching this string."
(goto-char (setq lspos (match-beginning 0)))
(setq level (org-reduced-level (org-outline-level))
category (org-get-category))
+ (when (eq action 'agenda)
+ (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
+ ts-date (car ts-date-pair)
+ ts-date-type (cdr ts-date-pair)))
(setq i llast llast level)
;; remove tag lists from same and sublevels
(while (>= i level)
@@ -13985,7 +14302,8 @@ headlines matching this string."
(if (eq org-tags-match-list-sublevels 'indented)
(make-string (1- level) ?.) "")
(org-get-heading))
- level category
+ (make-string level ?\s)
+ category
tags-list)
priority (org-get-priority txt))
(goto-char lspos)
@@ -13993,7 +14311,9 @@ headlines matching this string."
(org-add-props txt props
'org-marker marker 'org-hd-marker marker 'org-category category
'todo-state todo
- 'priority priority 'type "tagsmatch")
+ 'ts-date ts-date
+ 'priority priority
+ 'type (concat "tagsmatch" ts-date-type))
(push txt rtn))
((functionp action)
(setq org-map-continue-from nil)
@@ -14052,15 +14372,17 @@ also TODO lines."
(defun org-cached-entry-get (pom property)
(if (or (eq t org-use-property-inheritance)
(and (stringp org-use-property-inheritance)
- (string-match org-use-property-inheritance property))
+ (let ((case-fold-search t))
+ (org-string-match-p org-use-property-inheritance property)))
(and (listp org-use-property-inheritance)
- (member property org-use-property-inheritance)))
- ;; Caching is not possible, check it directly
+ (member-ignore-case property org-use-property-inheritance)))
+ ;; Caching is not possible, check it directly.
(org-entry-get pom property 'inherit)
- ;; Get all properties, so that we can do complicated checks easily
- (cdr (assoc property (or org-cached-props
- (setq org-cached-props
- (org-entry-properties pom)))))))
+ ;; Get all properties, so we can do complicated checks easily.
+ (cdr (assoc-string property
+ (or org-cached-props
+ (setq org-cached-props (org-entry-properties pom)))
+ t))))
(defun org-global-tags-completion-table (&optional files)
"Return the list of all tags in all agenda buffer/files.
@@ -14239,16 +14561,16 @@ See also `org-scan-tags'.
matcher)))
(cons match0 matcher)))
-(defun org-tags-expand (match &optional single-as-list downcased)
+(defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded)
"Expand group tags in MATCH.
This replaces every group tag in MATCH with a regexp tag search.
For example, a group tag \"Work\" defined as { Work : Lab Conf }
will be replaced like this:
- Work => {\\(?:Work\\|Lab\\|Conf\\)}
- +Work => +{\\(?:Work\\|Lab\\|Conf\\)}
- -Work => -{\\(?:Work\\|Lab\\|Conf\\)}
+ Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
+ +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
+ -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
Replacing by a regexp preserves the structure of the match.
E.g., this expansion
@@ -14258,6 +14580,12 @@ E.g., this expansion
will match anything tagged with \"Lab\" and \"Home\", or tagged
with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\".
+A group tag in MATCH can contain regular expressions of its own.
+For example, a group tag \"Proj\" defined as { Proj : {P@.+} }
+will be replaced like this:
+
+ Proj => {\\<\\(?:Proj\\)\\>\\|P@.+}
+
When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
assumed to be a single group tag, and the function will return
the list of tags in this group.
@@ -14266,33 +14594,112 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(if org-group-tags
(let* ((case-fold-search t)
(stable org-mode-syntax-table)
- (tal (or org-tag-groups-alist-for-agenda
- org-tag-groups-alist))
- (tal (if downcased
- (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
- (tml (mapcar 'car tal))
- (rtnmatch match) rpl)
- ;; @ and _ are allowed as word-components in tags
+ (taggroups (or org-tag-groups-alist-for-agenda org-tag-groups-alist))
+ (taggroups (if downcased
+ (mapcar (lambda (tg) (mapcar #'downcase tg))
+ taggroups)
+ taggroups))
+ (taggroups-keys (mapcar #'car taggroups))
+ (return-match (if downcased (downcase match) match))
+ (count 0)
+ (work-already-expanded tags-already-expanded)
+ regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped)
+ ;; @ and _ are allowed as word-components in tags.
(modify-syntax-entry ?@ "w" stable)
(modify-syntax-entry ?_ "w" stable)
- (while (and tml
+ ;; Temporarily replace regexp-expressions in the match-expression.
+ (while (string-match "{.+?}" return-match)
+ (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
(with-syntax-table stable
(string-match
(concat "\\(?1:[+-]?\\)\\(?2:\\<"
- (regexp-opt tml) "\\>\\)") rtnmatch)))
- (let* ((dir (match-string 1 rtnmatch))
- (tag (match-string 2 rtnmatch))
+ (regexp-opt taggroups-keys) "\\>\\)") return-match)))
+ (let* ((dir (match-string 1 return-match))
+ (tag (match-string 2 return-match))
(tag (if downcased (downcase tag) tag)))
- (setq tml (delete tag tml))
- (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
- (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
- (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
- (if (stringp rpl) (org-add-props rpl '(grouptag t)))
- (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (unless (or (get-text-property 0 'grouptag (match-string 2 return-match))
+ (member tag work-already-expanded))
+ (setq tags-in-group (assoc tag taggroups))
+ (push tag work-already-expanded)
+ ;; Recursively expand each tag in the group, if the tag hasn't
+ ;; already been expanded. Restore the match-data after all recursive calls.
+ (save-match-data
+ (let (tags-expanded)
+ (dolist (x (cdr tags-in-group))
+ (if (and (member x taggroups-keys)
+ (not (member x work-already-expanded)))
+ (setq tags-expanded
+ (delete-dups
+ (append
+ (org-tags-expand x t downcased
+ work-already-expanded)
+ tags-expanded)))
+ (setq tags-expanded
+ (append (list x) tags-expanded)))
+ (setq work-already-expanded
+ (delete-dups
+ (append tags-expanded
+ work-already-expanded))))
+ (setq tags-in-group
+ (delete-dups (cons (car tags-in-group)
+ tags-expanded)))))
+ ;; Filter tag-regexps from tags.
+ (setq regexp-in-group-escaped
+ (delq nil (mapcar (lambda (x)
+ (if (stringp x)
+ (and (equal "{" (substring x 0 1))
+ (equal "}" (substring x -1))
+ x)
+ x))
+ tags-in-group))
+ regexp-in-group
+ (mapcar (lambda (x)
+ (substring x 1 -1))
+ regexp-in-group-escaped)
+ tags-in-group
+ (delq nil (mapcar (lambda (x)
+ (if (stringp x)
+ (and (not (equal "{" (substring x 0 1)))
+ (not (equal "}" (substring x -1)))
+ x)
+ x))
+ tags-in-group)))
+ ;; If single-as-list, do no more in the while-loop.
+ (if (not single-as-list)
+ (progn
+ (when regexp-in-group
+ (setq regexp-in-group
+ (concat "\\|"
+ (mapconcat 'identity regexp-in-group
+ "\\|"))))
+ (setq tags-in-group
+ (concat dir
+ "{\\<"
+ (regexp-opt tags-in-group)
+ "\\>"
+ regexp-in-group
+ "}"))
+ (when (stringp tags-in-group)
+ (org-add-props tags-in-group '(grouptag t)))
+ (setq return-match
+ (replace-match tags-in-group t t return-match)))
+ (setq tags-in-group
+ (append regexp-in-group-escaped tags-in-group))))
+ (setq taggroups-keys (delete tag taggroups-keys))))
+ ;; Add the regular expressions back into the match-expression again.
+ (while regexps-in-match
+ (setq return-match (replace-regexp-in-string (format "<%d>" count)
+ (pop regexps-in-match)
+ return-match t t))
+ (decf count))
(if single-as-list
- (or (reverse rpl) (list rtnmatch))
- rtnmatch))
- (if single-as-list (list (if downcased (downcase match) match))
+ (if tags-in-group tags-in-group (list return-match))
+ return-match))
+ (if single-as-list
+ (list (if downcased (downcase match) match))
match)))
(defun org-op-to-function (op &optional stringp)
@@ -14537,102 +14944,108 @@ When JUST-ALIGN is non-nil, only align tags."
(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)
- 'region-start-level 'region))
- org-loop-over-headlines-in-active-region)
- (org-map-entries
- ;; We don't use ARG and JUST-ALIGN here because these args
- ;; are not useful when looping over headlines.
- `(org-set-tags)
- org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
- (let* ((re org-outline-regexp-bol)
- (current (unless arg (org-get-tags-string)))
- (col (current-column))
- (org-setting-tags t)
- table current-tags inherited-tags ; computed below when needed
- tags p0 c0 c1 rpl di tc level)
+ 'region-start-level
+ 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ ;; We don't use ARG and JUST-ALIGN here because these args
+ ;; are not useful when looping over headlines.
+ #'org-set-tags
+ org-loop-over-headlines-in-active-region
+ cl
+ '(when (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let ((org-setting-tags t))
(if arg
- (save-excursion
- (goto-char (point-min))
- (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
- (while (re-search-forward re nil t)
- (org-set-tags nil t)
- (end-of-line 1)))
- (message "All tags realigned to column %d" org-tags-column))
- (if just-align
- (setq tags current)
- ;; Get a new set of tags from the user
- (save-excursion
- (setq 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))))
- org-last-tags-completion-table table
- current-tags (org-split-string current ":")
- inherited-tags (nreverse
- (nthcdr (length current-tags)
- (nreverse (org-get-tags-at))))
- tags
- (if (or (eq t org-use-fast-tag-selection)
- (and org-use-fast-tag-selection
- (delq nil (mapcar 'cdr table))))
- (org-fast-tag-selection
- current-tags inherited-tags table
- (if org-fast-tag-selection-include-todo
- org-todo-key-alist))
- (let ((org-add-colon-after-tag-completion (< 1 (length table))))
- (org-trim
- (org-icompleting-read "Tags: "
- 'org-tags-completion-function
- nil nil current 'org-tags-history))))))
- (while (string-match "[-+&]+" tags)
- ;; No boolean logic, just a list
- (setq tags (replace-match ":" t t tags))))
-
- (setq tags (replace-regexp-in-string "[,]" ":" tags))
-
- (if org-tags-sort-function
- (setq tags (mapconcat 'identity
- (sort (org-split-string
- tags (org-re "[^[:alnum:]_@#%]+"))
- org-tags-sort-function) ":")))
-
- (if (string-match "\\`[\t ]*\\'" tags)
- (setq tags "")
- (unless (string-match ":$" tags) (setq tags (concat tags ":")))
- (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
-
- ;; Insert new tags at the correct column
- (beginning-of-line 1)
- (setq level (or (and (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]*$")
- (point-at-eol) t)
- (if (equal tags "")
- (setq rpl "")
- (goto-char (match-beginning 0))
- (setq c0 (current-column)
- ;; compute offset for the case of org-indent-mode active
- di (if (org-bound-and-true-p org-indent-mode)
- (* (1- org-indent-indentation-per-level) (1- level))
- 0)
- p0 (if (equal (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) (length tags))))
- rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
- (replace-match rpl t t)
- (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
- tags)
- (t (error "Tags alignment failed")))
- (org-move-to-column col)
- (unless just-align
- (run-hooks 'org-after-tags-change-hook))))))
+ (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)))
+ (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
+ (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))))))
+ (current-tags (org-split-string current ":"))
+ (inherited-tags
+ (nreverse (nthcdr (length current-tags)
+ (nreverse (org-get-tags-at))))))
+ (replace-regexp-in-string
+ "\\([-+&]+\\|,\\)"
+ ":"
+ (if (or (eq t org-use-fast-tag-selection)
+ (and org-use-fast-tag-selection
+ (delq nil (mapcar #'cdr table))))
+ (org-fast-tag-selection
+ current-tags inherited-tags table
+ (and org-fast-tag-selection-include-todo
+ org-todo-key-alist))
+ (let ((org-add-colon-after-tag-completion
+ (< 1 (length table))))
+ (org-trim
+ (completing-read
+ "Tags: "
+ #'org-tags-completion-function
+ nil nil current 'org-tags-history))))))))))
+
+ (when org-tags-sort-function
+ (setq tags
+ (mapconcat
+ #'identity
+ (sort (org-split-string tags (org-re "[^[: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))))
+
+ ;; 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)
+ (* (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))
+ (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.
@@ -14751,7 +15164,7 @@ Returns the new tags string, or nil to not change the current settings."
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
- groups ingroup)
+ groups ingroup intaggroup)
(save-excursion
(beginning-of-line 1)
(if (looking-at
@@ -14784,24 +15197,33 @@ Returns the new tags string, or nil to not change the current settings."
(setq tbl fulltable char ?a cnt 0)
(while (setq e (pop tbl))
(cond
- ((equal (car e) :startgroup)
+ ((eq (car e) :startgroup)
(push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n"))
(insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
- ((equal (car e) :endgroup)
+ ((eq (car e) :endgroup)
(setq ingroup nil cnt 0)
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((eq (car e) :startgrouptag)
+ (setq intaggroup t)
+ (unless (zerop cnt)
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "[ "))
+ ((eq (car e) :endgrouptag)
+ (setq intaggroup nil cnt 0)
+ (insert "]\n"))
((equal e '(:newline))
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n")
(setq e (car tbl))
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) nil)
+ ((equal e '(:grouptags)) (insert " : "))
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -14815,27 +15237,27 @@ Returns the new tags string, or nil to not change the current settings."
(setq char (1+ char)))
(setq c2 c1))
(setq c (or c2 char)))
- (if ingroup (push tg (car groups)))
+ (when ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
(cond
((not (assoc tg table))
(org-get-todo-face tg))
((member tg current) c-face)
((member tg inherited) i-face))))
- (if (equal (caar tbl) :grouptags)
- (org-add-props tg nil 'face 'org-tag-group))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (when (equal (caar tbl) :grouptags)
+ (org-add-props tg nil 'face 'org-tag-group))
+ (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
- (when (= (setq cnt (1+ cnt)) ncol)
+ (when (= (incf cnt) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (when (or ingroup intaggroup) (insert " "))
(setq cnt 0)))))
(setq ntable (nreverse ntable))
(insert "\n")
(goto-char (point-min))
- (if (not expert) (org-fit-window-to-buffer))
+ (unless expert (org-fit-window-to-buffer))
(setq rtn
(catch 'exit
(while t
@@ -14865,7 +15287,7 @@ Returns the new tags string, or nil to not change the current settings."
(setq quit-flag t))
((= c ?\ )
(setq current nil)
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((= c ?\t)
(condition-case nil
(setq tg (org-icompleting-read
@@ -14879,28 +15301,26 @@ Returns the new tags string, or nil to not change the current settings."
(if (member tg current)
(setq current (delete tg current))
(push tg current)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c todo-table) tg (car e))
(with-current-buffer buf
(save-excursion (org-todo tg)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c ntable) tg (car e))
(if (member tg current)
(setq current (delete tg current))
(loop for g in groups do
- (if (member tg g)
- (mapc (lambda (x)
- (setq current (delete x current)))
- g)))
+ (when (member tg g)
+ (dolist (x g) (setq current (delete x current)))))
(push tg current))
- (if exit-after-next (setq exit-after-next 'now))))
+ (when exit-after-next (setq exit-after-next 'now))))
;; Create a sorted list
(setq current
(sort current
(lambda (a b)
(assoc b (cdr (memq (assoc a ntable) ntable))))))
- (if (eq exit-after-next 'now) (throw 'exit t))
+ (when (eq exit-after-next 'now) (throw 'exit t))
(goto-char (point-min))
(beginning-of-line 2)
(delete-region (point) (point-at-eol))
@@ -14938,16 +15358,16 @@ Returns the new tags string, or nil to not change the current settings."
(defun org-get-buffer-tags ()
"Get a table of all tags used in the buffer, for completion."
- (let (tags)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t)
- (when (equal (char-after (point-at-bol 0)) ?*)
- (mapc (lambda (x) (add-to-list 'tags x))
- (org-split-string (org-match-string-no-properties 1) ":")))))
- (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags)
- (mapcar 'list tags)))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((tag-re (concat org-outline-regexp-bol
+ "\\(?:.*?[ \t]\\)?"
+ (org-re ":\\([[:alnum:]_@#%:]+\\):[ \t]*$")))
+ tags)
+ (while (re-search-forward tag-re nil t)
+ (dolist (tag (org-split-string (org-match-string-no-properties 1) ":"))
+ (push tag tags)))
+ (mapcar #'list (append org-file-tags (org-uniquify tags))))))
;;;; The mapping API
@@ -15024,7 +15444,6 @@ a *different* entry, you cannot use these techniques."
org-todo-keywords-for-agenda
org-done-keywords-for-agenda
org-todo-keyword-alist-for-agenda
- org-drawers-for-agenda
org-tag-alist-for-agenda
todo-only)
@@ -15083,15 +15502,12 @@ a *different* entry, you cannot use these techniques."
(setq res (append res (org-scan-tags func matcher todo-only))))))))))
res)))
-;;;; Properties
-
-;;; Setting and retrieving properties
+;;; Properties API
(defconst org-special-properties
- '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY"
- "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T")
- "The special properties valid in Org-mode.
-
+ '("ALLTAGS" "BLOCKED" "CLOCKSUM" "CLOCKSUM_T" "CLOSED" "DEADLINE" "FILE"
+ "ITEM" "PRIORITY" "SCHEDULED" "TAGS" "TIMESTAMP" "TIMESTAMP_IA" "TODO")
+ "The special properties valid in Org mode.
These are properties that are not defined in the property drawer,
but in some other way.")
@@ -15100,59 +15516,80 @@ but in some other way.")
"LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
"TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
"EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
- "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE"
+ "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED"
"ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE"
"CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS")
- "Some properties that are used by Org-mode for various purposes.
+ "Some properties that are used by Org mode for various purposes.
Being in this list makes sure that they are offered for completion.")
-(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
- "Regular expression matching the first line of a property drawer.")
-
-(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
- "Regular expression matching the last line of a property drawer.")
-
-(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
- "Regular expression matching the first line of a property drawer.")
-
-(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
- "Regular expression matching the first line of a property drawer.")
-
-(defconst org-property-drawer-re
- (concat "\\(" org-property-start-re "\\)[^\000]*\\("
- org-property-end-re "\\)\n?")
- "Matches an entire property drawer.")
+(defun org--update-property-plist (key val props)
+ "Associate KEY to VAL in alist PROPS.
+Modifications are made by side-effect. Return new alist."
+ (let* ((appending (string= (substring key -1) "+"))
+ (key (if appending (substring key 0 -1) key))
+ (old (assoc-string key props t)))
+ (if (not old) (cons (cons key val) props)
+ (setcdr old (if appending (concat (cdr old) " " val) val))
+ props)))
+
+(defun org-get-property-block (&optional beg force)
+ "Return the (beg . end) range of the body of the property drawer.
+BEG is the beginning of the current subtree, or of the part
+before the first headline. If it is not given, it will be found.
+If the drawer does not exist, create it if FORCE is non-nil, or
+return nil."
+ (org-with-wide-buffer
+ (when beg (goto-char beg))
+ (unless (org-before-first-heading-p)
+ (let ((beg (cond (beg)
+ ((or (not (featurep 'org-inlinetask))
+ (org-inlinetask-in-task-p))
+ (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))
+ (cond ((looking-at org-property-drawer-re)
+ (forward-line)
+ (cons (point) (progn (goto-char (match-end 0))
+ (line-beginning-position))))
+ (force
+ (goto-char beg)
+ (org-insert-property-drawer)
+ (let ((pos (save-excursion (search-forward ":END:")
+ (line-beginning-position))))
+ (cons pos pos))))))))
-(defconst org-clock-drawer-re
- (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\("
- org-property-end-re "\\)\n?")
- "Matches an entire clock drawer.")
+(defun org-at-property-p ()
+ "Non-nil when point is inside a property drawer.
+See `org-property-re' for match data, if applicable."
+ (save-excursion
+ (beginning-of-line)
+ (and (looking-at org-property-re)
+ (let ((property-drawer (save-match-data (org-get-property-block))))
+ (and property-drawer
+ (>= (point) (car property-drawer))
+ (< (point) (cdr property-drawer)))))))
(defun org-property-action ()
"Do an action on properties."
(interactive)
- (let (c)
- (org-at-property-p)
- (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
- (setq c (read-char-exclusive))
- (cond
- ((equal c ?s)
- (call-interactively 'org-set-property))
- ((equal c ?d)
- (call-interactively 'org-delete-property))
- ((equal c ?D)
- (call-interactively 'org-delete-property-globally))
- ((equal c ?c)
- (call-interactively 'org-compute-property-at-point))
- (t (user-error "No such property action %c" c)))))
+ (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
+ (?s (call-interactively #'org-set-property))
+ (?d (call-interactively #'org-delete-property))
+ (?D (call-interactively #'org-delete-property-globally))
+ (?c (call-interactively #'org-compute-property-at-point))
+ (otherwise (user-error "No such property action %c" c)))))
(defun org-inc-effort ()
"Increment the value of the effort property in the current entry."
(interactive)
(org-set-effort nil t))
-(defvar org-clock-effort) ;; Defined in org-clock.el
-(defvar org-clock-current-task) ;; Defined in org-clock.el
+(defvar org-clock-effort) ; Defined in org-clock.el.
+(defvar org-clock-current-task) ; Defined in org-clock.el.
(defun org-set-effort (&optional value increment)
"Set the effort property of the current entry.
With numerical prefix arg, use the nth allowed value, 0 stands for the
@@ -15197,218 +15634,269 @@ When INCREMENT is non-nil, set the property to the next allowed value."
existing nil nil "" nil cur))))))
(unless (equal (org-entry-get nil prop) val)
(org-entry-put nil prop val))
- (save-excursion
- (org-back-to-heading t)
- (put-text-property (point-at-bol) (point-at-eol) 'org-effort val))
+ (org-refresh-property
+ '((effort . identity)
+ (effort-minutes . org-duration-string-to-minutes))
+ val)
(when (string= heading org-clock-current-task)
- (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort))
+ (setq org-clock-effort (get-text-property (point-at-bol) 'effort))
(org-clock-update-mode-line))
(message "%s is now %s" prop val)))
-(defun org-at-property-p ()
- "Is cursor inside a property drawer?"
- (save-excursion
- (when (equal 'node-property (car (org-element-at-point)))
- (beginning-of-line 1)
- (looking-at org-property-re))))
+(defun org-entry-properties (&optional pom which)
+ "Get all properties of the current entry.
+
+When POM is a buffer position, get all properties from the entry
+there instead.
+
+This includes the TODO keyword, the tags, time strings for
+deadline, scheduled, and clocking, and any additional properties
+defined in the entry.
-(defun org-get-property-block (&optional beg end force)
- "Return the (beg . end) range of the body of the property drawer.
-BEG and END are the beginning and end of the current subtree, or of
-the part before the first headline. If they are not given, they will
-be found. If the drawer does not exist and FORCE is non-nil, create
-the drawer."
- (catch 'exit
- (save-excursion
- (let* ((beg (or beg (and (org-before-first-heading-p) (point-min))
- (progn (org-back-to-heading t) (point))))
- (end (or end (and (not (outline-next-heading)) (point-max))
- (point))))
- (goto-char beg)
- (if (re-search-forward org-property-start-re end t)
- (setq beg (1+ (match-end 0)))
- (if force
- (save-excursion
- (org-insert-property-drawer)
- (setq end (progn (outline-next-heading) (point))))
- (throw 'exit nil))
- (goto-char beg)
- (if (re-search-forward org-property-start-re end t)
- (setq beg (1+ (match-end 0)))))
- (if (re-search-forward org-property-end-re end t)
- (setq end (match-beginning 0))
- (or force (throw 'exit nil))
- (goto-char beg)
- (setq end beg)
- (org-indent-line)
- (insert ":END:\n"))
- (cons beg end)))))
-
-(defun org-entry-properties (&optional pom which specific)
- "Get all properties of the entry at point-or-marker POM.
-This includes the TODO keyword, the tags, time strings for deadline,
-scheduled, and clocking, and any additional properties defined in the
-entry. The return value is an alist, keys may occur multiple times
-if the property key was used several times.
-POM may also be nil, in which case the current entry is used.
If WHICH is nil or `all', get all properties. If WHICH is
-`special' or `standard', only get that subclass. If WHICH
-is a string only get exactly this property. SPECIFIC can be a string, the
-specific property we are interested in. Specifying it can speed
-things up because then unnecessary parsing is avoided."
- (setq which (or which 'all))
- (org-with-wide-buffer
- (org-with-point-at pom
- (let ((clockstr (substring org-clock-string 0 -1))
- (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
- (case-fold-search nil)
- beg end range props sum-props key key1 value string clocksum clocksumt)
- (when (and (derived-mode-p 'org-mode)
- (ignore-errors (org-back-to-heading t)))
- (setq beg (point))
- (setq sum-props (get-text-property (point) 'org-summaries))
- (setq clocksum (get-text-property (point) :org-clock-minutes)
- clocksumt (get-text-property (point) :org-clock-minutes-today))
- (outline-next-heading)
- (setq end (point))
- (when (memq which '(all special))
- ;; Get the special properties, like TODO and tags
- (goto-char beg)
- (when (and (or (not specific) (string= specific "TODO"))
- (looking-at org-todo-line-regexp) (match-end 2))
- (push (cons "TODO" (org-match-string-no-properties 2)) props))
- (when (and (or (not specific) (string= specific "PRIORITY"))
- (looking-at org-priority-regexp))
- (push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
- (when (or (not specific) (string= specific "FILE"))
- (push (cons "FILE" buffer-file-name) props))
- (when (and (or (not specific) (string= specific "TAGS"))
- (setq value (org-get-tags-string))
- (string-match "\\S-" value))
- (push (cons "TAGS" value) props))
- (when (and (or (not specific) (string= specific "ALLTAGS"))
- (setq value (org-get-tags-at)))
- (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":")
- ":"))
- props))
- (when (or (not specific) (string= specific "BLOCKED"))
- (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props))
- (when (or (not specific)
- (member specific
- '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
- "TIMESTAMP" "TIMESTAMP_IA")))
- (catch 'match
- (while (and (re-search-forward org-maybe-keyword-time-regexp end t)
- (not (text-property-any 0 (length (match-string 0))
- 'face 'font-lock-comment-face
- (match-string 0))))
- (setq key (if (match-end 1)
- (substring (org-match-string-no-properties 1)
- 0 -1))
- string (if (equal key clockstr)
- (org-trim
- (buffer-substring-no-properties
- (match-beginning 3) (goto-char
- (point-at-eol))))
- (substring (org-match-string-no-properties 3)
- 1 -1)))
- ;; Get the correct property name from the key. This is
- ;; necessary if the user has configured time keywords.
- (setq key1 (concat key ":"))
- (cond
- ((not key)
- (setq key
- (if (= (char-after (match-beginning 3)) ?\[)
- "TIMESTAMP_IA" "TIMESTAMP")))
- ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
- ((equal key1 org-deadline-string) (setq key "DEADLINE"))
- ((equal key1 org-closed-string) (setq key "CLOSED"))
- ((equal key1 org-clock-string) (setq key "CLOCK")))
- (if (and specific (equal key specific) (not (equal key "CLOCK")))
- (progn
- (push (cons key string) props)
- ;; no need to search further if match is found
- (throw 'match t))
- (when (or (equal key "CLOCK") (not (assoc key props)))
- (push (cons key string) props)))))))
-
- (when (memq which '(all standard))
- ;; Get the standard properties, like :PROP: ...
- (setq range (org-get-property-block beg end))
- (when range
- (goto-char (car range))
- (while (re-search-forward org-property-re
- (cdr range) t)
- (setq key (org-match-string-no-properties 2)
- value (org-trim (or (org-match-string-no-properties 3) "")))
- (unless (member key excluded)
- (push (cons key (or value "")) props)))))
- (if clocksum
- (push (cons "CLOCKSUM"
- (org-columns-number-to-string (/ (float clocksum) 60.)
- 'add_times))
- props))
- (if clocksumt
- (push (cons "CLOCKSUM_T"
- (org-columns-number-to-string (/ (float clocksumt) 60.)
- 'add_times))
- props))
- (unless (assoc "CATEGORY" props)
- (push (cons "CATEGORY" (org-get-category)) props))
- (append sum-props (nreverse props)))))))
+`special' or `standard', only get that subclass. If WHICH is
+a string, only get that property.
+
+Return value is an alist. Keys are properties, as upcased
+strings."
+ (org-with-point-at pom
+ (when (and (derived-mode-p 'org-mode)
+ (ignore-errors (org-back-to-heading t)))
+ (catch 'exit
+ (let* ((beg (point))
+ (specific (and (stringp which) (upcase which)))
+ (which (cond ((not specific) which)
+ ((member specific org-special-properties) 'special)
+ (t 'standard)))
+ props)
+ ;; Get the special properties, like TODO and TAGS.
+ (when (memq which '(nil all special))
+ (when (or (not specific) (string= specific "CLOCKSUM"))
+ (let ((clocksum (get-text-property (point) :org-clock-minutes)))
+ (when clocksum
+ (push (cons "CLOCKSUM"
+ (org-columns-number-to-string
+ (/ (float clocksum) 60.) 'add_times))
+ props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "CLOCKSUM_T"))
+ (let ((clocksumt (get-text-property (point)
+ :org-clock-minutes-today)))
+ (when clocksumt
+ (push (cons "CLOCKSUM_T"
+ (org-columns-number-to-string
+ (/ (float clocksumt) 60.) 'add_times))
+ 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))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "TODO"))
+ (when (and (looking-at org-todo-line-regexp) (match-end 2))
+ (push (cons "TODO" (org-match-string-no-properties 2)) props))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "PRIORITY"))
+ (when (looking-at org-priority-regexp)
+ (push (cons "PRIORITY" (org-match-string-no-properties 2))
+ props))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "FILE"))
+ (push (cons "FILE" (buffer-file-name (buffer-base-buffer)))
+ props)
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "TAGS"))
+ (let ((value (org-string-nw-p (org-get-tags-string))))
+ (when value (push (cons "TAGS" value) props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "ALLTAGS"))
+ (let ((value (org-get-tags-at)))
+ (when value
+ (push (cons "ALLTAGS"
+ (format ":%s:" (mapconcat #'identity value ":")))
+ props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "BLOCKED"))
+ (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)
+ (when specific (throw 'exit props)))
+ (when (or (not specific)
+ (member specific '("CLOSED" "DEADLINE" "SCHEDULED")))
+ (forward-line)
+ (when (org-looking-at-p org-planning-line-re)
+ (end-of-line)
+ (let ((bol (line-beginning-position))
+ ;; Backward compatibility: time keywords used to
+ ;; be configurable (before 8.3). Make sure we
+ ;; get the correct keyword.
+ (key-assoc `(("CLOSED" . ,org-closed-string)
+ ("DEADLINE" . ,org-deadline-string)
+ ("SCHEDULED" . ,org-scheduled-string))))
+ (dolist (pair (if specific (list (assoc specific key-assoc))
+ key-assoc))
+ (save-excursion
+ (when (search-backward (cdr pair) bol t)
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (and (looking-at org-ts-regexp-both)
+ (push (cons (car pair)
+ (org-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
+ ((string= specific "TIMESTAMP")
+ org-ts-regexp)
+ ((string= specific "TIMESTAMP_IA")
+ org-ts-regexp-inactive)
+ ((assoc "TIMESTAMP_IA" ts)
+ org-ts-regexp)
+ ((assoc "TIMESTAMP" ts)
+ org-ts-regexp-inactive)
+ (t org-ts-regexp-both))))
+ (catch 'next
+ (while (re-search-forward regexp end t)
+ (backward-char)
+ (let ((object (org-element-context)))
+ ;; Accept to match timestamps in node
+ ;; properties, too.
+ (when (memq (org-element-type object)
+ '(node-property timestamp))
+ (let ((type
+ (org-element-property :type object)))
+ (cond
+ ((and (memq type '(active active-range))
+ (not (equal specific "TIMESTAMP_IA")))
+ (unless (assoc "TIMESTAMP" ts)
+ (push (cons "TIMESTAMP"
+ (org-element-property
+ :raw-value object))
+ ts)
+ (when specific (throw 'exit ts))))
+ ((and (memq type '(inactive inactive-range))
+ (not (string= specific "TIMESTAMP")))
+ (unless (assoc "TIMESTAMP_IA" ts)
+ (push (cons "TIMESTAMP_IA"
+ (org-element-property
+ :raw-value object))
+ ts)
+ (when specific (throw 'exit ts))))))
+ ;; Both timestamp types are found,
+ ;; move to next part.
+ (when (= (length ts) 2) (throw 'next ts)))))
+ ts)))))
+ (goto-char beg)
+ ;; First look for timestamps within headline.
+ (let ((ts (funcall find-ts (line-end-position) nil)))
+ (if (= (length ts) 2) (setq props (nconc ts props))
+ (forward-line)
+ ;; Then find timestamps in the section, skipping
+ ;; planning line.
+ (when (org-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))))))))
+ ;; Get the standard properties, like :PROP:.
+ (when (memq which '(nil all standard))
+ ;; If we are looking after a specific property, delegate
+ ;; to `org-entry-get', which is faster. However, make an
+ ;; exception for "CATEGORY", since it can be also set
+ ;; through keywords (i.e. #+CATEGORY).
+ (if (and specific (not (equal specific "CATEGORY")))
+ (let ((value (org-entry-get beg specific nil t)))
+ (throw 'exit (and value (list (cons specific value)))))
+ (let ((range (org-get-property-block beg)))
+ (when range
+ (let ((end (cdr range)) seen-base)
+ (goto-char (car range))
+ ;; Unlike to `org--update-property-plist', we
+ ;; handle the case where base values is found
+ ;; 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))
+ (key-base (if extendp (substring key 0 -1) key))
+ (value (org-match-string-no-properties 3)))
+ (cond
+ ((member-ignore-case key-base org-special-properties))
+ (extendp
+ (setq props
+ (org--update-property-plist key value props)))
+ ((member key seen-base))
+ (t (push key seen-base)
+ (let ((p (assoc-string key props t)))
+ (if p (setcdr p (concat value " " (cdr p)))
+ (push (cons key value) props))))))))))))
+ (unless (assoc "CATEGORY" props)
+ (push (cons "CATEGORY" (org-get-category beg)) props)
+ (when (string= specific "CATEGORY") (throw 'exit props)))
+ ;; Return value.
+ (append (get-text-property beg 'org-summaries) props))))))
+
+(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
+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."
+ (let ((range (org-get-property-block)))
+ (when range
+ (goto-char (car range))
+ (let* ((case-fold-search t)
+ (end (cdr range))
+ (value
+ ;; Base value.
+ (save-excursion
+ (let ((v (and (re-search-forward
+ (org-re-property property nil t) end t)
+ (org-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)))
+ ;; Return final values.
+ (and (not (equal value '(nil))) (nreverse value))))))
(defun org-entry-get (pom property &optional inherit literal-nil)
"Get value of PROPERTY for entry or content at point-or-marker POM.
-If INHERIT is non-nil and the entry does not have the property,
-then also check higher levels of the hierarchy.
-If INHERIT is the symbol `selective', use inheritance only if the setting
-in `org-use-property-inheritance' selects PROPERTY for inheritance.
-If the property is present but empty, the return value is the empty string.
-If the property is not present at all, nil is returned.
-
-Return the value as a string.
-If LITERAL-NIL is set, return the string value \"nil\" as a string,
-do not interpret it as the list atom nil. This is used for inheritance
-when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
+If INHERIT is non-nil and the entry does not have the property,
+then also check higher levels of the hierarchy. If INHERIT is
+the symbol `selective', use inheritance only if the setting in
+`org-use-property-inheritance' selects PROPERTY for inheritance.
+
+If the property is present but empty, the return value is the
+empty string. If the property is not present at all, nil is
+returned. In any other case, return the value as a string.
+Search is case-insensitive.
+
+If LITERAL-NIL is set, return the string value \"nil\" as
+a string, do not interpret it as the list atom nil. This is used
+for inheritance when a \"nil\" value can supersede a non-nil
+value higher up the hierarchy."
(org-with-point-at pom
- (if (and inherit (if (eq inherit 'selective)
- (org-property-inherit-p property)
- t))
- (org-entry-get-with-inheritance property literal-nil)
- (if (member property org-special-properties)
- ;; We need a special property. Use `org-entry-properties'
- ;; to retrieve it, but specify the wanted property
- (cdr (assoc property (org-entry-properties nil 'special property)))
- (org-with-wide-buffer
- (let ((range (org-get-property-block)))
- (when (and range (not (eq (car range) (cdr range)))
- (save-excursion
- (goto-char (car range))
- (re-search-forward
- (concat (org-re-property property) "\\|"
- (org-re-property (concat property "+")))
- (cdr range) t)))
- (let* ((props
- (list (or (assoc property org-file-properties)
- (assoc property org-global-properties)
- (assoc property org-global-properties-fixed))))
- (ap (lambda (key)
- (when (re-search-forward
- (org-re-property key) (cdr range) t)
- (setq props
- (org-update-property-plist
- key
- (if (match-end 3)
- (org-match-string-no-properties 3) "")
- props)))))
- val)
- (goto-char (car range))
- (funcall ap property)
- (goto-char (car range))
- (while (funcall ap (concat property "+")))
- (setq val (cdr (assoc property props)))
- (when val (if literal-nil val (org-not-nil val)))))))))))
+ (cond
+ ((member-ignore-case property (cons "CATEGORY" org-special-properties))
+ ;; We need a special property. Use `org-entry-properties' to
+ ;; retrieve it, but specify the wanted property.
+ (cdr (assoc-string property (org-entry-properties nil property))))
+ ((and inherit
+ (or (not (eq inherit 'selective)) (org-property-inherit-p property)))
+ (org-entry-get-with-inheritance property literal-nil))
+ (t
+ (let* ((local (org-property--local-values property literal-nil))
+ (value (and local (mapconcat #'identity (delq nil local) " "))))
+ (if literal-nil value (org-not-nil value)))))))
(defun org-property-or-variable-value (var &optional inherit)
"Check if there is a property fixing the value of VAR.
@@ -15418,26 +15906,28 @@ If yes, return this value. If not, return the current value of the variable."
(read prop)
(symbol-value var))))
-(defun org-entry-delete (pom property &optional delete-empty-drawer)
- "Delete the property PROPERTY from entry at point-or-marker POM.
-When optional argument DELETE-EMPTY-DRAWER is a string, it defines
-an empty drawer to delete."
- (org-with-point-at pom
- (if (member property org-special-properties)
- nil ; cannot delete these properties.
+(defun org-entry-delete (pom property)
+ "Delete PROPERTY from entry at point-or-marker POM.
+Accumulated properties, i.e. PROPERTY+, are also removed. Return
+non-nil when a property was removed."
+ (unless (member property org-special-properties)
+ (org-with-point-at pom
(let ((range (org-get-property-block)))
- (if (and range
- (goto-char (car range))
- (re-search-forward
- (org-re-property property nil t)
- (cdr range) t))
- (progn
- (delete-region (match-beginning 0) (1+ (point-at-eol)))
- (and delete-empty-drawer
- (org-remove-empty-drawer-at
- delete-empty-drawer (car range)))
- t)
- nil)))))
+ (when range
+ (let* ((begin (car range))
+ (origin (cdr range))
+ (end (copy-marker origin))
+ (re (org-re-property
+ (concat (regexp-quote property) "\\+?") t t)))
+ (goto-char begin)
+ (while (re-search-forward re end t)
+ (delete-region (match-beginning 0) (line-beginning-position 2)))
+ ;; If drawer is empty, remove it altogether.
+ (when (= begin end)
+ (delete-region (line-beginning-position 0)
+ (line-beginning-position 2)))
+ ;; Return non-nil if some property was removed.
+ (prog1 (/= end origin) (set-marker end nil))))))))
;; Multi-values properties are properties that contain multiple values
;; These values are assumed to be single words, separated by whitespace.
@@ -15514,24 +16004,32 @@ If the value found is \"nil\", return nil to show that the property
should be considered as undefined (this is the meaning of nil here).
However, if LITERAL-NIL is set, return the string value \"nil\" instead."
(move-marker org-entry-property-inherited-from nil)
- (let (tmp)
- (save-excursion
- (save-restriction
- (widen)
- (catch 'ex
- (while t
- (when (setq tmp (org-entry-get nil property nil literal-nil))
- (or (ignore-errors (org-back-to-heading t))
- (goto-char (point-min)))
- (move-marker org-entry-property-inherited-from (point))
- (throw 'ex tmp))
- (or (ignore-errors (org-up-heading-safe))
- (throw 'ex nil))))))
- (setq tmp (or tmp
- (cdr (assoc property org-file-properties))
- (cdr (assoc property org-global-properties))
- (cdr (assoc property org-global-properties-fixed))))
- (if literal-nil tmp (org-not-nil tmp))))
+ (org-with-wide-buffer
+ (let (value)
+ (catch 'exit
+ (while t
+ (let ((v (org-property--local-values property literal-nil)))
+ (when v
+ (setq value
+ (concat (mapconcat #'identity (delq nil v) " ")
+ (and value " ")
+ value)))
+ (cond
+ ((car v)
+ (org-back-to-heading t)
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'exit nil))
+ ((org-up-heading-safe))
+ (t
+ (let ((global
+ (cdr (or (assoc-string property org-file-properties t)
+ (assoc-string property org-global-properties t)
+ (assoc-string property org-global-properties-fixed t)))))
+ (cond ((not global))
+ (value (setq value (concat global " " value)))
+ (t (setq value global))))
+ (throw 'exit nil))))))
+ (if literal-nil value (org-not-nil value)))))
(defvar org-property-changed-functions nil
"Hook called when the value of a property has changed.
@@ -15540,177 +16038,176 @@ and the new value.")
(defun org-entry-put (pom property value)
"Set PROPERTY to VALUE for entry at point-or-marker POM.
-If the value is `nil', it is converted to the empty string.
-If it is not a string, an error is raised."
+
+If the value is nil, it is converted to the empty string. If
+it is not a string, an error is raised.
+
+PROPERTY can be any regular property (see
+`org-special-properties'). It can also be \"TODO\",
+\"PRIORITY\", \"SCHEDULED\" and \"DEADLINE\".
+
+For the last two properties, VALUE may have any of the special
+values \"earlier\" and \"later\". The function then increases or
+decreases scheduled or deadline date by one day."
(cond ((null value) (setq value ""))
- ((not (stringp value))
- (error "Properties values should be strings.")))
+ ((not (stringp value)) (error "Properties values should be strings")))
(org-with-point-at pom
- (org-back-to-heading t)
- (let ((beg (point)) (end (save-excursion (outline-next-heading) (point)))
- range)
+ (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
+ (org-back-to-heading t)
+ (org-with-limited-levels (org-back-to-heading t)))
+ (let ((beg (point)))
(cond
((equal property "TODO")
- (when (and (string-match "\\S-" value)
- (not (member value org-todo-keywords-1)))
- (user-error "\"%s\" is not a valid TODO state" value))
- (if (or (not value)
- (not (string-match "\\S-" value)))
- (setq value 'none))
+ (cond ((not (org-string-nw-p value)) (setq value 'none))
+ ((not (member value org-todo-keywords-1))
+ (user-error "\"%s\" is not a valid TODO state" value)))
(org-todo value)
(org-set-tags nil 'align))
((equal property "PRIORITY")
- (org-priority (if (and value (string-match "\\S-" value))
- (string-to-char value) ?\ ))
+ (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
(org-set-tags nil 'align))
- ((equal property "CLOCKSUM")
- (if (not (re-search-forward
- (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t))
- (error "Cannot find a clock log")
- (goto-char (- (match-end 1) 2))
- (cond
- ((eq value 'earlier) (org-timestamp-down))
- ((eq value 'later) (org-timestamp-up)))
- (org-clock-sum-current-item)))
((equal property "SCHEDULED")
- (if (re-search-forward org-scheduled-time-regexp end t)
- (cond
- ((eq value 'earlier) (org-timestamp-change -1 'day))
- ((eq value 'later) (org-timestamp-change 1 'day))
- (t (call-interactively 'org-schedule)))
- (call-interactively 'org-schedule)))
+ (forward-line)
+ (if (and (org-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))
+ ((string= value "later") (org-timestamp-change 1 'day))
+ ((string= value "") (org-schedule '(4)))
+ (t (org-schedule nil value)))
+ (if (member value '("earlier" "later" ""))
+ (call-interactively #'org-schedule)
+ (org-schedule nil value))))
((equal property "DEADLINE")
- (if (re-search-forward org-deadline-time-regexp end t)
- (cond
- ((eq value 'earlier) (org-timestamp-change -1 'day))
- ((eq value 'later) (org-timestamp-change 1 'day))
- (t (call-interactively 'org-deadline)))
- (call-interactively 'org-deadline)))
+ (forward-line)
+ (if (and (org-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))
+ ((string= value "later") (org-timestamp-change 1 'day))
+ ((string= value "") (org-deadline '(4)))
+ (t (org-deadline nil value)))
+ (if (member value '("earlier" "later" ""))
+ (call-interactively #'org-deadline)
+ (org-deadline nil value))))
((member property org-special-properties)
- (error "The %s property can not yet be set with `org-entry-put'"
- property))
- (t ; a non-special property
- (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21
- (setq range (org-get-property-block beg end 'force))
+ (error "The %s property cannot be set with `org-entry-put'" property))
+ (t
+ (let* ((range (org-get-property-block beg 'force))
+ (end (cdr range))
+ (case-fold-search t))
(goto-char (car range))
- (if (re-search-forward
- (org-re-property property nil t) (cdr range) t)
- (progn
- (delete-region (match-beginning 0) (match-end 0))
- (goto-char (match-beginning 0)))
- (goto-char (cdr range))
+ (if (re-search-forward (org-re-property property nil t) end t)
+ (progn (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0)))
+ (goto-char end)
(insert "\n")
- (backward-char 1)
- (org-indent-line))
+ (backward-char))
(insert ":" property ":")
- (and value (insert " " value))
+ (when value (insert " " value))
(org-indent-line)))))
(run-hook-with-args 'org-property-changed-functions property value)))
-(defun org-buffer-property-keys (&optional include-specials include-defaults include-columns)
+(defun org-buffer-property-keys (&optional specials defaults columns)
"Get all property keys in the current buffer.
-With INCLUDE-SPECIALS, also list the special properties that reflect things
-like tags and TODO state.
-With INCLUDE-DEFAULTS, also include properties that has special meaning
-internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING
-and others.
-With INCLUDE-COLUMNS, also include property names given in COLUMN
-formats in the current buffer."
- (let (rtn range cfmt s p)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward org-property-start-re nil t)
- (setq range (org-get-property-block))
- (goto-char (car range))
- (while (re-search-forward org-property-re
- (cdr range) t)
- (add-to-list 'rtn (org-match-string-no-properties 2)))
- (outline-next-heading))))
- (when include-specials
- (setq rtn (append org-special-properties rtn)))
+When SPECIALS is non-nil, also list the special properties that
+reflect things like tags and TODO state.
- (when include-defaults
- (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)
- (add-to-list 'rtn org-effort-property))
+When DEFAULTS is non-nil, also include properties that has
+special meaning internally: ARCHIVE, CATEGORY, SUMMARY,
+DESCRIPTION, LOCATION, and LOGGING and others.
- (when include-columns
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward
- "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)"
- nil t)
- (setq cfmt (match-string 2) s 0)
- (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)")
- cfmt s)
- (setq s (match-end 0)
- p (match-string 1 cfmt))
- (unless (or (equal p "ITEM")
- (member p org-special-properties))
- (add-to-list 'rtn (match-string 1 cfmt))))))))
-
- (sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
+When COLUMNS in non-nil, also include property names given in
+COLUMN formats in the current buffer."
+ (let ((case-fold-search t)
+ (props (append
+ (and specials org-special-properties)
+ (and defaults (cons org-effort-property org-default-properties))
+ nil)))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward org-property-start-re nil t)
+ (let ((range (org-get-property-block)))
+ (catch 'skip
+ (unless range
+ (when (and (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))
+ (throw 'skip nil))
+ (goto-char (car range))
+ (let ((begin (car range))
+ (end (cdr range)))
+ ;; Make sure that found property block is not located
+ ;; before current point, as it would generate an infloop.
+ ;; It can happen, for example, in the following
+ ;; situation:
+ ;;
+ ;; * Headline
+ ;; :PROPERTIES:
+ ;; ...
+ ;; :END:
+ ;; *************** Inlinetask
+ ;; #+BEGIN_EXAMPLE
+ ;; :PROPERTIES:
+ ;; #+END_EXAMPLE
+ ;;
+ (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))))
+ ;; Only add true property name, not extension symbol.
+ (add-to-list 'props
+ (if (not (org-string-match-p "\\+\\'" p)) p
+ (substring p 0 -1))))
+ (forward-line))))
+ (outline-next-heading)))
+ (when columns
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t)
+ (let ((element (org-element-at-point)))
+ (when (memq (org-element-type element) '(keyword node-property))
+ (let ((value (org-element-property :value element))
+ (start 0))
+ (while (string-match "%[0-9]*\\(\\S-+\\)" value start)
+ (setq start (match-end 0))
+ (let ((p (org-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))))))
(defun org-property-values (key)
- "Return a list of all values of property KEY in the current buffer."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((re (org-re-property key))
- values)
- (while (re-search-forward re nil t)
- (add-to-list 'values (org-trim (match-string 3))))
- (delete "" values)))))
+ "List all non-nil values of property KEY in current buffer."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (re (org-re-property key))
+ values)
+ (while (re-search-forward re nil t)
+ (add-to-list 'values (org-entry-get (point) key)))
+ values)))
(defun org-insert-property-drawer ()
"Insert a property drawer into the current entry."
- (org-back-to-heading t)
- (looking-at org-outline-regexp)
- (let ((indent (if org-adapt-indentation
- (- (match-end 0) (match-beginning 0))
- 0))
- (beg (point))
- (re (concat "^[ \t]*" org-keyword-time-regexp))
- end hiddenp)
- (outline-next-heading)
- (setq end (point))
- (goto-char beg)
- (while (re-search-forward re end t))
- (setq hiddenp (outline-invisible-p))
- (end-of-line 1)
- (and (equal (char-after) ?\n) (forward-char 1))
- (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)")
- (if (member (match-string 1) '("CLOCK:" ":END:"))
- ;; just skip this line
- (beginning-of-line 2)
- ;; Drawer start, find the end
- (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t)
- (beginning-of-line 1)))
- (org-skip-over-state-notes)
- (skip-chars-backward " \t\n\r")
- (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n)))
- (forward-char 1))
- (goto-char (point-at-eol))
- (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
- (beginning-of-line 0)
- (org-indent-to-column indent)
- (beginning-of-line 2)
- (org-indent-to-column indent)
- (beginning-of-line 0)
- (if hiddenp
- (save-excursion
- (org-back-to-heading t)
- (hide-entry))
- (org-flag-drawer t))))
+ (org-with-wide-buffer
+ (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
+ (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)
+ (let ((inhibit-read-only t))
+ (unless (bolp) (insert "\n"))
+ (let ((begin (point)))
+ (insert ":PROPERTIES:\n:END:\n")
+ (org-indent-region begin (point)))))))
(defun org-insert-drawer (&optional arg drawer)
"Insert a drawer at point.
+When optional argument ARG is non-nil, insert a property drawer.
+
Optional argument DRAWER, when non-nil, is a string representing
drawer's name. Otherwise, the user is prompted for a name.
@@ -15719,23 +16216,14 @@ instead.
Point is left between drawer's boundaries."
(interactive "P")
- (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer
- "LOGBOOK"))
- ;; SYSTEM-DRAWERS is a list of drawer names that are used
- ;; internally by Org. They are meant to be inserted
- ;; automatically.
- (system-drawers `("CLOCK" ,logbook "PROPERTIES"))
- ;; Remove system drawers from list. Note: For some reason,
- ;; `org-completing-read' ignores the predicate while
- ;; `completing-read' handles it fine.
- (drawer (if arg "PROPERTIES"
- (or drawer
- (completing-read
- "Drawer: " org-drawers
- (lambda (d) (not (member d system-drawers))))))))
+ (let* ((drawer (if arg "PROPERTIES"
+ (or drawer (read-from-minibuffer "Drawer: ")))))
(cond
;; 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)))
+ (user-error "Invalid drawer name"))
;; With an active region, insert a drawer at point.
((not (org-region-active-p))
(progn
@@ -15811,28 +16299,16 @@ This is computed according to `org-property-set-functions-alist'."
(defvar org-last-set-property-value nil)
(defun org-read-property-name ()
"Read a property name."
- (let* ((completion-ignore-case t)
- (keys (org-buffer-property-keys nil t t))
- (default-prop (or (save-excursion
- (save-match-data
- (beginning-of-line)
- (and (looking-at "^\\s-*:\\([^:\n]+\\):")
- (null (string= (match-string 1) "END"))
- (match-string 1))))
- org-last-set-property))
- (property (org-icompleting-read
- (concat "Property"
- (if default-prop (concat " [" default-prop "]") "")
- ": ")
- (mapcar 'list keys)
- nil nil nil nil
- default-prop)))
- (if (member property keys)
- property
- (or (cdr (assoc (downcase property)
- (mapcar (lambda (x) (cons (downcase x) x))
- keys)))
- property))))
+ (let ((completion-ignore-case t)
+ (default-prop (or (and (org-at-property-p)
+ (org-match-string-no-properties 2))
+ org-last-set-property)))
+ (org-completing-read
+ (concat "Property"
+ (if default-prop (concat " [" default-prop "]") "")
+ ": ")
+ (mapcar #'list (org-buffer-property-keys nil t t))
+ nil nil nil nil default-prop)))
(defun org-set-property-and-value (use-last)
"Allow to set [PROPERTY]: [value] direction from prompt.
@@ -15869,10 +16345,28 @@ in the current file."
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value))))
-(defun org-delete-property (property &optional delete-empty-drawer)
- "In the current entry, delete PROPERTY.
-When optional argument DELETE-EMPTY-DRAWER is a string, it defines
-an empty drawer to delete."
+(defun org-find-property (property &optional value)
+ "Find first entry in buffer that sets PROPERTY.
+
+When optional argument VALUE is non-nil, only consider an entry
+if it contains PROPERTY set to this value. If PROPERTY should be
+explicitly set to nil, use string \"nil\" for VALUE.
+
+Return position where the entry begins, or nil if there is no
+such entry. If narrowing is in effect, only search the visible
+part of the buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (re (org-re-property property nil (not value) value)))
+ (catch 'exit
+ (while (re-search-forward re nil t)
+ (when (if value (org-at-property-p)
+ (org-entry-get (point) property nil t))
+ (throw 'exit (progn (org-back-to-heading t) (point)))))))))
+
+(defun org-delete-property (property)
+ "In the current entry, delete PROPERTY."
(interactive
(let* ((completion-ignore-case t)
(cat (org-entry-get (point) "CATEGORY"))
@@ -15885,28 +16379,25 @@ an empty drawer to delete."
(list prop)))
(if (not property)
(message "No property to delete in this entry")
- (org-entry-delete nil property delete-empty-drawer)
+ (org-entry-delete nil property)
(message "Property \"%s\" deleted" property)))
(defun org-delete-property-globally (property)
- "Remove PROPERTY globally, from all entries."
+ "Remove PROPERTY globally, from all entries.
+This function ignores narrowing, if any."
(interactive
(let* ((completion-ignore-case t)
(prop (org-icompleting-read
"Globally remove property: "
- (mapcar 'list (org-buffer-property-keys)))))
+ (mapcar #'list (org-buffer-property-keys)))))
(list prop)))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((cnt 0))
- (while (re-search-forward
- (org-re-property property)
- nil t)
- (setq cnt (1+ cnt))
- (delete-region (match-beginning 0) (1+ (point-at-eol))))
- (message "Property \"%s\" removed from %d entries" property cnt)))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (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)))
+ (message "Property \"%s\" removed from %d entries" property count))))
(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
@@ -15946,6 +16437,7 @@ completion."
(while (>= n org-highest-priority)
(push (char-to-string n) vals)
(setq n (1- n)))))
+ ((equal property "CATEGORY"))
((member property org-special-properties))
((setq vals (run-hook-with-args-until-success
'org-property-allowed-value-functions property)))
@@ -15996,9 +16488,10 @@ completion."
(beginning-of-line 1)
(skip-chars-forward " \t")
(when (equal prop org-effort-property)
- (save-excursion
- (org-back-to-heading t)
- (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval))
+ (org-refresh-property
+ '((effort . identity)
+ (effort-minutes . org-duration-string-to-minutes))
+ nval)
(when (string= org-clock-current-task heading)
(setq org-clock-effort nval)
(org-clock-update-mode-line)))
@@ -16073,7 +16566,7 @@ a priority cookie and tags in the standard locations."
"Find Org node headline HEADING in all .org files in directory DIR.
When the target headline is found, return a marker to this location."
(let ((files (directory-files (or dir default-directory)
- nil "\\`[^.#].*\\.org\\'"))
+ t "\\`[^.#].*\\.org\\'"))
file visiting m buffer)
(catch 'found
(while (setq file (pop files))
@@ -16093,19 +16586,10 @@ Return the position where this entry starts, or nil if there is no such entry."
(interactive "sID: ")
(let ((id (cond
((stringp ident) ident)
- ((symbol-name ident) (symbol-name ident))
+ ((symbolp ident) (symbol-name ident))
((numberp ident) (number-to-string ident))
- (t (error "IDENT %s must be a string, symbol or number" ident))))
- (case-fold-search nil))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$")
- nil t)
- (org-back-to-heading t)
- (point))))))
+ (t (error "IDENT %s must be a string, symbol or number" ident)))))
+ (org-with-wide-buffer (org-find-property "ID" id))))
;;;; Timestamps
@@ -16116,17 +16600,16 @@ Return the position where this entry starts, or nil if there is no such entry."
(defun org-time-stamp (arg &optional inactive)
"Prompt for a date/time and insert a time stamp.
+
If the user specifies a time like HH:MM or if this command is
called with at least one prefix argument, the time stamp contains
-the date and the time. Otherwise, only the date is be included.
+the date and the time. Otherwise, only the date is included.
-All parts of a date not specified by the user is filled in from
-the current date/time. So if you just press return without
-typing anything, the time stamp will represent the current
-date/time.
+All parts of a date not specified by the user are filled in from
+the timestamp at point, if any, or the current date/time
+otherwise.
-If there is already a timestamp at the cursor, it will be
-modified.
+If there is already a timestamp at the cursor, it is replaced.
With two universal prefix arguments, insert an active timestamp
with the current time without prompting the user.
@@ -16134,57 +16617,59 @@ with the current time without prompting the user.
When called from lisp, the timestamp is inactive if INACTIVE is
non-nil."
(interactive "P")
- (let* ((ts nil)
- (default-time
- ;; Default time is either today, or, when entering a range,
- ;; the range start.
- (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0)))
- (save-excursion
- (re-search-backward
- (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses
- (- (point) 20) t)))
- (apply 'encode-time (org-parse-time-string (match-string 1)))
- (current-time)))
- (default-input (and ts (org-get-compact-tod ts)))
- (repeater (save-excursion
- (save-match-data
- (beginning-of-line)
- (when (re-search-forward
- "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
- (save-excursion (progn (end-of-line) (point))) t)
- (match-string 0)))))
- org-time-was-given org-end-time-was-given time)
+ (let* ((ts
+ (cond ((org-at-date-range-p t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at (if inactive org-ts-regexp-both org-ts-regexp)))
+ (match-string 0))
+ ((org-at-timestamp-p t) (match-string 0))))
+ ;; Default time is either the timestamp at point or today.
+ ;; When entering a range, only the range start is considered.
+ (default-time (if (not ts) (current-time)
+ (apply #'encode-time (org-parse-time-string ts))))
+ (default-input (and ts (org-get-compact-tod ts)))
+ (repeater (and ts
+ (string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts)
+ (match-string 0 ts)))
+ org-time-was-given
+ org-end-time-was-given
+ (time
+ (and (if (equal arg '(16)) (current-time)
+ ;; Preserve `this-command' and `last-command'.
+ (let ((this-command this-command)
+ (last-command last-command))
+ (org-read-date
+ arg 'totime nil nil default-time default-input
+ inactive))))))
(cond
- ((and (org-at-timestamp-p t)
- (memq last-command '(org-time-stamp org-time-stamp-inactive))
- (memq this-command '(org-time-stamp org-time-stamp-inactive)))
+ ((and ts
+ (memq last-command '(org-time-stamp org-time-stamp-inactive))
+ (memq this-command '(org-time-stamp org-time-stamp-inactive)))
(insert "--")
- (setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil
- default-time default-input inactive)))
(org-insert-time-stamp time (or org-time-was-given arg) inactive))
- ((org-at-timestamp-p t)
- (setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil default-time default-input inactive)))
- (when (org-at-timestamp-p t) ; just to get the match data
- ; (setq inactive (eq (char-after (match-beginning 0)) ?\[))
- (replace-match "")
+ (ts
+ ;; Make sure we're on a timestamp. When in the middle of a date
+ ;; range, move arbitrarily to range end.
+ (unless (org-at-timestamp-p t)
+ (skip-chars-forward "-")
+ (org-at-timestamp-p t))
+ (replace-match "")
+ (setq org-last-changed-timestamp
+ (org-insert-time-stamp
+ time (or org-time-was-given arg)
+ inactive nil nil (list org-end-time-was-given)))
+ (when repeater
+ (backward-char)
+ (insert " " repeater)
(setq org-last-changed-timestamp
- (org-insert-time-stamp
- time (or org-time-was-given arg)
- inactive nil nil (list org-end-time-was-given)))
- (when repeater (goto-char (1- (point))) (insert " " repeater)
- (setq org-last-changed-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater ">"))))
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater ">")))
(message "Timestamp updated"))
- ((equal arg '(16))
- (org-insert-time-stamp (current-time) t inactive))
- (t
- (setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil default-time default-input inactive)))
- (org-insert-time-stamp time (or org-time-was-given arg) inactive
- nil nil (list org-end-time-was-given))))))
+ ((equal arg '(16)) (org-insert-time-stamp time t inactive))
+ (t (org-insert-time-stamp
+ time (or org-time-was-given arg) inactive nil nil
+ (list org-end-time-was-given))))))
;; FIXME: can we use this for something else, like computing time differences?
(defun org-get-compact-tod (s)
@@ -16231,8 +16716,7 @@ So these are more for recording a certain time/date."
(defvar org-read-date-inactive)
(defvar org-read-date-minibuffer-local-map
- (let* ((org-replace-disputed-keys nil)
- (map (make-sparse-keymap)))
+ (let* ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(org-defkey map (kbd ".")
(lambda () (interactive)
@@ -16285,10 +16769,10 @@ So these are more for recording a certain time/date."
(message "")))
(org-defkey map ">"
(lambda () (interactive)
- (org-eval-in-calendar '(scroll-calendar-left 1))))
+ (org-eval-in-calendar '(calendar-scroll-left 1))))
(org-defkey map "<"
(lambda () (interactive)
- (org-eval-in-calendar '(scroll-calendar-right 1))))
+ (org-eval-in-calendar '(calendar-scroll-right 1))))
(org-defkey map "\C-v"
(lambda () (interactive)
(org-eval-in-calendar
@@ -16370,9 +16854,10 @@ user."
(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 nil)
+ (calendar-setup (when (eq calendar-setup 'calendar-only) 'calendar-only))
(calendar-move-hook nil)
(calendar-view-diary-initially-flag nil)
(calendar-view-holidays-initially-flag nil)
@@ -16380,7 +16865,7 @@ user."
(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)
+ ans (org-ans0 "") org-ans1 org-ans2 final cal-frame)
(cond
(from-string (setq ans from-string))
@@ -16388,9 +16873,13 @@ user."
(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
+ (unwind-protect
+ (progn
(calendar-forward-day (- (time-to-days org-def)
(calendar-absolute-from-gregorian
(calendar-current-date))))
@@ -16417,8 +16906,11 @@ user."
(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*")))))
+ (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
@@ -16490,6 +16982,9 @@ user."
(defun org-read-date-analyze (ans org-def org-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)))
delta deltan deltaw deltadef year month day
hour minute second wday pm h2 m2 tl wday1
@@ -16593,16 +17088,35 @@ user."
(setq tl (parse-time-string ans)
day (or (nth 3 tl) (nth 3 org-defdecode))
- month (or (nth 4 tl)
- (if (and org-read-date-prefer-future
- (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode)))
- (prog1 (1+ (nth 4 nowdecode)) (setq futurep t))
- (nth 4 org-defdecode)))
- year (or (and (not kill-year) (nth 5 tl))
- (if (and org-read-date-prefer-future
- (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode)))
- (prog1 (1+ (nth 5 nowdecode)) (setq futurep t))
- (nth 5 org-defdecode)))
+ month
+ (cond ((nth 4 tl))
+ ((not org-read-date-prefer-future) (nth 4 org-defdecode))
+ ;; Day was specified. Make sure DAY+MONTH
+ ;; combination happens in the future.
+ ((nth 3 tl)
+ (setq futurep t)
+ (if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode))
+ (nth 4 nowdecode)))
+ (t (nth 4 org-defdecode)))
+ year
+ (cond ((and (not kill-year) (nth 5 tl)))
+ ((not org-read-date-prefer-future) (nth 5 org-defdecode))
+ ;; Month was guessed in the future and is at least
+ ;; equal to NOWDECODE's. Fix year accordingly.
+ (futurep
+ (if (or (> month (nth 4 nowdecode))
+ (>= day (nth 3 nowdecode)))
+ (nth 5 nowdecode)
+ (1+ (nth 5 nowdecode))))
+ ;; Month was specified. Make sure MONTH+YEAR
+ ;; combination happens in the future.
+ ((nth 4 tl)
+ (setq futurep t)
+ (cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode))
+ ((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode)))
+ ((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode)))
+ (t (nth 5 nowdecode))))
+ (t (nth 5 org-defdecode)))
hour (or (nth 2 tl) (nth 2 org-defdecode))
minute (or (nth 1 tl) (nth 1 org-defdecode))
second (or (nth 0 tl) 0)
@@ -16631,7 +17145,7 @@ user."
day (or iso-weekday wday 1)
wday nil ; to make sure that the trigger below does not match
iso-date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso
+ (calendar-iso-to-absolute
(list iso-week day year))))
; FIXME: Should we also push ISO weeks into the future?
; (when (and org-read-date-prefer-future
@@ -16640,7 +17154,7 @@ user."
; (time-to-days (current-time))))
; (setq year (1+ year)
; iso-date (calendar-gregorian-from-absolute
- ; (calendar-absolute-from-iso
+ ; (calendar-iso-to-absolute
; (list iso-week day year)))))
(setq month (car iso-date)
year (nth 2 iso-date)
@@ -16648,6 +17162,9 @@ user."
(deltan
(setq futurep nil)
(unless deltadef
+ ;; Pass `current-time' result to `decode-time' (instead of
+ ;; calling without arguments) so that only `current-time' has
+ ;; to be overriden in tests.
(let ((now (decode-time (current-time))))
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
(cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
@@ -16765,6 +17282,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
(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.
+See `format-time-string' for the format of TIME.
WITH-HM means use the stamp format that includes the time of the day.
INACTIVE means use square brackets instead of angular ones, so that the
stamp will not contribute to the agenda.
@@ -16837,33 +17355,6 @@ The command returns the inserted time stamp."
(put-text-property beg end 'end-glyph (make-glyph str)))
(put-text-property beg end 'display str))))
-(defun org-translate-time (string)
- "Translate all timestamps in STRING to custom format.
-But do this only if the variable `org-display-custom-times' is set."
- (when org-display-custom-times
- (save-match-data
- (let* ((start 0)
- (re org-ts-regexp-both)
- t1 with-hm inactive tf time str beg end)
- (while (setq start (string-match re string start))
- (setq beg (match-beginning 0)
- end (match-end 0)
- t1 (save-match-data
- (org-parse-time-string (substring string beg end) t))
- with-hm (and (nth 1 t1) (nth 2 t1))
- inactive (equal (substring string beg (1+ beg)) "[")
- tf (funcall (if with-hm 'cdr 'car)
- org-time-stamp-custom-formats)
- time (org-fix-decoded-time t1)
- str (format-time-string
- (concat
- (if inactive "[" "<") (substring tf 1 -1)
- (if inactive "]" ">"))
- (apply 'encode-time time))
- string (replace-match str t t string)
- start (+ start (length str)))))))
- string)
-
(defun org-fix-decoded-time (time)
"Set 0 instead of nil for the first 6 elements of time.
Don't touch the rest."
@@ -16954,14 +17445,17 @@ Allowed values for TYPE are:
When TYPE is nil, fall back on returning a regexp that matches
both scheduled and deadline timestamps."
- (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9> \n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)")
- ((eq type 'active) org-ts-regexp)
- ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]")
- ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>"))
- ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
- ((eq type 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]"))
- ((eq type 'scheduled-or-deadline)
- (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>"))))
+ (case type
+ (all org-ts-regexp-both)
+ (active org-ts-regexp)
+ (inactive org-ts-regexp-inactive)
+ (scheduled org-scheduled-time-regexp)
+ (deadline org-deadline-time-regexp)
+ (closed org-closed-time-regexp)
+ (otherwise
+ (concat "\\<"
+ (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."
@@ -16969,9 +17463,13 @@ both scheduled and deadline timestamps."
(let ((case-fold-search nil)
(regexp (org-re-timestamp org-ts-type))
(callback
- (lambda () (time-less-p
- (org-time-string-to-time (match-string 1))
- (org-time-string-to-time date)))))
+ `(lambda ()
+ (and ,(if (memq org-ts-type '(active inactive all))
+ '(eq (org-element-type (org-element-context)) 'timestamp)
+ '(org-at-planning-p))
+ (time-less-p
+ (org-time-string-to-time (match-string 1))
+ (org-time-string-to-time date))))))
(message "%d entries before %s"
(org-occur regexp nil callback) date)))
@@ -16981,10 +17479,13 @@ both scheduled and deadline timestamps."
(let ((case-fold-search nil)
(regexp (org-re-timestamp org-ts-type))
(callback
- (lambda () (not
- (time-less-p
- (org-time-string-to-time (match-string 1))
- (org-time-string-to-time date))))))
+ `(lambda ()
+ (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-string 1))
+ (org-time-string-to-time date)))))))
(message "%d entries after %s"
(org-occur regexp nil callback) date)))
@@ -16995,15 +17496,18 @@ 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
- (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)))))))
+ `(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)))))))
(message "%d entries between %s and %s"
(org-occur regexp nil callback) start-date end-date)))
@@ -17109,7 +17613,8 @@ The variable `date' is bound by the calendar when this is called."
(if (org-diary-sexp-entry (match-string 1 s) "" date)
daynr
(+ daynr 1000)))
- ((and daynr (string-match "\\+[0-9]+[hdwmy]" s))
+ ((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))
@@ -17129,14 +17634,15 @@ The variable `date' is bound by the calendar when this is called."
(defun org-small-year-to-year (year)
"Convert 2-digit years into 4-digit years.
-38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037.
-The year 2000 cannot be abbreviated. Any year larger than 99
-is returned unchanged."
- (if (< year 38)
- (setq year (+ 2000 year))
- (if (< year 100)
- (setq year (+ 1900 year))))
- year)
+YEAR is expanded into one of the 30 next years, if possible, or
+into a past one. Any year larger than 99 is returned unchanged."
+ (if (>= year 100) year
+ (let* ((current (string-to-number (format-time-string "%Y" (current-time))))
+ (century (/ current 100))
+ (offset (- year (% current 100))))
+ (cond ((> offset 30) (+ (* (1- century) 100) year))
+ ((> offset -70) (+ (* century 100) year))
+ (t (+ (* (1+ century) 100) year))))))
(defun org-time-from-absolute (d)
"Return the time corresponding to date D.
@@ -17224,9 +17730,10 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp."
(if (<= cday sday) (throw 'exit sday))
- (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change)
- (setq dn (string-to-number (match-string 1 change))
- dw (cdr (assoc (match-string 2 change) a1)))
+ (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
@@ -17392,7 +17899,7 @@ With prefix ARG, change that many days."
"Is the cursor on the clock log line?"
(save-excursion
(move-beginning-of-line 1)
- (looking-at "^[ \t]*CLOCK:")))
+ (looking-at org-clock-line-re)))
(defvar org-clock-history) ; defined in org-clock.el
(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
@@ -17510,7 +18017,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(let* ((p (save-excursion (org-back-to-heading t)))
(cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
(clfixnth
- (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100))))
+ (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100))))
(clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history))))
(if (not clfixpos)
(message "No clock to adjust")
@@ -17614,7 +18121,8 @@ If there is already a time stamp at the cursor position, update it."
(encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
(defcustom org-effort-durations
- `(("h" . 60)
+ `(("min" . 1)
+ ("h" . 60)
("d" . ,(* 60 8))
("w" . ,(* 60 8 5))
("m" . ,(* 60 8 5 4))
@@ -17630,7 +18138,8 @@ 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 "24.1"
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type '(alist :key-type (string :tag "Modifier")
:value-type (number :tag "Minutes")))
@@ -17748,7 +18257,7 @@ If no number is found, the return value is 0."
(defcustom org-image-actual-width t
"Should we use the actual width of images when inlining them?
-When set to `t', always use the image width.
+When set to t, always use the image width.
When set to a number, use imagemagick (when available) to set
the image's width to this value.
@@ -17775,26 +18284,32 @@ This requires Emacs >= 24.1, build with imagemagick support."
(defcustom org-agenda-inhibit-startup nil
"Inhibit startup when preparing agenda buffers.
-When this variable is `t', the initialization of the Org agenda
+When this variable is t, the initialization of the Org agenda
buffers is inhibited: e.g. the visibility state is not set, the
tables are not re-aligned, etc."
:type 'boolean
:version "24.3"
:group 'org-agenda)
-(defcustom org-agenda-ignore-drawer-properties nil
+(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, appointments,
-and subtree-local categories.
-If you don't use these in the agenda, you can add them to this list and
-agenda building will be a bit faster.
+Properties are used to prepare buffers for effort estimates,
+appointments, statistics and subtree-local categories.
+If you don't use these in the agenda, you can add them to this
+list and agenda building will be a bit faster.
The value is a list, with zero or more of the symbols `effort', `appt',
-or `category'."
+`stats' or `category'."
:type '(set :greedy t
(const effort)
(const appt)
+ (const stats)
(const category))
- :version "24.3"
+ :version "25.1"
+ :package-version '(Org . "8.3")
:group 'org-agenda)
(defun org-duration-string-to-minutes (s &optional output-to-string)
@@ -17957,8 +18472,10 @@ used by the agenda files. If ARCHIVE is `ifmode', do this only if
"Return non-nil, if FILE is an agenda file.
If FILE is omitted, use the file associated with the current
buffer."
- (member (or file (buffer-file-name))
- (org-agenda-files t)))
+ (let ((fname (or file (buffer-file-name))))
+ (and fname
+ (member (file-truename fname)
+ (mapcar #'file-truename (org-agenda-files t))))))
(defun org-edit-agenda-file-list ()
"Edit the list of agenda files.
@@ -18087,7 +18604,7 @@ Optional argument FILE means use this file instead of the current."
(progn
(org-store-new-agenda-file-list files)
(org-install-agenda-files-menu)
- (message "Removed file: %s" afile))
+ (message "Removed from Org Agenda list: %s" afile))
(message "File was not in list: %s (not removed)" afile))))
(defun org-file-menu-entry (file)
@@ -18103,11 +18620,12 @@ Optional argument FILE means use this file instead of the current."
((equal r ?r)
(org-remove-file file)
(throw 'nextfile t))
- (t (error "Abort"))))))
+ (t (user-error "Abort"))))))
(defun org-get-agenda-file-buffer (file)
- "Get a buffer visiting FILE. If the buffer needs to be created, add
-it to the list of buffers which might be released later."
+ "Get an agenda buffer visiting FILE.
+If the buffer needs to be created, add it to the list of buffers
+which might be released later."
(let ((buf (org-find-base-buffer-visiting file)))
(if buf
buf ; just return it
@@ -18150,20 +18668,15 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(org-check-agenda-file file)
(set-buffer (org-get-agenda-file-buffer file)))
(widen)
- (org-set-regexps-and-options-for-tags)
+ (org-set-regexps-and-options 'tags-only)
(setq pos (point))
- (goto-char (point-min))
- (let ((case-fold-search t))
- (when (search-forward "#+setupfile" nil t)
- ;; Don't set all regexps and options systematically as
- ;; this is only run for setting agenda tags from setup
- ;; file
- (org-set-regexps-and-options)))
- (or (memq 'category org-agenda-ignore-drawer-properties)
+ (or (memq 'category org-agenda-ignore-properties)
(org-refresh-category-properties))
- (or (memq 'effort org-agenda-ignore-drawer-properties)
- (org-refresh-properties org-effort-property 'org-effort))
- (or (memq 'appt org-agenda-ignore-drawer-properties)
+ (or (memq 'stats org-agenda-ignore-properties)
+ (org-refresh-stats-properties))
+ (or (memq 'effort org-agenda-ignore-properties)
+ (org-refresh-effort-properties))
+ (or (memq 'appt org-agenda-ignore-properties)
(org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
(setq org-todo-keywords-for-agenda
(append org-todo-keywords-for-agenda org-todo-keywords-1))
@@ -18171,8 +18684,6 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(append org-done-keywords-for-agenda org-done-keywords))
(setq org-todo-keyword-alist-for-agenda
(append org-todo-keyword-alist-for-agenda org-todo-key-alist))
- (setq org-drawers-for-agenda
- (append org-drawers-for-agenda org-drawers))
(setq org-tag-alist-for-agenda
(org-uniquify
(append org-tag-alist-for-agenda
@@ -18191,11 +18702,11 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(if (org-at-heading-p t)
(add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
- (setq re (format org-heading-keyword-regexp-format
- org-comment-string))
+ (setq re (format "^\\* .*\\<%s\\>" org-comment-string))
(while (re-search-forward re nil t)
- (add-text-properties
- (match-beginning 0) (org-end-of-subtree t) pc))))
+ (when (save-match-data (org-in-commented-heading-p t))
+ (add-text-properties
+ (match-beginning 0) (org-end-of-subtree t) pc)))))
(goto-char pos)))))
(setq org-todo-keywords-for-agenda
(org-uniquify org-todo-keywords-for-agenda))
@@ -18212,7 +18723,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret)
(org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol)
(org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify)
-(org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment)
+(org-defkey org-cdlatex-mode-map "\C-c{" 'org-cdlatex-environment-indent)
(defvar org-cdlatex-texmathp-advice-is-done nil
"Flag remembering if we have applied the advice to texmathp already.")
@@ -18290,21 +18801,66 @@ Revert to the normal definition outside of these fragments."
(let (org-cdlatex-mode)
(call-interactively (key-binding (vector last-input-event))))))
+(defun org-cdlatex-environment-indent (&optional environment item)
+ "Execute `cdlatex-environment' and indent the inserted environment.
+
+ENVIRONMENT and ITEM are passed to `cdlatex-environment'.
+
+The inserted environment is indented to current indentation
+unless point is at the beginning of the line, in which the
+environment remains unintended."
+ (interactive)
+ ;; cdlatex-environment always return nil. Therefore, capture output
+ ;; first and determine if an environment was selected.
+ (let* ((beg (point-marker))
+ (end (copy-marker (point) t))
+ (inserted (progn
+ (ignore-errors (cdlatex-environment environment item))
+ (< beg end)))
+ ;; Figure out how many lines to move forward after the
+ ;; environment has been inserted.
+ (lines (when inserted
+ (save-excursion
+ (- (loop while (< beg (point))
+ with x = 0
+ do (forward-line -1)
+ (incf x)
+ finally return x)
+ (if (progn (goto-char beg)
+ (and (progn (skip-chars-forward " \t") (eolp))
+ (progn (skip-chars-backward " \t") (bolp))))
+ 1 0)))))
+ (env (org-trim (delete-and-extract-region beg end))))
+ (when inserted
+ ;; Get indentation of next line unless at column 0.
+ (let ((ind (if (bolp) 0
+ (save-excursion
+ (org-return-indent)
+ (prog1 (org-get-indentation)
+ (when (progn (skip-chars-forward " \t") (eolp))
+ (delete-region beg (point)))))))
+ (bol (progn (skip-chars-backward " \t") (bolp))))
+ ;; Insert a newline before environment unless at column zero
+ ;; to "escape" the current line. Insert a newline if
+ ;; something is one the same line as \end{ENVIRONMENT}.
+ (insert
+ (concat (unless bol "\n") env
+ (when (and (skip-chars-forward " \t") (not (eolp))) "\n")))
+ (unless (zerop ind)
+ (save-excursion
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (eolp) (org-indent-line-to ind))
+ (forward-line))))
+ (goto-char beg)
+ (forward-line lines)
+ (org-indent-line-to ind)))
+ (set-marker beg nil)
+ (set-marker end nil)))
;;;; LaTeX fragments
-(defvar org-latex-regexps
- '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
- ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
- ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
- ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
- ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
- ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
- ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
- ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
- "Regular expressions for matching embedded LaTeX.")
-
(defun org-inside-LaTeX-fragment-p ()
"Test if point is inside a LaTeX fragment.
I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
@@ -18359,175 +18915,232 @@ looks only before point, not after."
"List of overlays carrying the images of latex fragments.")
(make-variable-buffer-local 'org-latex-fragment-image-overlays)
-(defun org-remove-latex-fragment-image-overlays ()
- "Remove all overlays with LaTeX fragment images in current buffer."
- (mapc 'delete-overlay org-latex-fragment-image-overlays)
- (setq org-latex-fragment-image-overlays nil))
+(defun org-remove-latex-fragment-image-overlays (&optional beg end)
+ "Remove all overlays with LaTeX fragment images in current buffer.
+When optional arguments BEG and END are non-nil, remove all
+overlays between them instead. Return t when some overlays were
+removed, nil otherwise."
+ (let (removedp)
+ (setq org-latex-fragment-image-overlays
+ (let ((beg (or beg (point-min)))
+ (end (or end (point-max))))
+ (org-remove-if
+ (lambda (o)
+ (and (>= (overlay-start o) beg)
+ (<= (overlay-end o) end)
+ (progn (delete-overlay o)
+ (or removedp (setq removedp t)))))
+ org-latex-fragment-image-overlays)))
+ removedp))
-(defun org-preview-latex-fragment (&optional subtree)
+(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.
-If the cursor is in a LaTeX fragment, create the image and overlay
-it over the source code. If there is no fragment at point, display
-all fragments in the current text, from one headline to the next. With
-prefix SUBTREE, display all fragments in the current subtree. With a
-double prefix arg \\[universal-argument] \\[universal-argument], or when \
-the cursor is before the first headline,
-display all fragments in the buffer.
-The images can be removed again with \\[org-ctrl-c-ctrl-c]."
+
+If the cursor is on a LaTeX fragment, create the image and overlay
+it over the source code, if there is none. Remove it otherwise.
+If there is no fragment at point, display all fragments in the
+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
+for all fragments in the buffer."
(interactive "P")
- (unless buffer-file-name
+ (unless (buffer-file-name (buffer-base-buffer))
(user-error "Can't preview LaTeX fragment in a non-file buffer"))
(when (display-graphic-p)
- (org-remove-latex-fragment-image-overlays)
- (save-excursion
- (save-restriction
- (let (beg end at msg)
- (cond
- ((or (equal subtree '(16))
- (not (save-excursion
- (re-search-backward org-outline-regexp-bol nil t))))
- (setq beg (point-min) end (point-max)
- msg "Creating images for buffer...%s"))
- ((equal subtree '(4))
- (org-back-to-heading)
- (setq beg (point) end (org-end-of-subtree t)
- msg "Creating images for subtree...%s"))
- (t
- (if (setq at (org-inside-LaTeX-fragment-p))
- (goto-char (max (point-min) (- (cdr at) 2)))
- (org-back-to-heading))
- (setq beg (point) end (progn (outline-next-heading) (point))
- msg (if at "Creating image...%s"
- "Creating images for entry...%s"))))
- (message msg "")
- (narrow-to-region beg end)
- (goto-char beg)
- (org-format-latex
- (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
- (file-name-nondirectory
- buffer-file-name)))
- default-directory 'overlays msg at 'forbuffer
- org-latex-create-formula-image-program)
- (message msg "done. Use `C-c C-c' to remove images."))))))
-
-(defun org-format-latex (prefix &optional dir overlays msg at
- forbuffer processing-type)
+ (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")
+ (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)
+ (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.
+
+When optional argument OVERLAYS is non-nil, display the image on
+top of the fragment instead of replacing it.
+
+PROCESSING-TYPE is the conversion method to use, as a symbol.
+
Some of the options can be changed using the variable
-`org-format-latex-options'."
- (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
- (let* ((prefixnodir (file-name-nondirectory prefix))
- (absprefix (expand-file-name prefix dir))
- (todir (file-name-directory absprefix))
- (opt org-format-latex-options)
- (optnew org-format-latex-options)
- (matchers (plist-get opt :matchers))
- (re-list org-latex-regexps)
- (cnt 0) txt hash link beg end re e checkdir
- string
- m n block-type block linkfile movefile ov)
- ;; Check the different regular expressions
- (while (setq e (pop re-list))
- (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e)
- block (if block-type "\n\n" ""))
- (when (member m matchers)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (when (and (or (not at) (equal (cdr at) (match-beginning n)))
- (or (not overlays)
- (not (eq (get-char-property (match-beginning n)
- 'org-overlay-type)
- 'org-latex-overlay))))
- (cond
- ((eq processing-type 'verbatim))
- ((eq processing-type 'mathjax)
- ;; Prepare for MathJax processing.
- (setq string (match-string n))
- (when (member m '("$" "$1"))
- (save-excursion
- (delete-region (match-beginning n) (match-end n))
- (goto-char (match-beginning n))
- (insert (concat "\\(" (substring string 1 -1) "\\)")))))
- ((or (eq processing-type 'dvipng)
- (eq processing-type 'imagemagick))
- ;; Process to an image.
- (setq txt (match-string n)
- beg (match-beginning n) end (match-end n)
- cnt (1+ cnt))
- (let ((face (face-at-point))
- (fg (plist-get opt :foreground))
- (bg (plist-get opt :background))
- ;; Ensure full list is printed.
- print-length print-level)
- (when forbuffer
- ;; Get the colors from the face at point.
- (goto-char beg)
- (when (eq fg 'auto)
- (setq fg (face-attribute face :foreground nil 'default)))
- (when (eq bg 'auto)
- (setq bg (face-attribute face :background nil 'default)))
- (setq optnew (copy-sequence opt))
- (plist-put optnew :foreground fg)
- (plist-put optnew :background bg))
- (setq hash (sha1 (prin1-to-string
- (list org-format-latex-header
- org-latex-default-packages-alist
- org-latex-packages-alist
- org-format-latex-options
- forbuffer txt fg bg)))
- linkfile (format "%s_%s.png" prefix hash)
- movefile (format "%s_%s.png" absprefix hash)))
- (setq link (concat block "[[file:" linkfile "]]" block))
- (if msg (message msg cnt))
- (goto-char beg)
- (unless checkdir ; Ensure the directory exists.
- (setq checkdir t)
- (or (file-directory-p todir) (make-directory todir t)))
- (unless (file-exists-p movefile)
- (org-create-formula-image
- txt movefile optnew forbuffer processing-type))
- (if overlays
- (progn
- (mapc (lambda (o)
- (if (eq (overlay-get o 'org-overlay-type)
- 'org-latex-overlay)
- (delete-overlay o)))
- (overlays-in beg end))
- (setq ov (make-overlay beg end))
- (overlay-put ov 'org-overlay-type 'org-latex-overlay)
- (if (featurep 'xemacs)
- (progn
- (overlay-put ov 'invisible t)
- (overlay-put
- ov 'end-glyph
- (make-glyph (vector 'png :file movefile))))
- (overlay-put
- ov 'display
- (list 'image :type 'png :file movefile :ascent 'center)))
- (push ov org-latex-fragment-image-overlays)
- (goto-char end))
- (delete-region beg end)
- (insert (org-add-props link
+`org-format-latex-options', which see."
+ (when (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
+ (unless (eq processing-type 'verbatim)
+ (let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}")
+ (cnt 0)
+ checkdir-flag)
+ (goto-char (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)
+ (unless (and overlays
+ (eq (get-char-property (point) 'org-overlay-type)
+ 'org-latex-overlay))
+ (let* ((context (org-element-context))
+ (type (org-element-type context)))
+ (when (memq type '(latex-environment latex-fragment))
+ (let ((block-type (eq type 'latex-environment))
+ (value (org-element-property :value context))
+ (beg (org-element-property :begin context))
+ (end (save-excursion
+ (goto-char (org-element-property :end context))
+ (skip-chars-backward " \r\t\n")
+ (point))))
+ (case processing-type
+ (mathjax
+ ;; Prepare for MathJax processing.
+ (if (eq (char-after beg) ?$)
+ (save-excursion
+ (delete-region beg end)
+ (insert "\\(" (substring value 1 -1) "\\)"))
+ (goto-char end)))
+ ((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)))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov
+ 'org-overlay-type
+ 'org-latex-overlay)
+ (overlay-put ov 'evaporate t)
+ (if (featurep 'xemacs)
+ (progn
+ (overlay-put ov 'invisible t)
+ (overlay-put
+ ov 'end-glyph
+ (make-glyph
+ (vector 'png :file movefile))))
+ (overlay-put
+ ov 'display
+ (list 'image
+ :type 'png
+ :file movefile
+ :ascent 'center)))
+ (push ov org-latex-fragment-image-overlays))
+ (goto-char end))
+ (delete-region beg end)
+ (insert
+ (org-add-props link
(list 'org-latex-src
- (replace-regexp-in-string
- "\"" "" txt)
+ (replace-regexp-in-string "\"" "" value)
'org-latex-src-embed-type
- (if block-type 'paragraph 'character))))))
- ((eq processing-type 'mathml)
- ;; Process to MathML
- (unless (save-match-data (org-format-latex-mathml-available-p))
- (user-error "LaTeX to MathML converter not configured"))
- (setq txt (match-string n)
- beg (match-beginning n) end (match-end n)
- cnt (1+ cnt))
- (if msg (message msg cnt))
- (goto-char beg)
- (delete-region beg end)
- (insert (org-format-latex-as-mathml
- txt block-type prefix dir)))
- (t
- (error "Unknown conversion type %s for LaTeX fragments"
- processing-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)))))))))))
(defun org-create-math-formula (latex-frag &optional mathml-file)
"Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
@@ -18542,7 +19155,7 @@ inspection."
(buffer-substring-no-properties
(region-beginning) (region-end)))))
(read-string "LaTeX Fragment: " frag nil frag))))
- (unless latex-frag (error "Invalid LaTeX fragment"))
+ (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))
@@ -18550,9 +19163,12 @@ inspection."
(make-temp-name (expand-file-name "ltxmathml-out"))))
(cmd (format-spec
org-latex-to-mathml-convert-command
- `((?j . ,(shell-quote-argument
- (expand-file-name org-latex-to-mathml-jar-file)))
+ `((?j . ,(and 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)
@@ -18567,9 +19183,11 @@ inspection."
(when (re-search-forward
(concat
(regexp-quote
- "<math xmlns=\"http://www.w3.org/1998/Math/MathML\">")
+ "<math xmlns=\"http://www.w3.org/1998/Math/MathML\"")
+ "[^>]*?>"
"\\(.\\|\n\\)*"
- (regexp-quote "</math>")) nil t)
+ "</math>")
+ nil t)
(prog1 (match-string 0) (kill-buffer))))))
(cond
(mathml
@@ -18629,11 +19247,11 @@ share a good deal of logic."
"latex" "needed to convert LaTeX fragments to images")
(funcall
(case (or type org-latex-create-formula-image-program)
- ('dvipng
+ (dvipng
(org-check-external-command
"dvipng" "needed to convert LaTeX fragments to images")
#'org-create-formula-image-with-dvipng)
- ('imagemagick
+ (imagemagick
(org-check-external-command
"convert" "you need to install imagemagick")
#'org-create-formula-image-with-imagemagick)
@@ -18661,6 +19279,16 @@ share a good deal of logic."
(plist-get info :latex-header)))
info)))
+(defun org--get-display-dpi ()
+ "Get the DPI of the display.
+
+Assumes that the display has the same pixel width in the
+horizontal and vertical directions."
+ (if (display-graphic-p)
+ (round (/ (display-pixel-height)
+ (/ (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."
@@ -18673,11 +19301,10 @@ share a good deal of logic."
(texfile (concat texfilebase ".tex"))
(dvifile (concat texfilebase ".dvi"))
(pngfile (concat texfilebase ".png"))
- (fnh (if (featurep 'xemacs)
- (font-height (face-font 'default))
- (face-attribute 'default :height nil)))
(scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
- (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
+ ;; 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))))
(fg (or (plist-get options (if buffer :foreground :html-foreground))
"Black"))
(bg (or (plist-get options (if buffer :background :html-background))
@@ -18691,29 +19318,26 @@ share a good deal of logic."
(insert latex-header)
(insert "\n\\begin{document}\n" string "\n\\end{document}\n")))
(let ((dir default-directory))
- (condition-case nil
- (progn
- (cd tmpdir)
- (call-process "latex" nil nil nil texfile))
- (error nil))
+ (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)
- (condition-case nil
- (if (featurep 'xemacs)
- (call-process "dvipng" nil nil nil
- "-fg" fg "-bg" bg
- "-T" "tight"
- "-o" pngfile
- dvifile)
+ (ignore-errors
+ (if (featurep 'xemacs)
(call-process "dvipng" nil nil nil
"-fg" fg "-bg" bg
- "-D" dpi
- ;;"-x" scale "-y" scale
"-T" "tight"
"-o" pngfile
- dvifile))
- (error nil))
+ 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)
@@ -18738,11 +19362,8 @@ share a good deal of logic."
(texfile (concat texfilebase ".tex"))
(pdffile (concat texfilebase ".pdf"))
(pngfile (concat texfilebase ".png"))
- (fnh (if (featurep 'xemacs)
- (font-height (face-font 'default))
- (face-attribute 'default :height nil)))
(scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
- (dpi (number-to-string (* scale (floor (if buffer fnh 120.)))))
+ (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))
@@ -18766,25 +19387,24 @@ share a good deal of logic."
(org-latex-compile texfile t)
(if (not (file-exists-p pdffile))
(progn (message "Failed to create pdf file from %s" texfile) nil)
- (condition-case nil
- (if (featurep 'xemacs)
- (call-process "convert" nil nil nil
- "-density" "96"
- "-trim"
- "-antialias"
- pdffile
- "-quality" "100"
- ;; "-sharpen" "0x1.0"
- pngfile)
+ (ignore-errors
+ (if (featurep 'xemacs)
(call-process "convert" nil nil nil
- "-density" dpi
+ "-density" "96"
"-trim"
"-antialias"
pdffile
"-quality" "100"
;; "-sharpen" "0x1.0"
- pngfile))
- (error nil))
+ 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)
@@ -18871,7 +19491,7 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
"Convert COLOR-NAME to a RGB color value for dvipng."
(apply 'format "rgb %s %s %s"
(mapcar 'org-normalize-color
- (color-values color-name))))
+ (color-values color-name))))
(defun org-latex-color (attr)
"Return a RGB color for the LaTeX color package."
@@ -18908,13 +19528,14 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
(if org-inline-image-overlays
(progn
(org-remove-inline-images)
- (message "Inline image display turned off"))
+ (when (org-called-interactively-p 'interactive)
+ (message "Inline image display turned off")))
(org-display-inline-images include-linked)
- (if (and (org-called-interactively-p)
- org-inline-image-overlays)
- (message "%d images displayed inline"
- (length org-inline-image-overlays))
- (message "No images to display inline"))))
+ (when (org-called-interactively-p 'interactive)
+ (message (if org-inline-image-overlays
+ (format "%d images displayed inline"
+ (length org-inline-image-overlays))
+ "No images to display inline")))))
(defun org-redisplay-inline-images ()
"Refresh the display of inline images."
@@ -18926,63 +19547,114 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
(defun org-display-inline-images (&optional include-linked refresh beg end)
"Display inline images.
-Normally only links without a description part are inlined, because this
-is how it will work for export. When INCLUDE-LINKED is set, also links
-with a description part will be inlined. This can be nice for a quick
-look at those images, but it does not reflect what exported files will look
-like.
-When REFRESH is set, refresh existing images between BEG and END.
-This will create new image displays only if necessary.
-BEG and END default to the buffer boundaries."
+
+An inline image is a link which follows either of these
+conventions:
+
+ 1. Its path is a file with an extension matching return value
+ from `image-file-name-regexp' and it has no contents.
+
+ 2. Its description consists in a single link of the previous
+ type.
+
+When optional argument INCLUDE-LINKED is non-nil, also links with
+a text description part will be inlined. This can be nice for
+a quick look at those images, but it does not reflect what
+exported files will look like.
+
+When optional argument REFRESH is non-nil, refresh existing
+images between BEG and END. This will create new image displays
+only if necessary. BEG and END default to the buffer
+boundaries."
(interactive "P")
(when (display-graphic-p)
(unless refresh
(org-remove-inline-images)
- (if (fboundp 'clear-image-cache) (clear-image-cache)))
- (save-excursion
- (save-restriction
- (widen)
- (setq beg (or beg (point-min)) end (or end (point-max)))
- (goto-char beg)
- (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
- (substring (org-image-file-name-regexp) 0 -2)
- "\\)\\]" (if include-linked "" "\\]")))
- (case-fold-search t)
- old file ov img type attrwidth width)
- (while (re-search-forward re end t)
- (setq old (get-char-property-and-overlay (match-beginning 1)
- 'org-image-overlay)
- file (expand-file-name
- (concat (or (match-string 3) "") (match-string 4))))
- (when (image-type-available-p 'imagemagick)
- (setq attrwidth (if (or (listp org-image-actual-width)
- (null org-image-actual-width))
- (save-excursion
- (save-match-data
- (when (re-search-backward
- "#\\+attr.*:width[ \t]+\\([^ ]+\\)"
- (save-excursion
- (re-search-backward "^[ \t]*$\\|\\`" nil t)) t)
- (string-to-number (match-string 1))))))
- width (cond ((eq org-image-actual-width t) nil)
- ((null org-image-actual-width) attrwidth)
- ((numberp org-image-actual-width)
- org-image-actual-width)
- ((listp org-image-actual-width)
- (or attrwidth (car org-image-actual-width))))
- type (if width 'imagemagick)))
- (when (file-exists-p file)
- (if (and (car-safe old) refresh)
- (image-refresh (overlay-get (cdr old) 'display))
- (setq img (save-match-data (create-image file type nil :width width)))
- (when img
- (setq ov (make-overlay (match-beginning 0) (match-end 0)))
- (overlay-put ov 'display img)
- (overlay-put ov 'face 'default)
- (overlay-put ov 'org-image-overlay t)
- (overlay-put ov 'modification-hooks
- (list 'org-display-inline-remove-overlay))
- (push ov org-inline-image-overlays))))))))))
+ (when (fboundp 'clear-image-cache) (clear-image-cache)))
+ (org-with-wide-buffer
+ (goto-char (or beg (point-min)))
+ (let ((case-fold-search t)
+ (file-extension-re (org-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.
+ (when (and (equal (org-element-property :type link) "file")
+ (or include-linked
+ (not (org-element-property :contents-begin link)))
+ (let ((parent (org-element-property :parent link)))
+ (or (not (eq (org-element-type parent) 'link))
+ (not (cdr (org-element-contents parent)))))
+ (org-string-match-p file-extension-re
+ (org-element-property :path link)))
+ (let ((file (expand-file-name
+ (org-link-unescape
+ (org-element-property :path link)))))
+ (when (file-exists-p file)
+ (let ((width
+ ;; Apply `org-image-actual-width' specifications.
+ (cond
+ ((not (image-type-available-p 'imagemagick)) nil)
+ ((eq org-image-actual-width t) nil)
+ ((listp org-image-actual-width)
+ (or
+ ;; First try to find a width among
+ ;; attributes associated to the paragraph
+ ;; containing link.
+ (let ((paragraph
+ (let ((e link))
+ (while (and (setq e (org-element-property
+ :parent e))
+ (not (eq (org-element-type e)
+ 'paragraph))))
+ e)))
+ (when paragraph
+ (save-excursion
+ (goto-char (org-element-property :begin paragraph))
+ (when
+ (re-search-forward
+ "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
+ (org-element-property
+ :post-affiliated paragraph)
+ t)
+ (string-to-number (match-string 1))))))
+ ;; Otherwise, fall-back to provided number.
+ (car org-image-actual-width)))
+ ((numberp org-image-actual-width)
+ org-image-actual-width)))
+ (old (get-char-property-and-overlay
+ (org-element-property :begin link)
+ 'org-image-overlay)))
+ (if (and (car-safe old) refresh)
+ (image-refresh (overlay-get (cdr old) 'display))
+ (let ((image (create-image file
+ (and width 'imagemagick)
+ nil
+ :width width)))
+ (when image
+ (let* ((link
+ ;; If inline image is the description
+ ;; of another link, be sure to
+ ;; consider the latter as the one to
+ ;; apply the overlay on.
+ (let ((parent
+ (org-element-property :parent link)))
+ (if (eq (org-element-type parent) 'link)
+ parent
+ link)))
+ (ov (make-overlay
+ (org-element-property :begin link)
+ (progn
+ (goto-char
+ (org-element-property :end link))
+ (skip-chars-backward " \t")
+ (point)))))
+ (overlay-put ov 'display image)
+ (overlay-put ov 'face 'default)
+ (overlay-put ov 'org-image-overlay t)
+ (overlay-put
+ ov 'modification-hooks
+ (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")
@@ -19015,34 +19687,38 @@ BEG and END default to the buffer boundaries."
(define-key org-mode-map [remap outline-promote] 'org-promote-subtree)
(define-key org-mode-map [remap outline-demote] 'org-demote-subtree)
(define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret)
+(define-key org-mode-map [remap outline-next-visible-heading]
+ 'org-next-visible-heading)
+(define-key org-mode-map [remap outline-previous-visible-heading]
+ 'org-previous-visible-heading)
;; Outline functions from `outline-mode-prefix-map' that can not
;; be remapped in Org:
-;;
+
;; - the column "key binding" shows whether the Outline function is still
;; available in Org mode on the same key that it has been bound to in
;; Outline mode:
;; - "overridden": key used for a different functionality in Org mode
;; - else: key still bound to the same Outline function in Org mode
-;;
-;; | Outline function | key binding | Org replacement |
-;; |------------------------------------+-------------+-----------------------|
-;; | `outline-next-visible-heading' | `C-c C-n' | still same function |
-;; | `outline-previous-visible-heading' | `C-c C-p' | still same function |
-;; | `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 |
-;; | `hide-subtree' | overridden | visibility cycling |
-;; | `hide-body' | overridden | no replacement |
-;; | `hide-entry' | overridden | visibility cycling |
-;; | `hide-leaves' | overridden | no replacement |
-;; | `hide-sublevels' | overridden | no replacement |
-;; | `hide-other' | overridden | no replacement |
+
+;; | 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 |
+;; | `hide-subtree' | overridden | visibility cycling |
+;; | `hide-body' | overridden | no replacement |
+;; | `hide-entry' | overridden | visibility cycling |
+;; | `hide-leaves' | overridden | no replacement |
+;; | `hide-sublevels' | overridden | no replacement |
+;; | `hide-other' | overridden | no replacement |
;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
@@ -19068,6 +19744,8 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map [(meta up)] 'org-metaup)
(org-defkey org-mode-map [(meta down)] 'org-metadown)
+(org-defkey org-mode-map [(control meta shift right)] 'org-increase-number-at-point)
+(org-defkey org-mode-map [(control meta shift left)] 'org-decrease-number-at-point)
(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft)
(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright)
(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup)
@@ -19148,7 +19826,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\M-f" 'org-next-block)
(org-defkey org-mode-map "\C-c\M-b" 'org-previous-block)
(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
-(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
+(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-archive-subtree)
(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default)
(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer)
(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
@@ -19174,6 +19852,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
+(org-defkey org-mode-map "\C-c\M-l" 'org-insert-last-stored-link)
(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links)
(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
@@ -19198,8 +19877,10 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
(org-defkey org-mode-map [remap open-line] 'org-open-line)
+(org-defkey org-mode-map [remap comment-dwim] 'org-comment-dwim)
(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph)
(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph)
+(org-defkey org-mode-map "\M-^" 'org-delete-indentation)
(org-defkey org-mode-map "\C-m" 'org-return)
(org-defkey org-mode-map "\C-j" 'org-return-indent)
(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
@@ -19208,6 +19889,8 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula)
(org-defkey org-mode-map "\C-c'" 'org-edit-special)
(org-defkey org-mode-map "\C-c`" 'org-table-edit-field)
+(org-defkey org-mode-map "\C-c\"a" 'orgtbl-ascii-plot)
+(org-defkey org-mode-map "\C-c\"g" 'org-plot/gnuplot)
(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el)
@@ -19215,7 +19898,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
(org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch)
-(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
+(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width)
(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
@@ -19239,7 +19922,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
-(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
+(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-toggle-latex-fragment)
(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images)
(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images)
(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities)
@@ -19251,7 +19934,6 @@ BEG and END default to the buffer boundaries."
(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 [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
-(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer)
(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
@@ -19276,8 +19958,8 @@ BEG and END default to the buffer boundaries."
(defconst org-speed-commands-default
'(
("Outline Navigation")
- ("n" . (org-speed-move-safe 'outline-next-visible-heading))
- ("p" . (org-speed-move-safe 'outline-previous-visible-heading))
+ ("n" . (org-speed-move-safe 'org-next-visible-heading))
+ ("p" . (org-speed-move-safe 'org-previous-visible-heading))
("f" . (org-speed-move-safe 'org-forward-heading-same-level))
("b" . (org-speed-move-safe 'org-backward-heading-same-level))
("F" . org-next-block)
@@ -19292,8 +19974,8 @@ BEG and END default to the buffer boundaries."
("s" . org-narrow-to-subtree)
("=" . org-columns)
("Outline Structure Editing")
- ("U" . org-shiftmetaup)
- ("D" . org-shiftmetadown)
+ ("U" . org-metaup)
+ ("D" . org-metadown)
("r" . org-metaright)
("l" . org-metaleft)
("R" . org-shiftmetaright)
@@ -19423,9 +20105,11 @@ overwritten, and the table is not marked as requiring realignment."
(org-check-before-invisible-edit 'insert)
(cond
((and org-use-speed-commands
- (setq org-speed-command
- (run-hook-with-args-until-success
- 'org-speed-command-hook (this-command-keys))))
+ (let ((kv (this-command-keys-vector)))
+ (setq org-speed-command
+ (run-hook-with-args-until-success
+ 'org-speed-command-hook
+ (make-string 1 (aref kv (1- (length kv))))))))
(cond
((commandp org-speed-command)
(setq this-command org-speed-command)
@@ -19441,8 +20125,8 @@ overwritten, and the table is not marked as requiring realignment."
(progn
;; check if we blank the field, and if that triggers align
(and (featurep 'org-table) org-table-auto-blank-field
- (member last-command
- '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand))
+ (memq last-command
+ '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c))
(if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |"))
;; got extra space, this field does not determine column width
(let (org-table-may-need-update) (org-table-blank-field))
@@ -19810,31 +20494,29 @@ individual commands for more information."
(t (org-modifier-cursor-error))))
(defun org-shiftmetaup (&optional arg)
- "Move subtree up or kill table row.
-Calls `org-move-subtree-up' or `org-table-kill-row' or
-`org-move-item-up' or `org-timestamp-up', depending on context.
-See the individual commands for more information."
+ "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>'
+but also adjust the previous clocked item in the clock history.
+Everywhere else, drag the line at point up."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftmetaup-hook))
((org-at-table-p) (call-interactively 'org-table-kill-row))
- ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
- ((org-at-item-p) (call-interactively 'org-move-item-up))
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
(call-interactively 'org-timestamp-up)))
(t (call-interactively 'org-drag-line-backward))))
(defun org-shiftmetadown (&optional arg)
- "Move subtree down or insert table row.
-Calls `org-move-subtree-down' or `org-table-insert-row' or
-`org-move-item-down' or `org-timestamp-up', depending on context.
-See the individual commands for more information."
+ "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>'
+but also adjust the previous clocked item in the clock history.
+Everywhere else, drag the line at point down."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftmetadown-hook))
((org-at-table-p) (call-interactively 'org-table-insert-row))
- ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
- ((org-at-item-p) (call-interactively 'org-move-item-down))
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
(call-interactively 'org-timestamp-down)))
(t (call-interactively 'org-drag-line-forward))))
@@ -19844,10 +20526,15 @@ See the individual commands for more information."
"Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
(defun org-metaleft (&optional arg)
- "Promote heading or move table column to left.
-Calls `org-do-promote' or `org-table-move-column', depending on context.
-With no specific context, calls the Emacs default `backward-word'.
-See the individual commands for more information."
+ "Promote heading, list item at point or move table column left.
+
+Calls `org-do-promote', `org-outdent-item' or `org-table-move-column',
+depending on context. With no specific context, calls the Emacs
+default `backward-word'. See the individual commands for more
+information.
+
+This function runs the hook `org-metaleft-hook' as a first step,
+and returns at first non-nil value."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaleft-hook))
@@ -19873,10 +20560,17 @@ See the individual commands for more information."
(t (call-interactively 'backward-word))))
(defun org-metaright (&optional arg)
- "Demote a subtree, a list item or move table column to right.
+ "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.
With no specific context, calls the Emacs default `forward-word'.
-See the individual commands for more information."
+See the individual commands for more information.
+
+This function runs the hook `org-metaright-hook' as a first step,
+and returns at first non-nil value."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaright-hook))
@@ -20138,6 +20832,32 @@ Optional argument N tells to change by that many units."
(org-clock-timestamps-down n))
(user-error "Not at a clock log")))
+(defun org-increase-number-at-point (&optional inc)
+ "Increment the number at point.
+With an optional prefix numeric argument INC, increment using
+this numeric value."
+ (interactive "p")
+ (if (not (number-at-point))
+ (user-error "Not on a number")
+ (unless inc (setq inc 1))
+ (let ((pos (point))
+ (beg (skip-chars-backward "-+^/*0-9eE."))
+ (end (skip-chars-forward "-+^/*0-9eE^.")) nap)
+ (setq nap (buffer-substring-no-properties
+ (+ pos beg) (+ pos beg end)))
+ (delete-region (+ pos beg) (+ pos beg end))
+ (insert (calc-eval (concat (number-to-string inc) "+" nap))))
+ (when (org-at-table-p)
+ (org-table-align)
+ (org-table-end-of-field 1))))
+
+(defun org-decrease-number-at-point (&optional inc)
+ "Decrement the number at point.
+With an optional prefix numeric argument INC, decrement using
+this numeric value."
+ (interactive "p")
+ (org-increase-number-at-point (- (or inc 1))))
+
(defun org-ctrl-c-ret ()
"Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
(interactive)
@@ -20205,7 +20925,9 @@ See the individual commands for more information."
When at a table, call the formula editor with `org-table-edit-formulas'.
When in a source code block, call `org-edit-src-code'.
When in a fixed-width region, call `org-edit-fixed-width-region'.
+When in an export block, call `org-edit-export-block'.
When at an #+INCLUDE keyword, visit the included file.
+When at a footnote reference, call `org-edit-footnote-reference'
On a link, call `ffap' to visit the link at point.
Otherwise, return a user error."
(interactive "P")
@@ -20228,24 +20950,35 @@ Otherwise, return a user error."
session params))))))
(keyword
(if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE"))
- (find-file
- (org-remove-double-quotes
- (car (org-split-string (org-element-property :value element)))))
+ (org-open-link-from-string
+ (format "[[%s]]"
+ (expand-file-name
+ (let ((value (org-element-property :value element)))
+ (cond ((not (org-string-nw-p value))
+ (user-error "No file to edit"))
+ ((string-match "\\`\"\\(.*?\\)\"" value)
+ (match-string 1 value))
+ ((string-match "\\`[^ \t\"]\\S-*" value)
+ (match-string 0 value))
+ (t (user-error "No valid file specified")))))))
(user-error "No special environment to edit here")))
(table
(if (eq (org-element-property :type element) 'table.el)
- (org-edit-src-code)
+ (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 export-block) (org-edit-src-code))
+ (example-block (org-edit-src-code))
+ (export-block (org-edit-export-block))
(fixed-width (org-edit-fixed-width-region))
(otherwise
- ;; No notable element at point. Though, we may be at a link,
- ;; which is an object. Thus, scan deeper.
- (if (eq (org-element-type (org-element-context element)) 'link)
- (call-interactively 'ffap)
- (user-error "No special environment to edit here"))))))
+ ;; 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"))))))))
(defvar org-table-coordinate-overlays) ; defined in org-table.el
(defun org-ctrl-c-ctrl-c (&optional arg)
@@ -20295,22 +21028,20 @@ This command does many different things, depending on context:
(interactive "P")
(cond
((or (and (boundp 'org-clock-overlays) org-clock-overlays)
- org-occur-highlights
- org-latex-fragment-image-overlays)
+ org-occur-highlights)
(and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
(org-remove-occur-highlights)
- (org-remove-latex-fragment-image-overlays)
(message "Temporary highlights/overlays removed from current buffer"))
((and (local-variable-p 'org-finish-function (current-buffer))
(fboundp org-finish-function))
(funcall org-finish-function))
((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
(t
- (let* ((context (org-element-context)) (type (org-element-type context)))
- ;; Test if point is within a blank line.
- (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"))
+ (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))
@@ -20320,16 +21051,16 @@ This command does many different things, depending on context:
((bold code entity export-snippet inline-babel-call inline-src-block
italic latex-fragment line-break macro strike-through subscript
superscript underline verbatim)
- (while (and (setq context (org-element-property :parent context))
- (not (memq (setq type (org-element-type context))
- '(radio-target paragraph verse-block
- table-cell)))))))
+ (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)
- (= (point-at-bol) (org-element-property :begin parent)))
+ (= (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
@@ -20348,7 +21079,7 @@ This command does many different things, depending on context:
(item
;; At an item: a double C-u set checkbox to "[-]"
;; unconditionally, whereas a single one will toggle its
- ;; presence. Without an universal argument, if the item
+ ;; 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))
@@ -20477,6 +21208,39 @@ This command does many different things, depending on context:
(let ((org-note-abort t))
(funcall org-finish-function))))
+(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."
+ (interactive "*P")
+ (if (save-excursion
+ (if ARG (beginning-of-line)
+ (forward-line -1))
+ (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))
+ (org-trim (delete-and-extract-region
+ (line-beginning-position)
+ (line-end-position)))))))
+ (unless (bobp) (delete-region (point) (1- (point))))
+ (goto-char (or (match-end 4)
+ (match-beginning 5)
+ (match-end 0)))
+ (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)))
+
(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."
@@ -20491,44 +21255,78 @@ If `org-special-ctrl-o' is nil, just call `open-line' everywhere."
(defun org-return (&optional indent)
"Goto next table row or insert a newline.
+
Calls `org-table-next-row' or `newline', depending on context.
-See the individual commands for more information."
+
+When optional INDENT argument is non-nil, call
+`newline-and-indent' instead of `newline'.
+
+When `org-return-follows-link' is non-nil and point is on
+a timestamp or a link, call `org-open-at-point'. However, it
+will not happen if point is in a table or on a \"dead\"
+object (e.g., within a comment). In these case, you need to use
+`org-open-at-point' directly."
(interactive)
- (let (org-ts-what)
- (cond
- ((or (bobp) (org-in-src-block-p))
- (if indent (newline-and-indent) (newline)))
- ((org-at-table-p)
- (org-table-justify-field-maybe)
- (call-interactively 'org-table-next-row))
- ;; when `newline-and-indent' is called within a list, make sure
- ;; text moved stays inside the item.
- ((and (org-in-item-p) indent)
- (if (and (org-at-item-p) (>= (point) (match-end 0)))
- (progn
- (save-match-data (newline))
- (org-indent-line-to (length (match-string 0))))
- (let ((ind (org-get-indentation)))
- (newline)
- (if (org-looking-back org-list-end-re)
- (org-indent-line)
- (org-indent-line-to ind)))))
- ((and org-return-follows-link
- (org-at-timestamp-p t)
- (not (eq org-ts-what 'after)))
- (org-follow-timestamp-link))
- ((and org-return-follows-link
- (let ((tprop (get-text-property (point) 'face)))
- (or (eq tprop 'org-link)
- (and (listp tprop) (memq 'org-link tprop)))))
- (call-interactively 'org-open-at-point))
- ((and (org-at-heading-p)
- (looking-at
- (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")))
- (org-show-entry)
- (end-of-line 1)
- (newline))
- (t (if indent (newline-and-indent) (newline))))))
+ (if (and (not (bolp))
+ (save-excursion (beginning-of-line)
+ (looking-at org-complex-heading-regexp)))
+ ;; At headline.
+ (let ((tags-column (when (match-beginning 5)
+ (save-excursion (goto-char (match-beginning 5))
+ (current-column))))
+ ;; Test if before or after headline title.
+ (string (when (and (match-end 4)
+ (not (or (< (point)
+ (or (match-end 3)
+ (match-end 2)
+ (save-excursion
+ (goto-char (match-beginning 4))
+ (skip-chars-backward " \t")
+ (point))))
+ (and (match-beginning 5)
+ (>= (point) (match-beginning 5))))))
+ ;; Point is on headline keywords, tags or cookies. Do not break
+ ;; them: add a newline after the headline instead.
+ (org-string-nw-p
+ (delete-and-extract-region (point) (match-end 4))))))
+ ;; Adjust alignment of tags.
+ (when (and tags-column string)
+ (org-align-tags-here (if org-auto-align-tags
+ org-tags-column
+ tags-column)))
+ (end-of-line)
+ (org-show-entry)
+ (if indent (newline-and-indent) (newline))
+ (and string (save-excursion (insert (org-trim string)))))
+ (let* ((context (if org-return-follows-link (org-element-context)
+ (org-element-at-point)))
+ (type (org-element-type context)))
+ (cond
+ ;; In a table, call `org-table-next-row'.
+ ((or (and (eq type 'table)
+ (>= (point) (org-element-property :contents-begin context))
+ (< (point) (org-element-property :contents-end context)))
+ (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 but not on white spaces after it,
+ ;; call `org-open-line' if `org-return-follows-link' allows it.
+ ((and org-return-follows-link
+ (memq type '(link timestamp))
+ (< (point)
+ (save-excursion (goto-char (org-element-property :end context))
+ (skip-chars-backward " \t")
+ (point))))
+ (call-interactively #'org-open-at-point))
+ ;; In a list, make sure indenting keeps trailing text within.
+ ((and indent
+ (not (eolp))
+ (org-element-lineage context '(item)))
+ (let ((trailing-data
+ (delete-and-extract-region (point) (line-end-position))))
+ (newline-and-indent)
+ (save-excursion (insert trailing-data))))
+ (t (if indent (newline-and-indent) (newline)))))))
(defun org-return-indent ()
"Goto next table row or insert a newline and indent.
@@ -20641,6 +21439,8 @@ With a prefix argument ARG, change the region in a single item."
((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
@@ -20651,6 +21451,7 @@ With a prefix argument ARG, change the region in a single item."
;; 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))))
@@ -20660,6 +21461,15 @@ With a prefix argument ARG, change the region in a single item."
(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
@@ -20672,19 +21482,19 @@ With a prefix argument ARG, change the region in a single item."
;; 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))))
+ (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
@@ -20760,31 +21570,16 @@ number of stars to add."
;; Case 2. Started at an item: change items into headlines.
;; One star will be added by `org-list-to-subtree'.
((org-at-item-p)
- (let* ((stars (make-string
- ;; subtract the star that will be added again by
- ;; `org-list-to-subtree'
- (if (numberp nstars) (1- nstars)
- (or (org-current-level) 0))
- ?*))
- (add-stars
- (cond (nstars "") ; stars from prefix only
- ((equal stars "") "") ; before first heading
- (org-odd-levels-only "*") ; inside heading, odd
- (t "")))) ; inside heading, oddeven
- (while (< (point) end)
- (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))))
- (save-restriction
- (narrow-to-region (point) list-end)
- (insert
- (org-list-to-subtree
- (org-list-parse-list t)
- '(:istart (concat stars add-stars (funcall get-stars depth))
- :icount (concat stars add-stars (funcall get-stars depth)))))))
- (setq toggled t))
- (forward-line))))
+ (while (< (point) end)
+ (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))))
+ (save-restriction
+ (narrow-to-region (point) list-end)
+ (insert (org-list-to-subtree (org-list-parse-list t)))))
+ (setq toggled t))
+ (forward-line)))
;; Case 3. Started at normal text: make every line an heading,
;; skipping headlines and items.
(t (let* ((stars
@@ -20811,17 +21606,8 @@ on context. See the individual commands for more information."
(interactive "P")
(org-check-before-invisible-edit 'insert)
(or (run-hook-with-args-until-success 'org-metareturn-hook)
- (let* ((element (org-element-at-point))
- (type (org-element-type element)))
- (when (eq type 'table-row)
- (setq element (org-element-property :parent element))
- (setq type 'table))
- (if (and (eq type 'table)
- (eq (org-element-property :type element) 'org)
- (>= (point) (org-element-property :contents-begin element))
- (< (point) (org-element-property :contents-end element)))
- (call-interactively 'org-table-wrap-region)
- (call-interactively 'org-insert-heading)))))
+ (call-interactively (if (org-at-table-p) #'org-table-wrap-region
+ #'org-insert-heading))))
;;; Menu entries
@@ -20889,7 +21675,11 @@ on context. See the individual commands for more information."
["Import from File" org-table-import (not (org-at-table-p))]
["Export to File" org-table-export (org-at-table-p)]
"--"
- ["Create/Convert from/to table.el" org-table-create-with-table.el t]))
+ ["Create/Convert from/to table.el" org-table-create-with-table.el t]
+ "--"
+ ("Plot"
+ ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
+ ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
(easy-menu-define org-org-menu org-mode-map "Org menu"
'("Org"
@@ -20914,8 +21704,8 @@ on context. See the individual commands for more information."
("Edit Structure"
["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
"--"
- ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)]
- ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)]
+ ["Move Subtree Up" org-metaup (org-at-heading-p)]
+ ["Move Subtree Down" org-metadown (org-at-heading-p)]
"--"
["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)]
["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)]
@@ -20943,7 +21733,7 @@ on context. See the individual commands for more information."
("Archive"
["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)]
"--"
- ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)]
+ ["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)]
["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)]
["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]
)
@@ -21269,9 +22059,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
;;; Generally useful functions
-(defun org-get-at-bol (property)
- "Get text property PROPERTY at beginning of line."
- (get-text-property (point-at-bol) property))
+(defsubst 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))
(defun org-find-text-property-in-string (prop s)
"Return the first non-nil value of property PROP in string S."
@@ -21310,17 +22100,6 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(>= (match-end 0) pos)
start))))
-(defun org-in-commented-line ()
- "Is point in a line starting with `#'?"
- (equal (char-after (point-at-bol)) ?#))
-
-(defun org-in-indented-comment-line ()
- "Is point in a line starting with `#' after some white space?"
- (save-excursion
- (save-match-data
- (goto-char (point-at-bol))
- (looking-at "[ \t]*#"))))
-
(defun org-in-verbatim-emphasis ()
(save-match-data
(and (org-in-regexp org-emph-re 2)
@@ -21484,12 +22263,6 @@ N may optionally be the number of spaces to remove."
(or (buffer-base-buffer buffer)
buffer)))
-(defun org-trim (s)
- "Remove whitespace at beginning and end of string."
- (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s)))
- (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s)))
- s)
-
(defun org-wrap (string &optional width lines)
"Wrap string to either a number of lines, or a width in characters.
If WIDTH is non-nil, the string is wrapped to that width, however many lines
@@ -21527,13 +22300,12 @@ The return value is a list of lines, without newlines at the end."
(defun org-split-string (string &optional separators)
"Splits STRING into substrings at SEPARATORS.
+SEPARATORS is a regular expression.
No empty strings are returned if there are matches at the beginning
and end of string."
- (let ((rexp (or separators "[ \f\t\n\r\v]+"))
- (start 0)
- notfirst
- (list nil))
- (while (and (string-match rexp string
+ ;; FIXME: why not use (split-string STRING SEPARATORS t)?
+ (let ((start 0) notfirst list)
+ (while (and (string-match (or separators "[ \f\t\n\r\v]+") string
(if (and notfirst
(= start (match-beginning 0))
(< start (length string)))
@@ -21543,14 +22315,10 @@ and end of string."
(or (eq (match-beginning 0) 0)
(and (eq (match-beginning 0) (match-end 0))
(eq (match-beginning 0) start))
- (setq list
- (cons (substring string start (match-beginning 0))
- list)))
+ (push (substring string start (match-beginning 0)) list))
(setq start (match-end 0)))
(or (eq start (length string))
- (setq list
- (cons (substring string start)
- list)))
+ (push (substring string start) list))
(nreverse list)))
(defun org-quote-vert (s)
@@ -21568,9 +22336,7 @@ and end of string."
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)
- (or (and (setq ov (overlays-at (point)))
- (memq 'org-block-background
- (overlay-properties (car ov))))
+ (or (and (eq (get-char-property (point) 'src-block) t))
(and (not inside)
(save-match-data
(save-excursion
@@ -21598,7 +22364,7 @@ contexts are:
:clocktable in a clocktable
:src-block in a source block
:link on a hyperlink
-:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE.
+:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT.
:target on a <<target>>
:radio-target on a <<<radio-target>>>
:latex-fragment on a LaTeX fragment
@@ -21648,16 +22414,16 @@ and :keyword."
;; New the "medium" contexts: clocktables, source blocks
(cond ((org-in-clocktable-p)
(push (list :clocktable
- (and (or (looking-at "#\\+BEGIN: clocktable")
- (search-backward "#+BEGIN: clocktable" nil t))
- (match-beginning 0))
- (and (re-search-forward "#\\+END:?" nil t)
+ (and (or (looking-at "[ \t]*\\(#\\+BEGIN: clocktable\\)")
+ (re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t))
+ (match-beginning 1))
+ (and (re-search-forward "[ \t]*#\\+END:?" nil t)
(match-end 0))) clist))
((org-in-src-block-p)
(push (list :src-block
- (and (or (looking-at "#\\+BEGIN_SRC")
- (search-backward "#+BEGIN_SRC" nil t))
- (match-beginning 0))
+ (and (or (looking-at "[ \t]*\\(#\\+BEGIN_SRC\\)")
+ (re-search-backward "[ \t]*\\(#+BEGIN_SRC\\)" nil t))
+ (match-beginning 1))
(and (search-forward "#+END_SRC" nil t)
(match-beginning 0))) clist))))
(goto-char p)
@@ -21696,13 +22462,13 @@ and :keyword."
(setq clist (nreverse (delq nil clist)))
clist))
-;; FIXME: Compare with at-regexp-p Do we need both?
(defun org-in-regexp (re &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 both before and after 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."
+ "Check if point is inside a match of RE.
+
+Normally only the current line is checked, but you can include
+NLINES extra lines after 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
(let ((pos (point))
(eol (point-at-eol (+ 1 (or nlines 0))))
@@ -21713,18 +22479,8 @@ really on, so that the block visually is on the match."
(if (and (<= (match-beginning 0) pos)
(>= (+ inc (match-end 0)) pos))
(throw 'exit (cons (match-beginning 0) (match-end 0)))))))))
-
-(defun org-at-regexp-p (regexp)
- "Is point inside a match of REGEXP in the current line?"
- (catch 'exit
- (save-excursion
- (let ((pos (point)) (end (point-at-eol)))
- (beginning-of-line 1)
- (while (re-search-forward regexp end t)
- (if (and (<= (match-beginning 0) pos)
- (>= (match-end 0) pos))
- (throw 'exit t)))
- nil))))
+(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp
+ "Org mode 8.3")
(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.
@@ -21745,7 +22501,7 @@ position before START-RE (resp. after END-RE)."
(save-excursion
;; Point is on a block when on START-RE or if START-RE can be
;; found before it...
- (and (or (org-at-regexp-p start-re)
+ (and (or (org-in-regexp start-re)
(re-search-backward start-re limit-up t))
(setq beg (match-beginning 0))
;; ... and END-RE after it...
@@ -21781,17 +22537,6 @@ block from point."
names))
nil)))
-(defun org-in-drawer-p ()
- "Is point within a drawer?"
- (save-match-data
- (let ((case-fold-search t)
- (lim-up (save-excursion (outline-previous-heading)))
- (lim-down (save-excursion (outline-next-heading))))
- (org-between-regexps-p
- (concat "^[ \t]*:" (regexp-opt org-drawers) ":")
- "^[ \t]*:end:.*$"
- lim-up lim-down))))
-
(defun org-occur-in-agenda-files (regexp &optional nlines)
"Call `multi-occur' with buffers for all agenda files."
(interactive "sOrg-files matching: \np")
@@ -21823,13 +22568,13 @@ block from point."
(org-reveal))))
;; Emacs 22
(defadvice occur-mode-goto-occurrence
- (after org-occur-reveal activate)
+ (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)
+ (after org-occur-reveal activate)
(and (derived-mode-p 'org-mode) (org-reveal)))
(defadvice occur-mode-display-occurrence
- (after org-occur-reveal activate)
+ (after org-occur-reveal activate)
(when (derived-mode-p 'org-mode)
(let ((pos (occur-mode-find-occurrence)))
(with-current-buffer (marker-buffer pos)
@@ -21873,7 +22618,7 @@ The function returns the new ALIST."
(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)
+ alist)
rtn))
(defun org-delete-all (elts list)
@@ -22062,8 +22807,9 @@ the agenda) or the current time of the day."
(when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp))
(setq hod (string-to-number (match-string 1 tp))
mod (string-to-number (match-string 2 tp))))
- (or tp (setq hod (nth 2 (decode-time (current-time)))
- mod (nth 1 (decode-time (current-time))))))
+ (or tp (let ((now (decode-time)))
+ (setq hod (nth 2 now)
+ mod (nth 1 now)))))
(cond
((eq major-mode 'calendar-mode)
(setq date (calendar-cursor-to-date)
@@ -22095,169 +22841,344 @@ hierarchy of headlines by UP levels before marking the subtree."
;;; Indentation
+(defun org--get-expected-indentation (element contentsp)
+ "Expected indentation column for current line, according to ELEMENT.
+ELEMENT is an element containing point. CONTENTSP is non-nil
+when indentation is to be computed according to contents of
+ELEMENT."
+ (let ((type (org-element-type element))
+ (start (org-element-property :begin element))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (org-with-wide-buffer
+ (cond
+ (contentsp
+ (case type
+ ((diary-sexp footnote-definition) 0)
+ ((headline inlinetask nil)
+ (if (not org-adapt-indentation) 0
+ (let ((level (org-current-level)))
+ (if level (1+ level) 0))))
+ ((item plain-list) (org-list-item-body-column post-affiliated))
+ (t
+ (goto-char start)
+ (org-get-indentation))))
+ ((memq type '(headline inlinetask nil))
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))
+ (org--get-expected-indentation element t)
+ 0))
+ ((memq type '(diary-sexp footnote-definition)) 0)
+ ;; First paragraph of a footnote definition or an item.
+ ;; Indent like parent.
+ ((< (line-beginning-position) start)
+ (org--get-expected-indentation
+ (org-element-property :parent element) t))
+ ;; At first line: indent according to previous sibling, if any,
+ ;; ignoring footnote definitions and inline tasks, or parent's
+ ;; contents.
+ ((= (line-beginning-position) start)
+ (catch 'exit
+ (while t
+ (if (= (point-min) start) (throw 'exit 0)
+ (goto-char (1- start))
+ (let* ((previous (org-element-at-point))
+ (parent previous))
+ (while (and parent (<= (org-element-property :end parent) start))
+ (setq previous parent
+ parent (org-element-property :parent parent)))
+ (cond
+ ((not previous) (throw 'exit 0))
+ ((> (org-element-property :end previous) start)
+ (throw 'exit (org--get-expected-indentation previous t)))
+ ((memq (org-element-type previous)
+ '(footnote-definition inlinetask))
+ (setq start (org-element-property :begin previous)))
+ (t (goto-char (org-element-property :begin previous))
+ (throw 'exit
+ (if (bolp) (org-get-indentation)
+ ;; At first paragraph in an item or
+ ;; a footnote definition.
+ (org--get-expected-indentation
+ (org-element-property :parent previous) t))))))))))
+ ;; Otherwise, move to the first non-blank line above.
+ (t
+ (beginning-of-line)
+ (let ((pos (point)))
+ (skip-chars-backward " \r\t\n")
+ (cond
+ ;; Two blank lines end a footnote definition or a plain
+ ;; list. When we indent an empty line after them, the
+ ;; containing list or footnote definition is over, so it
+ ;; qualifies as a previous sibling. Therefore, we indent
+ ;; like its first line.
+ ((and (memq type '(footnote-definition plain-list))
+ (> (count-lines (point) pos) 2))
+ (goto-char start)
+ (org-get-indentation))
+ ;; Line above is the first one of a paragraph at the
+ ;; beginning of an item or a footnote definition. Indent
+ ;; like parent.
+ ((< (line-beginning-position) start)
+ (org--get-expected-indentation
+ (org-element-property :parent element) t))
+ ;; Line above is the beginning of an element, i.e., point
+ ;; was originally on the blank lines between element's start
+ ;; and contents.
+ ((= (line-beginning-position) post-affiliated)
+ (org--get-expected-indentation element t))
+ ;; POS is after contents in a greater element. Indent like
+ ;; the beginning of the 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.
+ ((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))))
+ (goto-char start)
+ (org-get-indentation)))
+ ;; In any other case, indent like the current line.
+ (t (org-get-indentation)))))))))
+
+(defun org--align-node-property ()
+ "Align node property at point.
+Alignment is done according to `org-property-format', which see."
+ (when (save-excursion
+ (beginning-of-line)
+ (looking-at org-property-re))
+ (replace-match
+ (concat (match-string 4)
+ (org-trim
+ (format org-property-format (match-string 1) (match-string 3))))
+ t t)))
+
(defun org-indent-line ()
- "Indent line depending on context."
+ "Indent line depending on context.
+
+Indentation is done according to the following rules:
+
+ - Footnote definitions, diary sexps, headlines and inline tasks
+ have to start at column 0.
+
+ - On the very first line of an element, consider, in order, the
+ next rules until one matches:
+
+ 1. If there's a sibling element before, ignoring footnote
+ definitions and inline tasks, indent like its first line.
+
+ 2. If element has a parent, indent like its contents. More
+ precisely, if parent is an item, indent after the
+ description part, if any, or the bullet (see
+ `org-list-description-max-indent'). Else, indent like
+ parent's first line.
+
+ 3. Otherwise, indent relatively to current level, if
+ `org-adapt-indentation' is non-nil, or to left margin.
+
+ - On a blank line at the end of an element, indent according to
+ the type of the element. More precisely
+
+ 1. If element is a plain list, an item, or a footnote
+ definition, indent like the very last element within.
+
+ 2. If element is a paragraph, indent like its last non blank
+ line.
+
+ 3. Otherwise, indent like its very first line.
+
+ - In the code part of a source block, use language major mode
+ to indent current line if `org-src-tab-acts-natively' is
+ non-nil. If it is nil, do nothing.
+
+ - 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].
+
+Also align node properties according to `org-property-format'."
(interactive)
- (let* ((pos (point))
- (itemp (org-at-item-p))
- (case-fold-search t)
- (org-drawer-regexp (or org-drawer-regexp "\000"))
- (inline-task-p (and (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p)))
- (inline-re (and inline-task-p
- (org-inlinetask-outline-regexp)))
- column)
- (if (and orgstruct-is-++ (eq pos (point)))
- (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars))))
- (indent-according-to-mode))
- (beginning-of-line 1)
- (cond
- ;; Headings
- ((looking-at org-outline-regexp) (setq column 0))
- ;; Footnote definition
- ((looking-at org-footnote-definition-re) (setq column 0))
- ;; Literal examples
- ((looking-at "[ \t]*:\\( \\|$\\)")
- (setq column (org-get-indentation))) ; do nothing
- ;; Lists
- ((ignore-errors (goto-char (org-in-item-p)))
- (setq column (if itemp
- (org-get-indentation)
- (org-list-item-body-column (point))))
- (goto-char pos))
- ;; Drawers
- ((and (looking-at "[ \t]*:END:")
- (save-excursion (re-search-backward org-drawer-regexp nil t)))
- (save-excursion
- (goto-char (1- (match-beginning 1)))
- (setq column (current-column))))
- ;; Special blocks
- ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)")
- (save-excursion
- (re-search-backward
- (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
- (setq column (org-get-indentation (match-string 0))))
- ((and (not (looking-at "[ \t]*#\\+begin_"))
- (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
- (save-excursion
- (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
- (setq column
- (cond ((equal (downcase (match-string 1)) "src")
- ;; src blocks: let `org-edit-src-exit' handle them
- (org-get-indentation))
- ((equal (downcase (match-string 1)) "example")
- (max (org-get-indentation)
- (org-get-indentation (match-string 0))))
- (t
- (org-get-indentation (match-string 0))))))
- ;; This line has nothing special, look at the previous relevant
- ;; line to compute indentation
- (t
- (beginning-of-line 0)
- (while (and (not (bobp))
- (not (looking-at org-table-line-regexp))
- (not (looking-at org-drawer-regexp))
- ;; When point started in an inline task, do not move
- ;; above task starting line.
- (not (and inline-task-p (looking-at inline-re)))
- ;; Skip drawers, blocks, empty lines, verbatim,
- ;; comments, tables, footnotes definitions, lists,
- ;; inline tasks.
- (or (and (looking-at "[ \t]*:END:")
- (re-search-backward org-drawer-regexp nil t))
- (and (looking-at "[ \t]*#\\+end_")
- (re-search-backward "[ \t]*#\\+begin_"nil t))
- (looking-at "[ \t]*[\n:#|]")
- (looking-at org-footnote-definition-re)
- (and (not inline-task-p)
- (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p)
- (or (org-inlinetask-goto-beginning) t))))
- (beginning-of-line 0))
- (cond
- ;; There was a list item above.
- ((ignore-errors (goto-char (org-in-item-p)))
- (goto-char (org-list-get-top-point (org-list-struct)))
- (setq column (org-get-indentation)))
- ;; There was an heading above.
- ((looking-at "\\*+[ \t]+")
- (if (not org-adapt-indentation)
- (setq column 0)
- (goto-char (match-end 0))
- (setq column (current-column))))
- ;; A drawer had started and is unfinished
- ((looking-at org-drawer-regexp)
- (goto-char (1- (match-beginning 1)))
- (setq column (current-column)))
- ;; Else, nothing noticeable found: get indentation and go on.
- (t (setq column (org-get-indentation))))))
- ;; Now apply indentation and move cursor accordingly
- (goto-char pos)
- (if (<= (current-column) (current-indentation))
- (org-indent-line-to column)
- (save-excursion (org-indent-line-to column)))
- ;; Special polishing for properties, see `org-property-format'
- (setq column (current-column))
- (beginning-of-line 1)
- (if (looking-at org-property-re)
- (replace-match (concat (match-string 4)
- (format org-property-format
- (match-string 1) (match-string 3)))
- t t))
- (org-move-to-column column))))
+ (cond
+ (orgstruct-is-++
+ (let ((indent-line-function
+ (cadadr (assq 'indent-line-function org-fb-vars))))
+ (indent-according-to-mode)))
+ ((org-at-heading-p) 'noindent)
+ (t
+ (let* ((element (save-excursion (beginning-of-line) (org-element-at-point)))
+ (type (org-element-type element)))
+ (cond ((and (memq type '(plain-list item))
+ (= (line-beginning-position)
+ (org-element-property :post-affiliated element)))
+ 'noindent)
+ ((and (eq type 'src-block)
+ org-src-tab-acts-natively
+ (> (line-beginning-position)
+ (org-element-property :post-affiliated element))
+ (< (line-beginning-position)
+ (org-with-wide-buffer
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
+ (t
+ (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))))
+ ;; Align node property. Also preserve current column.
+ (when (eq type 'node-property)
+ (let ((column (current-column)))
+ (org--align-node-property)
+ (org-move-to-column column)))))))))
+
+(defun org-indent-region (start end)
+ "Indent each non-blank line in the region.
+Called from a program, START and END specify the region to
+indent. The function will not indent contents of example blocks,
+verse blocks and export blocks as leading white spaces are
+assumed to be significant there."
+ (interactive "r")
+ (save-excursion
+ (goto-char start)
+ (skip-chars-forward " \r\t\n")
+ (unless (eobp) (beginning-of-line))
+ (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))))
+ (while (< (point) limit)
+ (unless (org-looking-at-p "[ \t]*$") (org-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)
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element))
+ (element-end (copy-marker (org-element-property :end element)))
+ (ind (org--get-expected-indentation element nil)))
+ (cond
+ ((or (memq type '(paragraph table table-row))
+ (not (or (org-element-property :contents-begin element)
+ (memq type
+ '(example-block export-block src-block)))))
+ ;; Elements here are indented as a single block. Also
+ ;; align node properties.
+ (when (eq type 'node-property)
+ (org--align-node-property)
+ (beginning-of-line))
+ (funcall indent-to ind element-end))
+ (t
+ ;; Elements in this category consist of three parts:
+ ;; before the contents, the contents, and after the
+ ;; contents. The contents are treated specially,
+ ;; according to the element type, or not indented at
+ ;; all. Other parts are indented as a single block.
+ (let* ((post (copy-marker
+ (org-element-property :post-affiliated element)))
+ (cbeg
+ (copy-marker
+ (cond
+ ((not (org-element-property :contents-begin element))
+ ;; Fake contents for source blocks.
+ (org-with-wide-buffer
+ (goto-char post)
+ (forward-line)
+ (point)))
+ ((memq type '(footnote-definition item plain-list))
+ ;; Contents in these elements could start on
+ ;; the same line as the beginning of the
+ ;; element. Make sure we start indenting
+ ;; from the second line.
+ (org-with-wide-buffer
+ (goto-char post)
+ (end-of-line)
+ (skip-chars-forward " \r\t\n")
+ (if (eobp) (point) (line-beginning-position))))
+ (t (org-element-property :contents-begin element)))))
+ (cend (copy-marker
+ (or (org-element-property :contents-end element)
+ ;; Fake contents for source blocks.
+ (org-with-wide-buffer
+ (goto-char element-end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position)))
+ t)))
+ ;; Do not change items indentation individually as it
+ ;; might break the list as a whole. On the other
+ ;; hand, when at a plain list, indent it as a whole.
+ (cond ((eq type 'plain-list)
+ (let ((offset (- ind (org-get-indentation))))
+ (unless (zerop offset)
+ (indent-rigidly (org-element-property :begin element)
+ (org-element-property :end element)
+ offset))
+ (goto-char cbeg)))
+ ((eq type 'item) (goto-char cbeg))
+ (t (funcall indent-to ind cbeg)))
+ (when (< (point) end)
+ (case type
+ ((example-block export-block verse-block))
+ (src-block
+ ;; In a source block, indent source code
+ ;; according to language major mode, but only if
+ ;; `org-src-tab-acts-natively' is non-nil.
+ (when (and (< (point) end) org-src-tab-acts-natively)
+ (ignore-errors
+ (org-babel-do-in-edit-buffer
+ (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)))
+ (set-marker post nil)
+ (set-marker cbeg nil)
+ (set-marker cend nil))))
+ (set-marker element-end nil))))
+ (set-marker end nil))))
(defun org-indent-drawer ()
"Indent the drawer at point."
(interactive)
- (let ((p (point))
- (e (and (save-excursion (re-search-forward ":END:" nil t))
- (match-end 0)))
- (folded
- (save-excursion
- (end-of-line)
- (when (overlays-at (point))
- (member 'invisible (overlay-properties
- (car (overlays-at (point)))))))))
- (when folded (org-cycle))
- (indent-for-tab-command)
- (while (and (move-beginning-of-line 2) (< (point) e))
- (indent-for-tab-command))
- (goto-char p)
- (when folded (org-cycle)))
+ (unless (save-excursion
+ (beginning-of-line)
+ (org-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))
+ (user-error "Not at a drawer"))
+ (org-with-wide-buffer
+ (org-indent-region (org-element-property :begin element)
+ (org-element-property :end element))))
(message "Drawer at point indented"))
(defun org-indent-block ()
"Indent the block at point."
(interactive)
- (let ((p (point))
- (case-fold-search t)
- (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t))
- (match-end 0)))
- (folded
- (save-excursion
- (end-of-line)
- (when (overlays-at (point))
- (member 'invisible (overlay-properties
- (car (overlays-at (point)))))))))
- (when folded (org-cycle))
- (indent-for-tab-command)
- (while (and (move-beginning-of-line 2) (< (point) e))
- (indent-for-tab-command))
- (goto-char p)
- (when folded (org-cycle)))
+ (unless (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search t))
+ (org-looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
+ (user-error "Not at a block"))
+ (let ((element (org-element-at-point)))
+ (unless (memq (org-element-type element)
+ '(comment-block center-block dynamic-block example-block
+ export-block quote-block special-block
+ src-block verse-block))
+ (user-error "Not at a block"))
+ (org-with-wide-buffer
+ (org-indent-region (org-element-property :begin element)
+ (org-element-property :end element))))
(message "Block at point indented"))
-(defun org-indent-region (start end)
- "Indent region."
- (interactive "r")
- (save-excursion
- (let ((line-end (org-current-line end)))
- (goto-char start)
- (while (< (org-current-line) line-end)
- (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe))
- (t (call-interactively 'org-indent-line)))
- (move-beginning-of-line 2)))))
-
;;; Filling
@@ -22318,69 +23239,64 @@ matches in paragraphs or comments, use it."
(when (derived-mode-p 'message-mode)
(save-excursion
(beginning-of-line)
- (cond ((or (not (message-in-body-p))
- (looking-at orgtbl-line-start-regexp))
- (throw 'exit nil))
+ (cond ((not (message-in-body-p)) (throw 'exit nil))
+ ((org-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)
- (throw 'exit (make-string (length (match-string 0)) ? ))))))
+ (throw 'exit (make-string (length (match-string 0)) ?\s))))))
(org-with-wide-buffer
- (let* ((p (line-beginning-position))
- (element (save-excursion
- (beginning-of-line)
- (or (ignore-errors (org-element-at-point))
- (user-error "An element cannot be parsed line %d"
- (line-number-at-pos (point))))))
- (type (org-element-type element))
- (post-affiliated (org-element-property :post-affiliated element)))
- (unless (and post-affiliated (< p post-affiliated))
- (case type
- (comment
- (save-excursion
- (beginning-of-line)
- (looking-at "[ \t]*")
- (concat (match-string 0) "# ")))
- (footnote-definition "")
- ((item plain-list)
- (make-string (org-list-item-body-column
- (or post-affiliated
- (org-element-property :begin element)))
- ? ))
- (paragraph
- ;; Fill prefix is usually the same as the current line,
- ;; unless the paragraph is at the beginning of an item.
- (let ((parent (org-element-property :parent element)))
+ (unless (org-at-heading-p)
+ (let* ((p (line-beginning-position))
+ (element (save-excursion
+ (beginning-of-line)
+ (org-element-at-point)))
+ (type (org-element-type element))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (unless (< p post-affiliated)
+ (case type
+ (comment
(save-excursion
(beginning-of-line)
- (cond ((eq (org-element-type parent) 'item)
- (make-string (org-list-item-body-column
- (org-element-property :begin parent))
- ? ))
- ((and adaptive-fill-regexp
- ;; Locally disable
- ;; `adaptive-fill-function' to let
- ;; `fill-context-prefix' handle
- ;; `adaptive-fill-regexp' variable.
- (let (adaptive-fill-function)
- (fill-context-prefix
- post-affiliated
- (org-element-property :end element)))))
- ((looking-at "[ \t]+") (match-string 0))
- (t "")))))
- (comment-block
- ;; Only fill contents if P is within block boundaries.
- (let* ((cbeg (save-excursion (goto-char post-affiliated)
- (forward-line)
- (point)))
- (cend (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
- (when (and (>= p cbeg) (< p cend))
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
- (match-string 0)
- ""))))))))))
+ (looking-at "[ \t]*")
+ (concat (match-string 0) "# ")))
+ (footnote-definition "")
+ ((item plain-list)
+ (make-string (org-list-item-body-column post-affiliated) ?\s))
+ (paragraph
+ ;; Fill prefix is usually the same as the current line,
+ ;; unless the paragraph is at the beginning of an item.
+ (let ((parent (org-element-property :parent element)))
+ (save-excursion
+ (beginning-of-line)
+ (cond ((eq (org-element-type parent) 'item)
+ (make-string (org-list-item-body-column
+ (org-element-property :begin parent))
+ ?\s))
+ ((and adaptive-fill-regexp
+ ;; Locally disable
+ ;; `adaptive-fill-function' to let
+ ;; `fill-context-prefix' handle
+ ;; `adaptive-fill-regexp' variable.
+ (let (adaptive-fill-function)
+ (fill-context-prefix
+ post-affiliated
+ (org-element-property :end element)))))
+ ((looking-at "[ \t]+") (match-string 0))
+ (t "")))))
+ (comment-block
+ ;; Only fill contents if P is within block boundaries.
+ (let* ((cbeg (save-excursion (goto-char post-affiliated)
+ (forward-line)
+ (point)))
+ (cend (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (when (and (>= p cbeg) (< p cend))
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (match-string 0)
+ "")))))))))))
(declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el
@@ -22451,25 +23367,18 @@ a footnote definition, try to fill the first paragraph within."
(concat "^" message-cite-prefix-regexp) end t))
(setq end (match-beginning 0))))
;; Fill paragraph, taking line breaks into account.
- ;; For that, slice the paragraph using line breaks as
- ;; separators, and fill the parts in reverse order to
- ;; avoid messing with markers.
(save-excursion
- (goto-char end)
- (mapc
- (lambda (pos)
- (fill-region-as-paragraph pos (point) justify)
- (goto-char pos))
- ;; Find the list of ending positions for line breaks
- ;; in the current paragraph. Add paragraph
- ;; beginning to include first slice.
- (nreverse
- (cons beg
- (org-element-map
- (org-element--parse-objects
- beg end nil (org-element-restriction 'paragraph))
- 'line-break
- (lambda (lb) (org-element-property :end lb)))))))
+ (goto-char beg)
+ (let ((cuts (list beg)))
+ (while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
+ (when (eq 'line-break
+ (org-element-type
+ (save-excursion (backward-char)
+ (org-element-context))))
+ (push (point) cuts)))
+ (dolist (c (delq end cuts))
+ (fill-region-as-paragraph c end justify)
+ (setq end c))))
t)))
;; Contents of `comment-block' type elements should be
;; filled as plain text, but only if point is within block
@@ -22550,6 +23459,130 @@ non-nil."
(insert-before-markers-and-inherit fill-prefix))
+;;; Fixed Width Areas
+
+(defun org-toggle-fixed-width ()
+ "Toggle fixed-width markup.
+
+Add or remove fixed-width markup on current line, whenever it
+makes sense. Return an error otherwise.
+
+If a region is active and if it contains only fixed-width areas
+or blank lines, remove all fixed-width markup in it. If the
+region contains anything else, convert all non-fixed-width lines
+to fixed-width ones.
+
+Blank lines at the end of the region are ignored unless the
+region only contains such lines."
+ (interactive)
+ (if (not (org-region-active-p))
+ ;; No region:
+ ;;
+ ;; Remove fixed width marker only in a fixed-with element.
+ ;;
+ ;; Add fixed width maker in paragraphs, in blank lines after
+ ;; elements or at the beginning of a headline or an inlinetask,
+ ;; and before any one-line elements (e.g., a clock).
+ (progn
+ (beginning-of-line)
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element)))
+ (cond
+ ((and (eq type 'fixed-width)
+ (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)"))
+ (replace-match
+ "" nil nil nil (if (= (line-end-position) (match-end 0)) 0 1)))
+ ((and (memq type '(babel-call clock comment diary-sexp headline
+ horizontal-rule keyword paragraph
+ planning))
+ (<= (org-element-property :post-affiliated element) (point)))
+ (skip-chars-forward " \t")
+ (insert ": "))
+ ((and (org-looking-at-p "[ \t]*$")
+ (or (eq type 'inlinetask)
+ (save-excursion
+ (skip-chars-forward " \r\t\n")
+ (<= (org-element-property :end element) (point)))))
+ (delete-region (point) (line-end-position))
+ (org-indent-line)
+ (insert ": "))
+ (t (user-error "Cannot insert a fixed-width line here")))))
+ ;; Region active.
+ (let* ((begin (save-excursion
+ (goto-char (region-beginning))
+ (line-beginning-position)))
+ (end (copy-marker
+ (save-excursion
+ (goto-char (region-end))
+ (unless (eolp) (beginning-of-line))
+ (if (save-excursion (re-search-backward "\\S-" begin t))
+ (progn (skip-chars-backward " \r\t\n") (point))
+ (point)))))
+ (all-fixed-width-p
+ (catch 'not-all-p
+ (save-excursion
+ (goto-char begin)
+ (skip-chars-forward " \r\t\n")
+ (when (eobp) (throw 'not-all-p nil))
+ (while (< (point) end)
+ (let ((element (org-element-at-point)))
+ (if (eq (org-element-type element) 'fixed-width)
+ (goto-char (org-element-property :end element))
+ (throw 'not-all-p nil))))
+ t))))
+ (if all-fixed-width-p
+ (save-excursion
+ (goto-char begin)
+ (while (< (point) end)
+ (when (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)")
+ (replace-match
+ "" nil nil nil
+ (if (= (line-end-position) (match-end 0)) 0 1)))
+ (forward-line)))
+ (let ((min-ind (point-max)))
+ ;; Find minimum indentation across all lines.
+ (save-excursion
+ (goto-char begin)
+ (if (not (save-excursion (re-search-forward "\\S-" end t)))
+ (setq min-ind 0)
+ (catch 'zerop
+ (while (< (point) end)
+ (unless (org-looking-at-p "[ \t]*$")
+ (let ((ind (org-get-indentation)))
+ (setq min-ind (min min-ind ind))
+ (when (zerop ind) (throw 'zerop t))))
+ (forward-line)))))
+ ;; Loop over all lines and add fixed-width markup everywhere
+ ;; but in fixed-width lines.
+ (save-excursion
+ (goto-char begin)
+ (while (< (point) end)
+ (cond
+ ((org-at-heading-p)
+ (insert ": ")
+ (forward-line)
+ (while (and (< (point) end) (org-looking-at-p "[ \t]*$"))
+ (insert ":")
+ (forward-line)))
+ ((org-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)
+ (progn (goto-char element-end)
+ (skip-chars-backward " \r\t\n")
+ (forward-line))
+ (let ((limit (min end element-end)))
+ (while (< (point) limit)
+ (org-move-to-column min-ind t)
+ (insert ": ")
+ (forward-line))))))
+ (t
+ (org-move-to-column min-ind t)
+ (insert ": ")
+ (forward-line)))))))
+ (set-marker end nil))))
+
+
;;; Comments
;; Org comments syntax is quite complex. It requires the entire line
@@ -22579,78 +23612,124 @@ non-nil."
(defun org-insert-comment ()
"Insert an empty comment above current line.
-If the line is empty, insert comment at its beginning."
- (beginning-of-line)
- (if (looking-at "\\s-*$") (replace-match "") (open-line 1))
- (org-indent-line)
- (insert "# "))
+If the line is empty, insert comment at its beginning. When
+point is within a source block, comment according to the related
+major mode."
+ (if (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'src-block)
+ (< (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (line-end-position))
+ (point))
+ (> (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))
+ (point))))
+ (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
+ (beginning-of-line)
+ (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
+ (open-line 1))
+ (org-indent-line)
+ (insert "# ")))
(defvar comment-empty-lines) ; From newcomment.el.
(defun org-comment-or-uncomment-region (beg end &rest ignore)
"Comment or uncomment each non-blank line in the region.
Uncomment each non-blank line between BEG and END if it only
-contains commented lines. Otherwise, comment them."
- (save-restriction
- ;; Restrict region
- (narrow-to-region (save-excursion (goto-char beg)
- (skip-chars-forward " \r\t\n" end)
- (line-beginning-position))
- (save-excursion (goto-char end)
- (skip-chars-backward " \r\t\n" beg)
- (line-end-position)))
- (let ((uncommentp
- ;; UNCOMMENTP is non-nil when every non blank line between
- ;; BEG and END is a comment.
- (save-excursion
- (goto-char (point-min))
- (while (and (not (eobp))
- (let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'comment)
- (goto-char (min (point-max)
- (org-element-property
- :end element)))))))
- (eobp))))
- (if uncommentp
- ;; Only blank lines and comments in region: uncomment it.
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
- (replace-match "" nil nil nil 1))
- (forward-line)))
- ;; Comment each line in region.
- (let ((min-indent (point-max)))
- ;; First find the minimum indentation across all lines.
- (save-excursion
- (goto-char (point-min))
- (while (and (not (eobp)) (not (zerop min-indent)))
- (unless (looking-at "[ \t]*$")
- (setq min-indent (min min-indent (current-indentation))))
- (forward-line)))
- ;; Then loop over all lines.
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
- ;; Don't get fooled by invisible text (e.g. link path)
- ;; when moving to column MIN-INDENT.
- (let ((buffer-invisibility-spec nil))
- (org-move-to-column min-indent t))
- (insert comment-start))
- (forward-line))))))))
+contains commented lines. Otherwise, comment them. If region is
+strictly within a source block, use appropriate comment syntax."
+ (if (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'src-block)
+ (< (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (line-end-position))
+ beg)
+ (>= (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))
+ end)))
+ (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
+ (save-restriction
+ ;; Restrict region
+ (narrow-to-region (save-excursion (goto-char beg)
+ (skip-chars-forward " \r\t\n" end)
+ (line-beginning-position))
+ (save-excursion (goto-char end)
+ (skip-chars-backward " \r\t\n" beg)
+ (line-end-position)))
+ (let ((uncommentp
+ ;; UNCOMMENTP is non-nil when every non blank line between
+ ;; BEG and END is a comment.
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'comment)
+ (goto-char (min (point-max)
+ (org-element-property
+ :end element)))))))
+ (eobp))))
+ (if uncommentp
+ ;; Only blank lines and comments in region: uncomment it.
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
+ (replace-match "" nil nil nil 1))
+ (forward-line)))
+ ;; Comment each line in region.
+ (let ((min-indent (point-max)))
+ ;; First find the minimum indentation across all lines.
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (zerop min-indent)))
+ (unless (looking-at "[ \t]*$")
+ (setq min-indent (min min-indent (current-indentation))))
+ (forward-line)))
+ ;; Then loop over all lines.
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
+ ;; Don't get fooled by invisible text (e.g. link path)
+ ;; when moving to column MIN-INDENT.
+ (let ((buffer-invisibility-spec nil))
+ (org-move-to-column min-indent t))
+ (insert comment-start))
+ (forward-line)))))))))
+
+(defun org-comment-dwim (arg)
+ "Call `comment-dwim' within a source edit buffer if needed."
+ (interactive "*P")
+ (if (org-in-src-block-p)
+ (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
+ (call-interactively 'comment-dwim)))
-;;; Planning
+;;; Timestamps API
;; This section contains tools to operate on timestamp objects, as
;; returned by, e.g. `org-element-context'.
+(defun org-timestamp--to-internal-time (timestamp &optional end)
+ "Encode TIMESTAMP object into Emacs internal time.
+Use end of date range or time range when END is non-nil."
+ (apply #'encode-time
+ (cons 0
+ (mapcar
+ (lambda (prop) (or (org-element-property prop timestamp) 0))
+ (if end '(:minute-end :hour-end :day-end :month-end :year-end)
+ '(:minute-start :hour-start :day-start :month-start
+ :year-start))))))
+
(defun org-timestamp-has-time-p (timestamp)
"Non-nil when TIMESTAMP has a time specified."
(org-element-property :hour-start timestamp))
(defun org-timestamp-format (timestamp format &optional end utc)
- "Format a TIMESTAMP element into a string.
+ "Format a TIMESTAMP object into a string.
FORMAT is a format specifier to be passed to
`format-time-string'.
@@ -22661,27 +23740,18 @@ time-range, if possible.
When optional argument UTC is non-nil, time will be expressed as
Universal Time."
(format-time-string
- format
- (apply 'encode-time
- (cons 0
- (mapcar
- (lambda (prop) (or (org-element-property prop timestamp) 0))
- (if end '(:minute-end :hour-end :day-end :month-end :year-end)
- '(:minute-start :hour-start :day-start :month-start
- :year-start)))))
- utc))
+ format (org-timestamp--to-internal-time timestamp end) utc))
(defun org-timestamp-split-range (timestamp &optional end)
- "Extract a timestamp object from a date or time range.
+ "Extract a TIMESTAMP object from a date or time range.
-TIMESTAMP is a timestamp object. END, when non-nil, means extract
-the end of the range. Otherwise, extract its start.
+END, when non-nil, means extract the end of the range.
+Otherwise, extract its start.
-Return a new timestamp object sharing the same parent as
-TIMESTAMP."
+Return a new timestamp object."
(let ((type (org-element-property :type timestamp)))
(if (memq type '(active inactive diary)) timestamp
- (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp)))))
+ (let ((split-ts (org-element-copy timestamp)))
;; Set new type.
(org-element-put-property
split-ts :type (if (eq type 'active-range) 'active 'inactive))
@@ -22695,88 +23765,41 @@ TIMESTAMP."
(dolist (p-cell p-alist)
(org-element-put-property
split-ts
- (funcall (if end 'car 'cdr) p-cell)
+ (funcall (if end #'car #'cdr) p-cell)
(org-element-property
- (funcall (if end 'cdr 'car) p-cell) split-ts)))
+ (funcall (if end #'cdr #'car) p-cell) split-ts)))
;; Eventually refresh `:raw-value'.
(org-element-put-property split-ts :raw-value nil)
(org-element-put-property
split-ts :raw-value (org-element-interpret-data split-ts)))))))
(defun org-timestamp-translate (timestamp &optional boundary)
- "Apply `org-translate-time' on a TIMESTAMP object.
+ "Translate TIMESTAMP object to custom format.
+
+Format string is defined in `org-time-stamp-custom-formats',
+which see.
+
When optional argument BOUNDARY is non-nil, it is either the
symbol `start' or `end'. In this case, only translate the
starting or ending part of TIMESTAMP if it is a date or time
-range. Otherwise, translate both parts."
- (if (and (not boundary)
- (memq (org-element-property :type timestamp)
- '(active-range inactive-range)))
- (concat
- (org-translate-time
- (org-element-property :raw-value
- (org-timestamp-split-range timestamp)))
- "--"
- (org-translate-time
- (org-element-property :raw-value
- (org-timestamp-split-range timestamp t))))
- (org-translate-time
- (org-element-property
- :raw-value
- (if (not boundary) timestamp
- (org-timestamp-split-range timestamp (eq boundary 'end)))))))
+range. Otherwise, translate both parts.
+Return timestamp as-is if `org-display-custom-times' is nil or if
+it has a `diary' type."
+ (let ((type (org-element-property :type timestamp)))
+ (if (or (not org-display-custom-times) (eq type 'diary))
+ (org-element-interpret-data timestamp)
+ (let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car)
+ org-time-stamp-custom-formats)))
+ (if (and (not boundary) (memq type '(active-range inactive-range)))
+ (concat (org-timestamp-format timestamp fmt)
+ "--"
+ (org-timestamp-format timestamp fmt t))
+ (org-timestamp-format timestamp fmt (eq boundary 'end)))))))
-;;; Other stuff.
-(defun org-toggle-fixed-width-section (arg)
- "Toggle the fixed-width export.
-If there is no active region, the QUOTE keyword at the current headline is
-inserted or removed. When present, it causes the text between this headline
-and the next to be exported as fixed-width text, and unmodified.
-If there is an active region, this command adds or removes a colon as the
-first character of this line. If the first character of a line is a colon,
-this line is also exported in fixed-width font."
- (interactive "P")
- (let* ((cc 0)
- (regionp (org-region-active-p))
- (beg (if regionp (region-beginning) (point)))
- (end (if regionp (region-end)))
- (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
- (case-fold-search nil)
- (re "[ \t]*\\(:\\(?: \\|$\\)\\)")
- off)
- (if regionp
- (save-excursion
- (goto-char beg)
- (setq cc (current-column))
- (beginning-of-line 1)
- (setq off (looking-at re))
- (while (> nlines 0)
- (setq nlines (1- nlines))
- (beginning-of-line 1)
- (cond
- (arg
- (org-move-to-column cc t)
- (insert ": \n")
- (forward-line -1))
- ((and off (looking-at re))
- (replace-match "" t t nil 1))
- ((not off) (org-move-to-column cc t) (insert ": ")))
- (forward-line 1)))
- (save-excursion
- (org-back-to-heading)
- (cond
- ((looking-at (format org-heading-keyword-regexp-format
- org-quote-string))
- (goto-char (match-end 1))
- (looking-at (concat " +" org-quote-string))
- (replace-match "" t t)
- (when (eolp) (insert " ")))
- ((looking-at org-outline-regexp)
- (goto-char (match-end 0))
- (insert org-quote-string " ")))))))
+;;; Other stuff.
(defun org-reftex-citation ()
"Use reftex-citation to insert a citation into the buffer.
@@ -22799,11 +23822,11 @@ package ox-bibtex by Taru Karttunen."
(save-restriction
(widen)
(let ((case-fold-search t)
- (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)"))
+ (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)"))
(if (not (save-excursion
(or (re-search-forward re nil t)
(re-search-backward re nil t))))
- (error "No bibliography defined in file")
+ (user-error "No bibliography defined in file")
(setq bib (concat (match-string 1) ".bib")
rds (list (list 'bib bib)))))))
(call-interactively 'reftex-citation)))
@@ -22838,7 +23861,7 @@ beyond the end of the headline."
(when special
(cond
((and (looking-at org-complex-heading-regexp)
- (= (char-after (match-end 1)) ?\ ))
+ (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
@@ -22909,7 +23932,7 @@ the cursor is already beyond the end of the headline."
(goto-char (match-end 0))
(goto-char (match-beginning 1))))
(call-interactively move-fun))))
- ((org-element-property :hiddenp element)
+ ((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))
@@ -22927,18 +23950,43 @@ the cursor is already beyond the end of the headline."
This will call `backward-sentence' or `org-table-beginning-of-field',
depending on context."
(interactive "P")
- (cond
- ((org-at-table-p) (call-interactively 'org-table-beginning-of-field))
- (t (call-interactively 'backward-sentence))))
+ (let* ((element (org-element-at-point))
+ (contents-begin (org-element-property :contents-begin element))
+ (table (org-element-lineage element '(table) t)))
+ (if (and table
+ (> (point) contents-begin)
+ (<= (point) (org-element-property :contents-end table)))
+ (call-interactively #'org-table-beginning-of-field)
+ (save-restriction
+ (when (and contents-begin
+ (< (point-min) contents-begin)
+ (> (point) contents-begin))
+ (narrow-to-region contents-begin
+ (org-element-property :contents-end element)))
+ (call-interactively #'backward-sentence)))))
(defun org-forward-sentence (&optional arg)
"Go to end of sentence, or end of table field.
This will call `forward-sentence' or `org-table-end-of-field',
depending on context."
(interactive "P")
- (cond
- ((org-at-table-p) (call-interactively 'org-table-end-of-field))
- (t (call-interactively 'forward-sentence))))
+ (let* ((element (org-element-at-point))
+ (contents-end (org-element-property :contents-end element))
+ (table (org-element-lineage element '(table) t)))
+ (if (and table
+ (>= (point) (org-element-property :contents-begin table))
+ (< (point) contents-end))
+ (call-interactively #'org-table-end-of-field)
+ (save-restriction
+ (when (and contents-end
+ (> (point-max) contents-end)
+ ;; Skip blank lines between elements.
+ (< (org-element-property :end element)
+ (save-excursion (goto-char contents-end)
+ (skip-chars-forward " \r\t\n"))))
+ (narrow-to-region (org-element-property :contents-begin element)
+ contents-end))
+ (call-interactively #'forward-sentence)))))
(define-key org-mode-map "\M-a" 'org-backward-sentence)
(define-key org-mode-map "\M-e" 'org-forward-sentence)
@@ -22972,15 +24020,15 @@ 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.
-org-yank-folded-subtrees
+`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.
-org-yank-adjusted-subtrees
+`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.
+ 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 \
@@ -23103,11 +24151,27 @@ This version does not only check the character property, but also
;; 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.
+This function also checks ancestors of the current headline,
+unless optional argument NO-INHERITANCE is non-nil."
+ (cond
+ ((org-before-first-heading-p) nil)
+ ((let ((headline (nth 4 (org-heading-components))))
+ (and headline
+ (let ((case-fold-search nil))
+ (org-string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
+ headline)))))
+ (no-inheritance nil)
+ (t
+ (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
+
(defun org-at-comment-p nil
- "Is cursor in a line starting with a # character?"
+ "Is cursor in a commented line?"
(save-excursion
- (beginning-of-line)
- (looking-at "^#")))
+ (save-match-data
+ (beginning-of-line)
+ (looking-at "^[ \t]*# "))))
(defun org-at-drawer-p nil
"Is cursor at a drawer keyword?"
@@ -23158,14 +24222,11 @@ headline found, or nil if no higher level is found.
Also, this function will be a lot faster than `outline-up-heading',
because it relies on stars being the outline starters. This can really
make a significant difference in outlines with very many siblings."
- (let (start-level re)
- (org-back-to-heading t)
- (setq start-level (funcall outline-level))
- (if (equal start-level 1)
- nil
- (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} "))
- (if (re-search-backward re nil t)
- (funcall outline-level)))))
+ (when (ignore-errors (org-back-to-heading t))
+ (let ((level-up (1- (funcall outline-level))))
+ (and (> level-up 0)
+ (re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t)
+ (funcall outline-level)))))
(defun org-first-sibling-p ()
"Is this heading the first child of its parents?"
@@ -23190,7 +24251,7 @@ move point."
(pos (point))
(re org-outline-regexp-bol)
level l)
- (when (condition-case nil (org-back-to-heading t) (error nil))
+ (when (ignore-errors (org-back-to-heading t))
(setq level (funcall outline-level))
(catch 'exit
(or previous (forward-char 1))
@@ -23214,7 +24275,7 @@ move point."
Return t when a child was found. Otherwise don't move point and
return nil."
(let (level (pos (point)) (re org-outline-regexp-bol))
- (when (condition-case nil (org-back-to-heading t) (error nil))
+ (when (ignore-errors (org-back-to-heading t))
(setq level (outline-level))
(forward-char 1)
(if (and (re-search-forward re nil t) (> (outline-level) level))
@@ -23303,24 +24364,28 @@ If there is no such heading, return nil."
(forward-char -1))))))
(point))
-(defun org-end-of-meta-data-and-drawers ()
- "Jump to the first text after meta data and drawers in the current entry.
-This will move over empty lines, lines with planning time stamps,
-clocking lines, and drawers."
+(defun org-end-of-meta-data (&optional full)
+ "Skip planning line and properties drawer in current entry.
+When optional argument FULL is non-nil, also skip empty lines,
+clocking lines and regular drawers at the beginning of the
+entry."
(org-back-to-heading t)
- (let ((end (save-excursion (outline-next-heading) (point)))
- (re (concat "\\(" org-drawer-regexp "\\)"
- "\\|" "[ \t]*" org-keyword-time-regexp)))
- (forward-line 1)
- (while (re-search-forward re end t)
- (if (not (match-end 1))
- ;; empty or planning line
- (forward-line 1)
- ;; a drawer, find the end
- (re-search-forward "^[ \t]*:END:" end 'move)
- (forward-line 1)))
- (and (re-search-forward "[^\n]" nil t) (backward-char 1))
- (point)))
+ (forward-line)
+ (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (forward-line))
+ (when (and full (not (org-at-heading-p)))
+ (catch 'exit
+ (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)
+ (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
+ (forward-line)
+ (throw 'exit t)))
+ ((org-looking-at-p re) (forward-line))
+ (t (throw 'exit t))))))))
(defun org-forward-heading-same-level (arg &optional invisible-ok)
"Move forward to the ARG'th subheading at same level as this one.
@@ -23361,20 +24426,64 @@ Stop at the first and last subheadings of a superior heading."
(interactive "p")
(org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
+(defun org-next-visible-heading (arg)
+ "Move to the next visible heading.
+
+This function wraps `outline-next-visible-heading' with
+`org-with-limited-levels' in order to skip over inline tasks and
+respect customization of `org-odd-levels-only'."
+ (interactive "p")
+ (org-with-limited-levels
+ (outline-next-visible-heading arg)))
+
+(defun org-previous-visible-heading (arg)
+ "Move to the next visible heading.
+
+This function wraps `outline-previous-visible-heading' with
+`org-with-limited-levels' in order to skip over inline tasks and
+respect customization of `org-odd-levels-only'."
+ (interactive "p")
+ (org-with-limited-levels
+ (outline-previous-visible-heading arg)))
+
(defun org-next-block (arg &optional backward block-regexp)
"Jump to the next block.
-With a prefix argument ARG, jump forward ARG many source blocks.
+
+With a prefix argument ARG, jump forward ARG many blocks.
+
When BACKWARD is non-nil, jump to the previous block.
-When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
+
+When BLOCK-REGEXP is non-nil, use this regexp to find blocks.
+Match data is set according to this regexp when the function
+returns.
+
+Return point at beginning of the opening line of found block.
+Throw an error if no block is found."
(interactive "p")
- (let ((re (or block-regexp org-block-regexp))
- (re-search-fn (or (and backward 're-search-backward)
- 're-search-forward)))
- (if (looking-at re) (forward-char 1))
- (condition-case nil
- (funcall re-search-fn re nil nil arg)
- (error (error "No %s code blocks" (if backward "previous" "further" ))))
- (goto-char (match-beginning 0)) (org-show-context)))
+ (let ((re (or block-regexp "^[ \t]*#\\+BEGIN"))
+ (case-fold-search t)
+ (search-fn (if backward #'re-search-backward #'re-search-forward))
+ (count (or arg 1))
+ (origin (point))
+ last-element)
+ (if backward (beginning-of-line) (end-of-line))
+ (while (and (> count 0) (funcall search-fn re nil t))
+ (let ((element (save-excursion
+ (goto-char (match-beginning 0))
+ (save-match-data (org-element-at-point)))))
+ (when (and (memq (org-element-type element)
+ '(center-block comment-block dynamic-block
+ example-block export-block quote-block
+ special-block src-block verse-block))
+ (<= (match-beginning 0)
+ (org-element-property :post-affiliated element)))
+ (setq last-element element)
+ (decf count))))
+ (if (= count 0)
+ (prog1 (goto-char (org-element-property :post-affiliated last-element))
+ (save-match-data (org-show-context)))
+ (goto-char origin)
+ (user-error "No %s code blocks" (if backward "previous" "further")))))
(defun org-previous-block (arg &optional block-regexp)
"Jump to the previous block.
@@ -23413,7 +24522,7 @@ item, etc. It also provides some special moves for convenience:
(skip-chars-forward " \r\t\n")
(or (eobp) (beginning-of-line)))
;; On affiliated keywords, move to element's beginning.
- ((and post-affiliated (< (point) post-affiliated))
+ ((< (point) post-affiliated)
(goto-char post-affiliated))
;; At a table row, move to the end of the table. Similarly,
;; at a node property, move to the end of the property
@@ -23492,7 +24601,7 @@ convenience:
((= (point) begin)
(backward-char)
(org-backward-paragraph))
- ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin))
+ ((<= (point) post-affiliated) (goto-char begin))
((memq type '(node-property table-row))
(goto-char (org-element-property
:post-affiliated (org-element-property :parent element))))
@@ -23566,18 +24675,21 @@ Move to the previous element at the same level, when possible."
(progn (goto-char origin)
(user-error "Cannot move further up"))))))
(t
- (let* ((trail (org-element-at-point 'keep-trail))
- (elem (car trail))
- (prev-elem (nth 1 trail))
+ (let* ((elem (org-element-at-point))
(beg (org-element-property :begin elem)))
(cond
;; Move to beginning of current element if point isn't
;; there already.
((null beg) (message "No element at point"))
((/= (point) beg) (goto-char beg))
- (prev-elem (goto-char (org-element-property :begin prev-elem)))
- ((org-before-first-heading-p) (goto-char (point-min)))
- (t (org-back-to-heading)))))))
+ (t (goto-char beg)
+ (skip-chars-backward " \r\t\n")
+ (unless (bobp)
+ (let ((prev (org-element-at-point)))
+ (goto-char (org-element-property :begin prev))
+ (while (and (setq prev (org-element-property :parent prev))
+ (<= (org-element-property :end prev) beg))
+ (goto-char (org-element-property :begin prev)))))))))))
(defun org-up-element ()
"Move to upper element."
@@ -23602,7 +24714,7 @@ Move to the previous element at the same level, when possible."
(forward-char))
((memq (org-element-type element) org-element-greater-elements)
;; If contents are hidden, first disclose them.
- (when (org-element-property :hiddenp element) (org-cycle))
+ (when (outline-invisible-p (line-end-position)) (org-cycle))
(goto-char (or (org-element-property :contents-begin element)
(user-error "No content for this element"))))
(t (user-error "No inner element")))))
@@ -23611,9 +24723,19 @@ Move to the previous element at the same level, when possible."
"Move backward element at point."
(interactive)
(if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
- (let* ((trail (org-element-at-point 'keep-trail))
- (elem (car trail))
- (prev-elem (nth 1 trail)))
+ (let* ((elem (org-element-at-point))
+ (prev-elem
+ (save-excursion
+ (goto-char (org-element-property :begin elem))
+ (skip-chars-backward " \r\t\n")
+ (unless (bobp)
+ (let* ((beg (org-element-property :begin elem))
+ (prev (org-element-at-point))
+ (up prev))
+ (while (and (setq up (org-element-property :parent up))
+ (<= (org-element-property :end up) beg))
+ (setq prev up))
+ prev)))))
;; Error out if no previous element or previous element is
;; a parent of the current one.
(if (or (not prev-elem) (org-element-nested-p elem prev-elem))
@@ -23762,27 +24884,26 @@ modified."
Show the heading too, if it is currently invisible."
(interactive)
(save-excursion
- (condition-case nil
- (progn
- (org-back-to-heading t)
- (outline-flag-region
- (max (point-min) (1- (point)))
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
- (match-beginning 1)
- (point-max)))
- nil)
- (org-cycle-hide-drawers 'children))
- (error nil))))
+ (ignore-errors
+ (org-back-to-heading t)
+ (outline-flag-region
+ (max (point-min) (1- (point)))
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
+ (match-beginning 1)
+ (point-max)))
+ nil)
+ (org-cycle-hide-drawers 'children))))
(defun org-make-options-regexp (kwds &optional extra)
- "Make a regular expression for keyword lines."
- (concat
- "^#\\+\\("
- (mapconcat 'regexp-quote kwds "\\|")
- (if extra (concat "\\|" extra))
- "\\):[ \t]*\\(.*\\)"))
+ "Make a regular expression for keyword lines.
+KWDS is a list of keywords, as strings. Optional argument EXTRA,
+when non-nil, is a regexp matching keywords names."
+ (concat "^[ \t]*#\\+\\("
+ (regexp-opt kwds)
+ (and extra (concat (and kwds "\\|") extra))
+ "\\):[ \t]*\\(.*\\)"))
;; Make isearch reveal the necessary context
(defun org-isearch-end ()
@@ -23938,34 +25059,97 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
;;; Fixes and Hacks for problems with other packages
-;; Make flyspell not check words in links, to not mess up our keymap
-(defvar org-element-affiliated-keywords) ; From org-element.el
-(defvar org-element-block-name-alist) ; From org-element.el
+(defun org--flyspell-object-check-p (element)
+ "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))
+ (org-element-context element))))
+ (case (org-element-type object)
+ ;; Prevent checks in links due to keybinding conflict with
+ ;; Flyspell.
+ ((code entity export-snippet inline-babel-call
+ inline-src-block line-break latex-fragment link macro
+ statistics-cookie target timestamp verbatim)
+ nil)
+ (footnote-reference
+ ;; Only in inline footnotes, within the definition.
+ (and (eq (org-element-property :type object) 'inline)
+ (< (save-excursion
+ (goto-char (org-element-property :begin object))
+ (search-forward ":" nil t 2))
+ (point))))
+ (otherwise t))))
+
(defun org-mode-flyspell-verify ()
- "Don't let flyspell put overlays at active buttons, or on
- {todo,all-time,additional-option-like}-keywords."
- (require 'org-element) ; For `org-element-affiliated-keywords'
- (let ((pos (max (1- (point)) (point-min)))
- (word (thing-at-point 'word)))
- (and (not (get-text-property pos 'keymap))
- (not (get-text-property pos 'org-no-flyspell))
- (not (member word org-todo-keywords-1))
- (not (member word org-all-time-keywords))
- (not (member word org-options-keywords))
- (not (member word (mapcar 'car org-startup-options)))
- (not (member-ignore-case word org-element-affiliated-keywords))
- (not (member-ignore-case word (org-get-export-keywords)))
- (not (member-ignore-case
- word (mapcar 'car org-element-block-name-alist)))
- (not (member-ignore-case word '("BEGIN" "END" "ATTR")))
- (not (org-in-src-block-p)))))
+ "Function used for `flyspell-generic-check-word-predicate'."
+ (if (org-at-heading-p)
+ ;; At a headline or an inlinetask, check title only. This is
+ ;; 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)))
+ (match-beginning 4)
+ (>= (point) (match-beginning 4))
+ (or (not (match-beginning 5))
+ (< (point) (match-beginning 5))))
+ (let* ((element (org-element-at-point))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (cond
+ ;; Ignore checks in all affiliated keywords but captions.
+ ((< (point) post-affiliated)
+ (and (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
+ (> (point) (match-end 0))
+ (org--flyspell-object-check-p element)))
+ ;; Ignore checks in LOGBOOK (or equivalent) drawer.
+ ((let ((log (org-log-into-drawer)))
+ (and log
+ (let ((drawer (org-element-lineage element '(drawer))))
+ (and drawer
+ (eq (compare-strings
+ log nil nil
+ (org-element-property :drawer-name drawer) nil nil t)
+ t)))))
+ nil)
+ (t
+ (case (org-element-type element)
+ ((comment quote-section) t)
+ (comment-block
+ ;; Allow checks between block markers, not on them.
+ (and (> (line-beginning-position) post-affiliated)
+ (save-excursion
+ (end-of-line)
+ (skip-chars-forward " \r\t\n")
+ (< (point) (org-element-property :end element)))))
+ ;; Arbitrary list of keywords where checks are meaningful.
+ ;; Make sure point is on the value part of the element.
+ (keyword
+ (and (member (org-element-property :key element)
+ '("DESCRIPTION" "TITLE"))
+ (save-excursion
+ (search-backward ":" (line-beginning-position) t))))
+ ;; Check is globally allowed in paragraphs verse blocks and
+ ;; table rows (after affiliated keywords) but some objects
+ ;; must not be affected.
+ ((paragraph table-row verse-block)
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (and cbeg (>= (point) cbeg) (< (point) cend)
+ (org--flyspell-object-check-p element))))))))))
+(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
(and (org-bound-and-true-p flyspell-mode)
(fboundp 'flyspell-delete-region-overlays)
- (flyspell-delete-region-overlays beg end))
- (add-text-properties beg end '(org-no-flyspell t)))
+ (flyspell-delete-region-overlays beg end)))
+
+(defvar flyspell-delayed-commands)
+(eval-after-load "flyspell"
+ '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
;; Make `bookmark-jump' shows the jump location if it was hidden.
(eval-after-load "bookmark"
@@ -23998,6 +25182,27 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(outline-invisible-p)))
(org-show-context 'bookmark-jump)))
+(defun org-mark-jump-unhide ()
+ "Make the point visible with `org-show-context' after jumping to the mark."
+ (when (and (derived-mode-p 'org-mode)
+ (outline-invisible-p))
+ (org-show-context 'mark-goto)))
+
+(eval-after-load "simple"
+ '(defadvice pop-to-mark-command (after org-make-visible activate)
+ "Make the point visible with `org-show-context'."
+ (org-mark-jump-unhide)))
+
+(eval-after-load "simple"
+ '(defadvice exchange-point-and-mark (after org-make-visible activate)
+ "Make the point visible with `org-show-context'."
+ (org-mark-jump-unhide)))
+
+(eval-after-load "simple"
+ '(defadvice pop-global-mark (after org-make-visible activate)
+ "Make the point visible with `org-show-context'."
+ (org-mark-jump-unhide)))
+
;; Make session.el ignore our circular variable
(defvar session-globals-exclude)
(eval-after-load "session"
diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el
index cd2a9af..5cc70bd 100644
--- a/lisp/ox-ascii.el
+++ b/lisp/ox-ascii.el
@@ -1,6 +1,6 @@
;;; ox-ascii.el --- ASCII Back-End for Org Export Engine
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -49,8 +49,6 @@
(center-block . org-ascii-center-block)
(clock . org-ascii-clock)
(code . org-ascii-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-ascii-drawer)
(dynamic-block . org-ascii-dynamic-block)
(entity . org-ascii-entity)
@@ -71,12 +69,13 @@
(latex-fragment . org-ascii-latex-fragment)
(line-break . org-ascii-line-break)
(link . org-ascii-link)
+ (node-property . org-ascii-node-property)
(paragraph . org-ascii-paragraph)
(plain-list . org-ascii-plain-list)
(plain-text . org-ascii-plain-text)
(planning . org-ascii-planning)
+ (property-drawer . org-ascii-property-drawer)
(quote-block . org-ascii-quote-block)
- (quote-section . org-ascii-quote-section)
(radio-target . org-ascii-radio-target)
(section . org-ascii-section)
(special-block . org-ascii-special-block)
@@ -119,7 +118,30 @@
(:filter-parse-tree org-ascii-filter-paragraph-spacing
org-ascii-filter-comment-spacing)
(:filter-section . org-ascii-filter-headline-blank-lines))
- :options-alist '((:ascii-charset nil nil org-ascii-charset)))
+ :options-alist
+ '((:subtitle "SUBTITLE" nil nil parse)
+ (:ascii-bullets nil nil org-ascii-bullets)
+ (:ascii-caption-above nil nil org-ascii-caption-above)
+ (:ascii-charset nil nil org-ascii-charset)
+ (:ascii-global-margin nil nil org-ascii-global-margin)
+ (:ascii-format-drawer-function nil nil org-ascii-format-drawer-function)
+ (:ascii-format-inlinetask-function
+ nil nil org-ascii-format-inlinetask-function)
+ (:ascii-headline-spacing nil nil org-ascii-headline-spacing)
+ (:ascii-indented-line-width nil nil org-ascii-indented-line-width)
+ (:ascii-inlinetask-width nil nil org-ascii-inlinetask-width)
+ (:ascii-inner-margin nil nil org-ascii-inner-margin)
+ (:ascii-links-to-notes nil nil org-ascii-links-to-notes)
+ (:ascii-list-margin nil nil org-ascii-list-margin)
+ (:ascii-paragraph-spacing nil nil org-ascii-paragraph-spacing)
+ (:ascii-quote-margin nil nil org-ascii-quote-margin)
+ (:ascii-table-keep-all-vertical-lines
+ nil nil org-ascii-table-keep-all-vertical-lines)
+ (:ascii-table-use-ascii-art nil nil org-ascii-table-use-ascii-art)
+ (:ascii-table-widen-columns nil nil org-ascii-table-widen-columns)
+ (:ascii-text-width nil nil org-ascii-text-width)
+ (:ascii-underline nil nil org-ascii-underline)
+ (:ascii-verbatim-format nil nil org-ascii-verbatim-format)))
@@ -162,6 +184,15 @@ This margin is applied on both sides of the text."
:package-version '(Org . "8.0")
:type 'integer)
+(defcustom org-ascii-list-margin 0
+ "Width of margin used for plain lists, in characters.
+This margin applies to top level list only, not to its
+sub-lists."
+ :group 'org-export-ascii
+ :version "25.1"
+ :package-version '(Org . "8.3")
+ :type 'integer)
+
(defcustom org-ascii-inlinetask-width 30
"Width of inline tasks, in number of characters.
This number ignores any margin."
@@ -185,7 +216,7 @@ original Org buffer at the same place."
:package-version '(Org . "8.0")
:type '(choice
(const :tag "Replicate original spacing" nil)
- (cons :tag "Set an uniform spacing"
+ (cons :tag "Set a uniform spacing"
(integer :tag "Number of blank lines before contents")
(integer :tag "Number of blank lines after contents"))))
@@ -384,14 +415,18 @@ nil to ignore the inline task."
;; Internal functions fall into three categories.
-;; The first one is about text formatting. The core function is
-;; `org-ascii--current-text-width', which determines the current
-;; text width allowed to a given element. In other words, it helps
-;; keeping each line width within maximum text width defined in
-;; `org-ascii-text-width'. Once this information is known,
-;; `org-ascii--fill-string', `org-ascii--justify-string',
-;; `org-ascii--box-string' and `org-ascii--indent-string' can
-;; operate on a given output string.
+;; The first one is about text formatting. The core functions are
+;; `org-ascii--current-text-width' and
+;; `org-ascii--current-justification', which determine, respectively,
+;; the current text width allowed to a given element and its expected
+;; justification. Once this information is known,
+;; `org-ascii--fill-string', `org-ascii--justify-lines',
+;; `org-ascii--justify-element' `org-ascii--box-string' and
+;; `org-ascii--indent-string' can operate on a given output string.
+;; In particular, justification happens at the regular (i.e.,
+;; non-greater) element level, which means that when the exporting
+;; process reaches a container (e.g., a center block) content are
+;; already justified.
;; The second category contains functions handling elements listings,
;; triggered by "#+TOC:" keyword. As such, `org-ascii--build-toc'
@@ -420,7 +455,8 @@ a communication channel.
Optional argument JUSTIFY can specify any type of justification
among `left', `center', `right' or `full'. A nil value is
equivalent to `left'. For a justification that doesn't also fill
-string, see `org-ascii--justify-string'.
+string, see `org-ascii--justify-lines' and
+`org-ascii--justify-block'.
Return nil if S isn't a string."
(when (stringp s)
@@ -435,8 +471,8 @@ Return nil if S isn't a string."
(fill-region (point-min) (point-max) justify))
(buffer-string)))))
-(defun org-ascii--justify-string (s text-width how)
- "Justify string S.
+(defun org-ascii--justify-lines (s text-width how)
+ "Justify all lines in string S.
TEXT-WIDTH is an integer specifying maximum length of a line.
HOW determines the type of justification: it can be `left',
`right', `full' or `center'."
@@ -452,6 +488,48 @@ HOW determines the type of justification: it can be `left',
(forward-line)))
(buffer-string)))
+(defun org-ascii--justify-element (contents element info)
+ "Justify CONTENTS of ELEMENT.
+INFO is a plist used as a communication channel. Justification
+is done according to the type of element. More accurately,
+paragraphs are filled and other elements are justified as blocks,
+that is according to the widest non blank line in CONTENTS."
+ (if (not (org-string-nw-p contents)) contents
+ (let ((text-width (org-ascii--current-text-width element info))
+ (how (org-ascii--current-justification element)))
+ (cond
+ ((eq (org-element-type element) 'paragraph)
+ ;; Paragraphs are treated specially as they need to be filled.
+ (org-ascii--fill-string contents text-width info how))
+ ((eq how 'left) contents)
+ (t (with-temp-buffer
+ (insert contents)
+ (goto-char (point-min))
+ (catch 'exit
+ (let ((max-width 0))
+ ;; Compute maximum width. Bail out if it is greater
+ ;; than page width, since no justification is
+ ;; possible.
+ (save-excursion
+ (while (not (eobp))
+ (unless (org-looking-at-p "[ \t]*$")
+ (end-of-line)
+ (let ((column (current-column)))
+ (cond
+ ((>= column text-width) (throw 'exit contents))
+ ((> column max-width) (setq max-width column)))))
+ (forward-line)))
+ ;; Justify every line according to TEXT-WIDTH and
+ ;; MAX-WIDTH.
+ (let ((offset (/ (- text-width max-width)
+ (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))
+ (forward-line)))))
+ (buffer-string))))))))
+
(defun org-ascii--indent-string (s width)
"Indent string S by WIDTH white spaces.
Empty lines are not indented."
@@ -474,24 +552,25 @@ INFO is a plist used as a communication channel."
INFO is a plist used as a communication channel."
(case (org-element-type element)
;; Elements with an absolute width: `headline' and `inlinetask'.
- (inlinetask org-ascii-inlinetask-width)
+ (inlinetask (plist-get info :ascii-inlinetask-width))
(headline
- (- org-ascii-text-width
+ (- (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) org-ascii-global-margin))))
+ (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 (cons element (org-export-get-genealogy element)))
+ (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))
- org-ascii-inlinetask-width
+ (plist-get info :ascii-inlinetask-width)
;; No inlinetask: Remove global margin from text width.
- (- org-ascii-text-width
- org-ascii-global-margin
+ (- (plist-get info :ascii-text-width)
+ (plist-get info :ascii-global-margin)
(let ((parent (org-export-get-parent-headline element)))
;; Inner margin doesn't apply to text before first
;; headline.
@@ -502,41 +581,66 @@ INFO is a plist used as a communication channel."
;; low level headlines, since they've got their
;; own indentation mechanism.
(if low-level-rank (* low-level-rank 2)
- org-ascii-inner-margin))))))))
+ (plist-get info :ascii-inner-margin)))))))))
(- total-width
- ;; Each `quote-block', `quote-section' and `verse-block' above
- ;; narrows text width by twice the standard margin size.
+ ;; 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 quote-section verse-block))
+ '(quote-block verse-block))
count parent)
- 2 org-ascii-quote-margin)
+ 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))))
+ (plist-get info :ascii-list-margin))
;; Text width within a plain-list is restricted by
;; indentation of current item. If that's the case,
;; compute it with the help of `:structure' property from
;; parent item, if any.
- (let ((parent-item
+ (let ((item
(if (eq (org-element-type element) 'item) element
(loop for parent in genealogy
when (eq (org-element-type parent) 'item)
return parent))))
- (if (not parent-item) 0
+ (if (not item) 0
;; Compute indentation offset of the current item,
;; that is the sum of the difference between its
;; indentation and the indentation of the top item in
;; the list and current item bullet's length. Also
;; remove checkbox length, and tag length (for
;; description lists) or bullet length.
- (let ((struct (org-element-property :structure parent-item))
- (beg-item (org-element-property :begin parent-item)))
+ (let ((struct (org-element-property :structure item))
+ (beg-item (org-element-property :begin item)))
(+ (- (org-list-get-ind beg-item struct)
(org-list-get-ind
(org-list-get-top-point struct) struct))
- (string-width (or (org-ascii--checkbox parent-item info)
+ (string-width (or (org-ascii--checkbox item info)
""))
(string-width
- (or (org-list-get-tag beg-item struct)
- (org-list-get-bullet beg-item struct)))))))))))))
+ (let ((tag (org-element-property :tag item)))
+ (if tag (org-export-data tag info)
+ (org-element-property :bullet item))))))))))))))
+
+(defun org-ascii--current-justification (element)
+ "Return expected justification for ELEMENT's contents.
+Return value is a symbol among `left', `center', `right' and
+`full'."
+ (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
+ (let ((name (org-element-property :type element)))
+ (cond ((string= name "JUSTIFYRIGHT") (setq justification 'right))
+ ((string= name "JUSTIFYLEFT") (setq justification 'left)))))))
+ (or justification 'left)))
(defun org-ascii--build-title
(element info text-width &optional underline notags toc)
@@ -601,7 +705,7 @@ possible. It doesn't apply to `inlinetask' elements."
(let ((under-char
(nth (1- (org-export-get-relative-level element info))
(cdr (assq (plist-get info :ascii-charset)
- org-ascii-underline)))))
+ (plist-get info :ascii-underline))))))
(and under-char
(concat "\n"
(make-string (/ (string-width first-part)
@@ -640,7 +744,7 @@ caption keyword."
(org-export-data caption info))
(org-ascii--current-text-width element info) info)))))
-(defun org-ascii--build-toc (info &optional n keyword)
+(defun org-ascii--build-toc (info &optional n keyword local)
"Return a table of contents.
INFO is a plist used as a communication channel.
@@ -649,28 +753,34 @@ Optional argument N, when non-nil, is an integer specifying the
depth of the table.
Optional argument KEYWORD specifies the TOC keyword, if any, from
-which the table of contents generation has been initiated."
- (let ((title (org-ascii--translate "Table of Contents" info)))
- (concat
- title "\n"
- (make-string (string-width title)
- (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
- "\n\n"
- (let ((text-width
- (if keyword (org-ascii--current-text-width keyword info)
- (- org-ascii-text-width org-ascii-global-margin))))
- (mapconcat
- (lambda (headline)
- (let* ((level (org-export-get-relative-level headline info))
- (indent (* (1- level) 3)))
- (concat
- (unless (zerop indent) (concat (make-string (1- indent) ?.) " "))
- (org-ascii--build-title
- headline info (- text-width indent) nil
- (or (not (plist-get info :with-tags))
- (eq (plist-get info :with-tags) 'not-in-toc))
- 'toc))))
- (org-export-collect-headlines info n) "\n")))))
+which the table of contents generation has been initiated.
+
+When optional argument LOCAL is non-nil, build a table of
+contents according to the current headline."
+ (concat
+ (unless local
+ (let ((title (org-ascii--translate "Table of Contents" info)))
+ (concat title "\n"
+ (make-string
+ (string-width title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
+ "\n\n")))
+ (let ((text-width
+ (if keyword (org-ascii--current-text-width keyword info)
+ (- (plist-get info :ascii-text-width)
+ (plist-get info :ascii-global-margin)))))
+ (mapconcat
+ (lambda (headline)
+ (let* ((level (org-export-get-relative-level headline info))
+ (indent (* (1- level) 3)))
+ (concat
+ (unless (zerop indent) (concat (make-string (1- indent) ?.) " "))
+ (org-ascii--build-title
+ headline info (- text-width indent) nil
+ (or (not (plist-get info :with-tags))
+ (eq (plist-get info :with-tags) 'not-in-toc))
+ 'toc))))
+ (org-export-collect-headlines info n (and local keyword)) "\n"))))
(defun org-ascii--list-listings (keyword info)
"Return a list of listings.
@@ -685,7 +795,8 @@ generation. INFO is a plist used as a communication channel."
"\n\n"
(let ((text-width
(if keyword (org-ascii--current-text-width keyword info)
- (- org-ascii-text-width org-ascii-global-margin)))
+ (- (plist-get info :ascii-text-width)
+ (plist-get info :ascii-global-margin))))
;; Use a counter instead of retrieving ordinal of each
;; src-block.
(count 0))
@@ -724,7 +835,8 @@ generation. INFO is a plist used as a communication channel."
"\n\n"
(let ((text-width
(if keyword (org-ascii--current-text-width keyword info)
- (- org-ascii-text-width org-ascii-global-margin)))
+ (- (plist-get info :ascii-text-width)
+ (plist-get info :ascii-global-margin))))
;; Use a counter instead of retrieving ordinal of each
;; src-block.
(count 0))
@@ -812,13 +924,22 @@ channel."
(if (not dest) (org-ascii--translate "Unknown reference" info)
(format
(org-ascii--translate "See section %s" info)
- (mapconcat 'number-to-string
- (org-export-get-headline-number dest info) "."))))
+ (if (org-export-numbered-headline-p dest info)
+ (mapconcat #'number-to-string
+ (org-export-get-headline-number dest info) ".")
+ (org-export-data (org-element-property :title dest) info)))))
width info) "\n\n")))
;; Do not add a link that cannot be resolved and doesn't have
;; any description: destination is already visible in the
;; paragraph.
((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)
(t
(concat
(org-ascii--fill-string
@@ -843,11 +964,15 @@ INFO is a plist used as a communication channel."
(defun org-ascii-template--document-title (info)
"Return document title, as a string.
INFO is a plist used as a communication channel."
- (let* ((text-width org-ascii-text-width)
+ (let* ((text-width (plist-get info :ascii-text-width))
;; Links in the title will not be resolved later, so we make
;; sure their path is located right after them.
- (org-ascii-links-to-notes nil)
- (title (org-export-data (plist-get info :title) info))
+ (info (org-combine-plists info '(:ascii-links-to-notes nil)))
+ (with-title (plist-get info :with-title))
+ (title (org-export-data
+ (when with-title (plist-get info :title)) info))
+ (subtitle (org-export-data
+ (when with-title (plist-get info :subtitle)) info))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
@@ -878,7 +1003,7 @@ INFO is a plist used as a communication channel."
date "\n\n\n"))
((org-string-nw-p date)
(concat
- (org-ascii--justify-string date text-width 'right)
+ (org-ascii--justify-lines date text-width 'right)
"\n\n\n"))
((and (org-string-nw-p author) (org-string-nw-p email))
(concat author "\n" email "\n\n\n"))
@@ -890,8 +1015,14 @@ INFO is a plist used as a communication channel."
(let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
;; Format TITLE. It may be filled if it is too wide,
;; that is wider than the two thirds of the total width.
- (title-len (min (length title) (/ (* 2 text-width) 3)))
+ (title-len (min (apply #'max
+ (mapcar #'length
+ (org-split-string
+ (concat title "\n" subtitle) "\n")))
+ (/ (* 2 text-width) 3)))
(formatted-title (org-ascii--fill-string title title-len info))
+ (formatted-subtitle (when (org-string-nw-p subtitle)
+ (org-ascii--fill-string subtitle title-len info)))
(line
(make-string
(min (+ (max title-len
@@ -899,17 +1030,16 @@ INFO is a plist used as a communication channel."
(string-width (or email "")))
2)
text-width) (if utf8p ?━ ?_))))
- (org-ascii--justify-string
+ (org-ascii--justify-lines
(concat line "\n"
(unless utf8p "\n")
(upcase formatted-title)
+ (and formatted-subtitle (concat "\n" formatted-subtitle))
(cond
((and (org-string-nw-p author) (org-string-nw-p email))
- (concat (if utf8p "\n\n\n" "\n\n") author "\n" email))
- ((org-string-nw-p author)
- (concat (if utf8p "\n\n\n" "\n\n") author))
- ((org-string-nw-p email)
- (concat (if utf8p "\n\n\n" "\n\n") email)))
+ (concat "\n\n" author "\n" email))
+ ((org-string-nw-p author) (concat "\n\n" author))
+ ((org-string-nw-p email) (concat "\n\n" email)))
"\n" line
(when (org-string-nw-p date) (concat "\n\n\n" date))
"\n\n\n") text-width 'center)))))
@@ -919,81 +1049,82 @@ INFO is a plist used as a communication channel."
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(org-element-normalize-string
- (org-ascii--indent-string
- (concat
- ;; 1. Document's body.
- contents
- ;; 2. Footnote definitions.
- (let ((definitions (org-export-collect-footnote-definitions
- (plist-get info :parse-tree) info))
- ;; Insert full links right inside the footnote definition
- ;; as they have no chance to be inserted later.
- (org-ascii-links-to-notes nil))
- (when definitions
- (concat
- "\n\n\n"
- (let ((title (org-ascii--translate "Footnotes" info)))
- (concat
- title "\n"
- (make-string
- (string-width title)
- (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))))
- "\n\n"
- (let ((text-width (- org-ascii-text-width org-ascii-global-margin)))
- (mapconcat
- (lambda (ref)
- (let ((id (format "[%s] " (car ref))))
- ;; Distinguish between inline definitions and
- ;; full-fledged definitions.
- (org-trim
- (let ((def (nth 2 ref)))
- (if (eq (org-element-type def) 'org-data)
- ;; Full-fledged definition: footnote ID is
- ;; inserted inside the first parsed paragraph
- ;; (FIRST), if any, to be sure filling will
- ;; take it into consideration.
- (let ((first (car (org-element-contents def))))
- (if (not (eq (org-element-type first) 'paragraph))
- (concat id "\n" (org-export-data def info))
- (push id (nthcdr 2 first))
- (org-export-data def info)))
- ;; Fill paragraph once footnote ID is inserted
- ;; in order to have a correct length for first
- ;; line.
- (org-ascii--fill-string
- (concat id (org-export-data def info))
- text-width info))))))
- definitions "\n\n"))))))
- org-ascii-global-margin)))
+ (let ((global-margin (plist-get info :ascii-global-margin)))
+ (org-ascii--indent-string
+ (concat
+ ;; 1. Document's body.
+ contents
+ ;; 2. Footnote definitions.
+ (let ((definitions (org-export-collect-footnote-definitions info))
+ ;; Insert full links right inside the footnote definition
+ ;; as they have no chance to be inserted later.
+ (info (org-combine-plists info '(:ascii-links-to-notes nil))))
+ (when definitions
+ (concat
+ "\n\n\n"
+ (let ((title (org-ascii--translate "Footnotes" info)))
+ (concat
+ title "\n"
+ (make-string
+ (string-width title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))))
+ "\n\n"
+ (let ((text-width (- (plist-get info :ascii-text-width)
+ global-margin)))
+ (mapconcat
+ (lambda (ref)
+ (let ((id (format "[%s] " (car ref))))
+ ;; Distinguish between inline definitions and
+ ;; full-fledged definitions.
+ (org-trim
+ (let ((def (nth 2 ref)))
+ (if (eq (org-element-type def) 'org-data)
+ ;; Full-fledged definition: footnote ID is
+ ;; inserted inside the first parsed
+ ;; paragraph (FIRST), if any, to be sure
+ ;; filling will take it into consideration.
+ (let ((first (car (org-element-contents def))))
+ (if (not (eq (org-element-type first) 'paragraph))
+ (concat id "\n" (org-export-data def info))
+ (push id (nthcdr 2 first))
+ (org-export-data def info)))
+ ;; Fill paragraph once footnote ID is inserted
+ ;; in order to have a correct length for first
+ ;; line.
+ (org-ascii--fill-string
+ (concat id (org-export-data def info))
+ text-width info))))))
+ definitions "\n\n"))))))
+ global-margin))))
(defun org-ascii-template (contents info)
"Return complete document string after ASCII conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- (concat
- ;; 1. Build title block.
- (org-ascii--indent-string
- (concat (org-ascii-template--document-title info)
- ;; 2. Table of contents.
- (let ((depth (plist-get info :with-toc)))
- (when depth
- (concat
- (org-ascii--build-toc info (and (wholenump depth) depth))
- "\n\n\n"))))
- org-ascii-global-margin)
- ;; 3. Document's body.
- contents
- ;; 4. Creator. Ignore `comment' value as there are no comments in
- ;; ASCII. Justify it to the bottom right.
- (org-ascii--indent-string
- (let ((creator-info (plist-get info :with-creator))
- (text-width (- org-ascii-text-width org-ascii-global-margin)))
- (unless (or (not creator-info) (eq creator-info 'comment))
- (concat
- "\n\n\n"
- (org-ascii--fill-string
- (plist-get info :creator) text-width info 'right))))
- org-ascii-global-margin)))
+ (let ((global-margin (plist-get info :ascii-global-margin)))
+ (concat
+ ;; Build title block.
+ (org-ascii--indent-string
+ (concat (org-ascii-template--document-title info)
+ ;; 2. Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat
+ (org-ascii--build-toc info (and (wholenump depth) depth))
+ "\n\n\n"))))
+ global-margin)
+ ;; Document's body.
+ contents
+ ;; Creator. Justify it to the bottom right.
+ (and (plist-get info :with-creator)
+ (org-ascii--indent-string
+ (let ((text-width
+ (- (plist-get info :ascii-text-width) global-margin)))
+ (concat
+ "\n\n\n"
+ (org-ascii--fill-string
+ (plist-get info :creator) text-width info 'right)))
+ global-margin)))))
(defun org-ascii--translate (s info)
"Translate string S according to specified language and charset.
@@ -1020,8 +1151,9 @@ contextual information."
"Transcode a CENTER-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (org-ascii--justify-string
- contents (org-ascii--current-text-width center-block info) 'center))
+ ;; Center has already been taken care of at a lower level, so
+ ;; there's nothing left to do.
+ contents)
;;;; Clock
@@ -1030,16 +1162,16 @@ holding contextual information."
"Transcode a CLOCK object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (concat org-clock-string " "
- (org-translate-time
- (org-element-property :raw-value
- (org-element-property :value clock)))
- (let ((time (org-element-property :duration clock)))
- (and time
- (concat " => "
- (apply 'format
- "%2s:%02s"
- (org-split-string time ":")))))))
+ (org-ascii--justify-element
+ (concat org-clock-string " "
+ (org-timestamp-translate (org-element-property :value clock))
+ (let ((time (org-element-property :duration clock)))
+ (and time
+ (concat " => "
+ (apply 'format
+ "%2s:%02s"
+ (org-split-string time ":"))))))
+ clock info))
;;;; Code
@@ -1048,7 +1180,8 @@ information."
"Return a CODE object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format org-ascii-verbatim-format (org-element-property :value code)))
+ (format (plist-get info :ascii-verbatim-format)
+ (org-element-property :value code)))
;;;; Drawer
@@ -1059,7 +1192,8 @@ CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let ((name (org-element-property :drawer-name drawer))
(width (org-ascii--current-text-width drawer info)))
- (funcall org-ascii-format-drawer-function name contents width)))
+ (funcall (plist-get info :ascii-format-drawer-function)
+ name contents width)))
;;;; Dynamic Block
@@ -1087,8 +1221,10 @@ contextual information."
(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--box-string
- (org-export-format-code-default example-block info) info))
+ (org-ascii--justify-element
+ (org-ascii--box-string
+ (org-export-format-code-default example-block info) info)
+ example-block info))
;;;; Export Snippet
@@ -1106,7 +1242,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"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")
- (org-remove-indentation (org-element-property :value export-block))))
+ (org-ascii--justify-element
+ (org-element-property :value export-block) export-block info)))
;;;; Fixed Width
@@ -1114,9 +1251,11 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(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--box-string
- (org-remove-indentation
- (org-element-property :value fixed-width)) info))
+ (org-ascii--justify-element
+ (org-ascii--box-string
+ (org-remove-indentation
+ (org-element-property :value fixed-width)) info)
+ fixed-width info))
;;;; Footnote Definition
@@ -1149,8 +1288,9 @@ holding contextual information."
;; original buffer's spacing.
(pre-blanks
(make-string
- (if org-ascii-headline-spacing (car org-ascii-headline-spacing)
- (org-element-property :pre-blank headline)) ?\n))
+ (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
@@ -1164,7 +1304,7 @@ holding contextual information."
(concat
;; Bullet.
(let ((bullets (cdr (assq (plist-get info :ascii-charset)
- org-ascii-bullets))))
+ (plist-get info :ascii-bullets)))))
(char-to-string
(nth (mod (1- low-level-rank) (length bullets)) bullets)))
" "
@@ -1192,7 +1332,7 @@ information."
(let ((text-width (org-ascii--current-text-width horizontal-rule info))
(spec-width
(org-export-read-attribute :attr_ascii horizontal-rule :width)))
- (org-ascii--justify-string
+ (org-ascii--justify-lines
(make-string (if (and spec-width (string-match "^[0-9]+$" spec-width))
(string-to-number spec-width)
text-width)
@@ -1206,7 +1346,7 @@ information."
"Transcode an INLINE-SRC-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (format org-ascii-verbatim-format
+ (format (plist-get info :ascii-verbatim-format)
(org-element-property :value inline-src-block)))
@@ -1218,7 +1358,7 @@ contextual information."
See `org-ascii-format-inlinetask-function' for a description
of the parameters."
(let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
- (width (or width org-ascii-inlinetask-width)))
+ (width (or width (plist-get info :ascii-inlinetask-width))))
(org-ascii--indent-string
(concat
;; Top line, with an additional blank line if not in UTF-8.
@@ -1236,9 +1376,9 @@ of the parameters."
;; Bottom line.
(make-string width (if utf8p ?━ ?_)))
;; Flush the inlinetask to the right.
- (- org-ascii-text-width org-ascii-global-margin
+ (- (plist-get info :ascii-text-width) (plist-get info :ascii-global-margin)
(if (not (org-export-get-parent-headline inlinetask)) 0
- org-ascii-inner-margin)
+ (plist-get info :ascii-inner-margin))
(org-ascii--current-text-width inlinetask info)))))
(defun org-ascii-inlinetask (inlinetask contents info)
@@ -1246,7 +1386,7 @@ of the parameters."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let ((width (org-ascii--current-text-width inlinetask info)))
- (funcall org-ascii-format-inlinetask-function
+ (funcall (plist-get info :ascii-format-inlinetask-function)
;; todo.
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property
@@ -1334,20 +1474,21 @@ information."
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
(cond
- ((string= key "ASCII") value)
+ ((string= key "ASCII") (org-ascii--justify-element value keyword info))
((string= key "TOC")
- (let ((value (downcase value)))
- (cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (org-ascii--build-toc
- info (and (wholenump depth) depth) keyword)))
- ((string= "tables" value)
- (org-ascii--list-tables keyword info))
- ((string= "listings" value)
- (org-ascii--list-listings keyword info))))))))
+ (org-ascii--justify-element
+ (let ((case-fold-search t))
+ (cond
+ ((org-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)))
+ (org-ascii--build-toc info depth keyword localp)))
+ ((org-string-match-p "\\<tables\\>" value)
+ (org-ascii--list-tables keyword info))
+ ((org-string-match-p "\\<listings\\>" value)
+ (org-ascii--list-listings keyword info))))
+ keyword info)))))
;;;; Latex Environment
@@ -1357,7 +1498,9 @@ information."
CONTENTS is nil. INFO is a plist holding contextual
information."
(when (plist-get info :with-latex)
- (org-remove-indentation (org-element-property :value latex-environment))))
+ (org-ascii--justify-element
+ (org-remove-indentation (org-element-property :value latex-environment))
+ latex-environment info)))
;;;; Latex Fragment
@@ -1385,9 +1528,9 @@ CONTENTS is nil. INFO is a plist holding contextual
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information."
- (let ((raw-link (org-element-property :raw-link link))
- (type (org-element-property :type link)))
+ (let ((type (org-element-property :type link)))
(cond
+ ((org-export-custom-protocol-maybe link desc 'ascii))
((string= type "coderef")
(let ((ref (org-element-property :path link)))
(format (org-export-get-coderef-format ref desc)
@@ -1404,14 +1547,33 @@ INFO is a plist holding contextual information."
(let ((number
(org-export-get-ordinal
destination info nil 'org-ascii--has-caption-p)))
- (when number
- (if (atom number) (number-to-string number)
- (mapconcat 'number-to-string number "."))))))))
+ (if number
+ (if (atom number) (number-to-string number)
+ (mapconcat #'number-to-string number "."))
+ ;; Unnumbered headline.
+ (when (eq 'headline (org-element-type destination))
+ (format "[%s]"
+ (org-export-data
+ (org-element-property :title destination)
+ info)))))))))
(t
- (if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
- (concat
- (format "[%s]" desc)
- (unless org-ascii-links-to-notes (format " (%s)" raw-link))))))))
+ (let ((raw-link (org-element-property :raw-link link)))
+ (if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
+ (concat (format "[%s]" desc)
+ (and (not (plist-get info :ascii-links-to-notes))
+ (format " (%s)" raw-link)))))))))
+
+
+;;;; Node Properties
+
+(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."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
;;;; Paragraph
@@ -1420,16 +1582,17 @@ INFO is a plist holding contextual information."
"Transcode a PARAGRAPH element from Org to ASCII.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
- (org-ascii--fill-string
- (if (not (wholenump org-ascii-indented-line-width)) contents
- (concat
- ;; Do not indent first paragraph in a section.
- (unless (and (not (org-export-get-previous-element paragraph info))
- (eq (org-element-type (org-export-get-parent paragraph))
- 'section))
- (make-string org-ascii-indented-line-width ?\s))
- (replace-regexp-in-string "\\`[ \t]+" "" contents)))
- (org-ascii--current-text-width paragraph info) info))
+ (org-ascii--justify-element
+ (let ((indented-line-width (plist-get info :ascii-indented-line-width)))
+ (if (not (wholenump indented-line-width)) contents
+ (concat
+ ;; Do not indent first paragraph in a section.
+ (unless (and (not (org-export-get-previous-element paragraph info))
+ (eq (org-element-type (org-export-get-parent paragraph))
+ 'section))
+ (make-string indented-line-width ?\s))
+ (replace-regexp-in-string "\\`[ \t]+" "" contents))))
+ paragraph info))
;;;; Plain List
@@ -1438,7 +1601,11 @@ the plist used as a communication channel."
"Transcode a PLAIN-LIST element from Org to ASCII.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
- contents)
+ (let ((margin (plist-get info :ascii-list-margin)))
+ (if (or (< margin 1)
+ (eq (org-element-type (org-export-get-parent plain-list)) 'item))
+ contents
+ (org-ascii--indent-string contents margin))))
;;;; Plain Text
@@ -1466,25 +1633,34 @@ INFO is a plist used as a communication channel."
"Transcode a PLANNING element from Org to ASCII.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (mapconcat
- 'identity
- (delq nil
- (list (let ((closed (org-element-property :closed planning)))
- (when closed
- (concat org-closed-string " "
- (org-translate-time
- (org-element-property :raw-value closed)))))
- (let ((deadline (org-element-property :deadline planning)))
- (when deadline
- (concat org-deadline-string " "
- (org-translate-time
- (org-element-property :raw-value deadline)))))
- (let ((scheduled (org-element-property :scheduled planning)))
- (when scheduled
- (concat org-scheduled-string " "
- (org-translate-time
- (org-element-property :raw-value scheduled)))))))
- " "))
+ (org-ascii--justify-element
+ (mapconcat
+ #'identity
+ (delq nil
+ (list (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat org-closed-string " "
+ (org-timestamp-translate closed))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat org-deadline-string " "
+ (org-timestamp-translate deadline))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat org-scheduled-string " "
+ (org-timestamp-translate scheduled))))))
+ " ")
+ planning info))
+
+
+;;;; Property Drawer
+
+(defun org-ascii-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to ASCII.
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (org-ascii--justify-element contents property-drawer info)))
;;;; Quote Block
@@ -1493,26 +1669,7 @@ channel."
"Transcode a QUOTE-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (org-ascii--indent-string contents org-ascii-quote-margin))
-
-
-;;;; Quote Section
-
-(defun org-ascii-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to ASCII.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((width (org-ascii--current-text-width quote-section info))
- (value
- (org-export-data
- (org-remove-indentation (org-element-property :value quote-section))
- info)))
- (org-ascii--indent-string
- value
- (+ org-ascii-quote-margin
- ;; Don't apply inner margin if parent headline is low level.
- (let ((headline (org-export-get-parent-headline quote-section)))
- (if (org-export-low-level-p headline info) 0
- org-ascii-inner-margin))))))
+ (org-ascii--indent-string contents (plist-get info :ascii-quote-margin)))
;;;; Radio Target
@@ -1533,7 +1690,7 @@ contextual information."
(org-ascii--indent-string
(concat
contents
- (when org-ascii-links-to-notes
+ (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)
@@ -1543,7 +1700,7 @@ contextual information."
;; 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
- org-ascii-inner-margin))))
+ (plist-get info :ascii-inner-margin)))))
;;;; Special Block
@@ -1552,6 +1709,9 @@ contextual information."
"Transcode a SPECIAL-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
+ ;; "JUSTIFYLEFT" and "JUSTFYRIGHT" have already been taken care of
+ ;; at a lower level. There is no other special block type to
+ ;; handle.
contents)
@@ -1562,13 +1722,15 @@ holding contextual information."
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let ((caption (org-ascii--build-caption src-block info))
+ (caption-above-p (plist-get info :ascii-caption-above))
(code (org-export-format-code-default src-block info)))
(if (equal code "") ""
- (concat
- (when (and caption org-ascii-caption-above) (concat caption "\n"))
- (org-ascii--box-string code info)
- (when (and caption (not org-ascii-caption-above))
- (concat "\n" caption))))))
+ (org-ascii--justify-element
+ (concat
+ (and caption caption-above-p (concat caption "\n"))
+ (org-ascii--box-string code info)
+ (and caption (not caption-above-p) (concat "\n" caption)))
+ src-block info))))
;;;; Statistics Cookie
@@ -1616,26 +1778,29 @@ holding contextual information."
"Transcode a TABLE element from Org to ASCII.
CONTENTS is the contents of the table. INFO is a plist holding
contextual information."
- (let ((caption (org-ascii--build-caption table info)))
- (concat
- ;; Possibly add a caption string above.
- (when (and caption org-ascii-caption-above) (concat caption "\n"))
- ;; Insert table. Note: "table.el" tables are left unmodified.
- (cond ((eq (org-element-property :type table) 'org) contents)
- ((and org-ascii-table-use-ascii-art
- (eq (plist-get info :ascii-charset) 'utf-8)
- (require 'ascii-art-to-unicode nil t))
- (with-temp-buffer
- (insert (org-remove-indentation
- (org-element-property :value table)))
- (goto-char (point-min))
- (aa2u)
- (goto-char (point-max))
- (skip-chars-backward " \r\t\n")
- (buffer-substring (point-min) (point))))
- (t (org-remove-indentation (org-element-property :value table))))
- ;; Possible add a caption string below.
- (and (not org-ascii-caption-above) caption))))
+ (let ((caption (org-ascii--build-caption table info))
+ (caption-above-p (plist-get info :ascii-caption-above)))
+ (org-ascii--justify-element
+ (concat
+ ;; Possibly add a caption string above.
+ (and caption caption-above-p (concat caption "\n"))
+ ;; Insert table. Note: "table.el" tables are left unmodified.
+ (cond ((eq (org-element-property :type table) 'org) contents)
+ ((and (plist-get info :ascii-table-use-ascii-art)
+ (eq (plist-get info :ascii-charset) 'utf-8)
+ (require 'ascii-art-to-unicode nil t))
+ (with-temp-buffer
+ (insert (org-remove-indentation
+ (org-element-property :value table)))
+ (goto-char (point-min))
+ (aa2u)
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (buffer-substring (point-min) (point))))
+ (t (org-remove-indentation (org-element-property :value table))))
+ ;; Possible add a caption string below.
+ (and (not caption-above-p) caption))
+ table info)))
;;;; Table Cell
@@ -1661,12 +1826,13 @@ are ignored."
(plist-put info :ascii-table-cell-width-cache
(make-hash-table :test 'equal)))
:ascii-table-cell-width-cache)))
- (key (cons table col)))
+ (key (cons table col))
+ (widenp (plist-get info :ascii-table-widen-columns)))
(or (gethash key cache)
(puthash
key
(let ((cookie-width (org-export-table-cell-width table-cell info)))
- (or (and (not org-ascii-table-widen-columns) cookie-width)
+ (or (and (not widenp) cookie-width)
(let ((contents-width
(let ((max-width 0))
(org-element-map table 'table-row
@@ -1681,8 +1847,7 @@ are ignored."
info)
max-width)))
(cond ((not cookie-width) contents-width)
- (org-ascii-table-widen-columns
- (max cookie-width contents-width))
+ (widenp (max cookie-width contents-width))
(t cookie-width)))))
cache))))
@@ -1696,14 +1861,14 @@ a communication channel."
;; each cell in the column.
(let ((width (org-ascii--table-cell-width table-cell info)))
;; When contents are too large, truncate them.
- (unless (or org-ascii-table-widen-columns
+ (unless (or (plist-get info :ascii-table-widen-columns)
(<= (string-width (or contents "")) width))
(setq contents (concat (substring contents 0 (- width 2)) "=>")))
;; Align contents correctly within the cell.
(let* ((indent-tabs-mode nil)
(data
(when contents
- (org-ascii--justify-string
+ (org-ascii--justify-lines
contents width
(org-export-table-cell-alignment table-cell info)))))
(setq contents
@@ -1790,7 +1955,7 @@ holding contextual information."
(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 org-ascii-verbatim-format
+ (format (plist-get info :ascii-verbatim-format)
(org-element-property :value verbatim)))
@@ -1802,8 +1967,8 @@ 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-string contents verse-width 'left)
- org-ascii-quote-margin)))
+ (org-ascii--justify-element contents verse-block info)
+ (plist-get info :ascii-quote-margin))))
@@ -1818,9 +1983,10 @@ plist containing the communication channel.
This function only applies to `ascii' back-end. See
`org-ascii-headline-spacing' for information."
- (if (not org-ascii-headline-spacing) headline
- (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n)))
- (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))))
+ (let ((headline-spacing (plist-get info :ascii-headline-spacing)))
+ (if (not headline-spacing) headline
+ (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)
"Filter controlling number of blank lines between paragraphs.
@@ -1830,13 +1996,13 @@ back-end used for export. INFO is a plist used as
a communication channel.
See `org-ascii-paragraph-spacing' for information."
- (when (wholenump org-ascii-paragraph-spacing)
- (org-element-map tree 'paragraph
- (lambda (p)
- (when (eq (org-element-type (org-export-get-next-element p info))
- 'paragraph)
- (org-element-put-property
- p :post-blank org-ascii-paragraph-spacing)))))
+ (let ((paragraph-spacing (plist-get info :ascii-paragraph-spacing)))
+ (when (wholenump paragraph-spacing)
+ (org-element-map tree 'paragraph
+ (lambda (p)
+ (when (eq (org-element-type (org-export-get-next-element p info))
+ 'paragraph)
+ (org-element-put-property p :post-blank paragraph-spacing))))))
tree)
(defun org-ascii-filter-comment-spacing (tree backend info)
@@ -1965,7 +2131,7 @@ Return output file name."
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
-;; coding: utf-8-emacs
+;; coding: utf-8
;; End:
;;; ox-ascii.el ends here
diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el
index 5ab805d..3119bd4 100644
--- a/lisp/ox-beamer.el
+++ b/lisp/ox-beamer.el
@@ -1,6 +1,6 @@
;;; ox-beamer.el --- Beamer Back-End for Org Export Engine
-;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Nicolas Goaziou <n.goaziou AT gmail DOT com>
@@ -105,7 +105,9 @@ key Selection key for `org-beamer-select-environment'
open The opening template for the environment, with the following escapes
%a the action/overlay specification
%A the default action/overlay specification
- %o the options argument of the template
+ %R the raw BEAMER_act value
+ %o the options argument, with square brackets
+ %O the raw BEAMER_opt value
%h the headline text
%r the raw headline text (i.e. without any processing)
%H if there is headline text, that raw text in {} braces
@@ -133,6 +135,15 @@ You might want to put e.g. \"allowframebreaks=0.9\" here."
:type '(string :tag "Outline frame options"))
+(defcustom org-beamer-subtitle-format "\\subtitle{%s}"
+ "Format string used for transcoded subtitle.
+The format string should have at most one \"%s\"-expression,
+which is replaced with the subtitle."
+ :group 'org-export-beamer
+ :version "25.1"
+ :package-version '(Org . "8.3")
+ :type '(string :tag "Format string"))
+
;;; Internal Variables
@@ -231,15 +242,20 @@ Return overlay specification, as a string, or nil."
(if a (org-beamer-export-to-pdf t s v b)
(org-open-file (org-beamer-export-to-pdf nil s v b)))))))
:options-alist
- '((:beamer-theme "BEAMER_THEME" nil org-beamer-theme)
+ '((:headline-levels nil "H" org-beamer-frame-level)
+ (:latex-class "LATEX_CLASS" nil "beamer" t)
+ (:beamer-subtitle-format nil nil org-beamer-subtitle-format)
+ (:beamer-column-view-format "COLUMNS" nil org-beamer-column-view-format)
+ (:beamer-theme "BEAMER_THEME" nil org-beamer-theme)
(:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t)
(:beamer-font-theme "BEAMER_FONT_THEME" nil nil t)
(:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t)
(:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t)
- (:beamer-header-extra "BEAMER_HEADER" nil nil newline)
- ;; Modify existing properties.
- (:headline-levels nil "H" org-beamer-frame-level)
- (:latex-class "LATEX_CLASS" nil "beamer" t))
+ (:beamer-header "BEAMER_HEADER" nil nil newline)
+ (:beamer-environments-extra nil nil org-beamer-environments-extra)
+ (:beamer-frame-default-options nil nil org-beamer-frame-default-options)
+ (:beamer-outline-frame-options nil nil org-beamer-outline-frame-options)
+ (:beamer-outline-frame-title nil nil org-beamer-outline-frame-title))
:translate-alist '((bold . org-beamer-bold)
(export-block . org-beamer-export-block)
(export-snippet . org-beamer-export-snippet)
@@ -318,13 +334,10 @@ The value is either the label specified in \"BEAMER_opt\"
property, or a fallback value built from headline's number. This
function assumes HEADLINE will be treated as a frame."
(let ((opt (org-element-property :BEAMER_OPT headline)))
- (if (and (org-string-nw-p opt)
+ (if (and (stringp opt)
(string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt))
(match-string 1 opt)
- (format "sec-%s"
- (mapconcat 'number-to-string
- (org-export-get-headline-number headline info)
- "-")))))
+ (format "{sec:%s}" (org-export-get-reference headline info)))))
(defun org-beamer--frame-level (headline info)
"Return frame level in subtree containing HEADLINE.
@@ -333,12 +346,10 @@ INFO is a plist used as a communication channel."
;; 1. Look for "frame" environment in parents, starting from the
;; farthest.
(catch 'exit
- (mapc (lambda (parent)
- (let ((env (org-element-property :BEAMER_ENV parent)))
- (when (and env (member-ignore-case env '("frame" "fullframe")))
- (throw 'exit (org-export-get-relative-level parent info)))))
- (nreverse (org-export-get-genealogy headline)))
- nil)
+ (dolist (parent (nreverse (org-element-lineage headline)))
+ (let ((env (org-element-property :BEAMER_ENV parent)))
+ (when (and env (member-ignore-case env '("frame" "fullframe")))
+ (throw 'exit (org-export-get-relative-level parent info))))))
;; 2. Look for "frame" environment in HEADLINE.
(let ((env (org-element-property :BEAMER_ENV headline)))
(and env (member-ignore-case env '("frame" "fullframe"))
@@ -413,7 +424,8 @@ used as a communication channel."
;; Collect options from default value and headline's
;; properties. Also add a label for links.
(append
- (org-split-string org-beamer-frame-default-options ",")
+ (org-split-string
+ (plist-get info :beamer-frame-default-options) ",")
(and beamer-opt
(org-split-string
;; Remove square brackets if user provided
@@ -422,9 +434,12 @@ used as a communication channel."
(match-string 1 beamer-opt))
","))
;; Provide an automatic label for the frame
- ;; unless the user specified one.
+ ;; unless the user specified one. Also refrain
+ ;; from labeling `allowframebreaks' frames; this
+ ;; is not allowed by beamer.
(unless (and beamer-opt
- (string-match "\\(^\\|,\\)label=" beamer-opt))
+ (or (string-match "\\(^\\|,\\)label=" beamer-opt)
+ (string-match "allowframebreaks" beamer-opt)))
(list
(format "label=%s"
(org-beamer--get-label headline info)))))))
@@ -475,14 +490,15 @@ used as a communication channel."
(env-format
(cond ((member environment '("column" "columns")) nil)
((assoc environment
- (append org-beamer-environments-extra
+ (append (plist-get info :beamer-environments-extra)
org-beamer-environments-default)))
(t (user-error "Wrong block type at a headline named \"%s\""
raw-title))))
(title (org-export-data (org-element-property :title headline) info))
- (options (let ((options (org-element-property :BEAMER_OPT headline)))
- (if (not options) ""
- (org-beamer--normalize-argument options 'option))))
+ (raw-options (org-element-property :BEAMER_OPT headline))
+ (options (if raw-options
+ (org-beamer--normalize-argument raw-options 'option)
+ ""))
;; Start a "columns" environment when explicitly requested or
;; when there is no previous headline or the previous
;; headline do not have a BEAMER_column property.
@@ -521,7 +537,7 @@ used as a communication channel."
;; One can specify placement for column only when
;; HEADLINE stands for a column on its own.
(if (equal environment "column") options "")
- (format "%s\\textwidth" column-width)))
+ (format "%s\\columnwidth" column-width)))
;; Block's opening string.
(when (nth 2 env-format)
(concat
@@ -534,15 +550,18 @@ used as a communication channel."
;; overlay specification and the default one is nil.
(let ((action (org-element-property :BEAMER_ACT headline)))
(cond
- ((not action) (list (cons "a" "") (cons "A" "")))
+ ((not action) (list (cons "a" "") (cons "A" "") (cons "R" "")))
((string-match "\\`\\[.*\\]\\'" action)
(list
(cons "A" (org-beamer--normalize-argument action 'defaction))
- (cons "a" "")))
+ (cons "a" "")
+ (cons "R" action)))
(t
(list (cons "a" (org-beamer--normalize-argument action 'action))
- (cons "A" "")))))
+ (cons "A" "")
+ (cons "R" action)))))
(list (cons "o" options)
+ (cons "O" (or raw-options ""))
(cons "h" title)
(cons "r" raw-title)
(cons "H" (if (equal raw-title "") ""
@@ -640,15 +659,27 @@ as a communication channel."
"Transcode an ITEM element into Beamer code.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let ((action (let ((first-element (car (org-element-contents item))))
- (and (eq (org-element-type first-element) 'paragraph)
- (org-beamer--element-has-overlay-p first-element))))
- (output (org-export-with-backend 'latex item contents info)))
- (if (or (not action) (not (string-match "\\\\item" output))) output
- ;; If the item starts with a paragraph and that paragraph starts
- ;; with an export snippet specifying an overlay, insert it after
- ;; \item command.
- (replace-match (concat "\\\\item" action) nil nil output))))
+ (org-export-with-backend
+ ;; Delegate item export to `latex'. However, we use `beamer'
+ ;; transcoders for objects in the description tag.
+ (org-export-create-backend
+ :parent 'beamer
+ :transcoders
+ (list
+ (cons
+ 'item
+ (lambda (item c i)
+ (let ((action
+ (let ((first (car (org-element-contents item))))
+ (and (eq (org-element-type first) 'paragraph)
+ (org-beamer--element-has-overlay-p first))))
+ (output (org-latex-item item contents info)))
+ (if (not (and action (string-match "\\\\item" output))) output
+ ;; If the item starts with a paragraph and that paragraph
+ ;; starts with an export snippet specifying an overlay,
+ ;; append it to the \item command.
+ (replace-match (concat "\\\\item" action) nil nil output)))))))
+ item contents info))
;;;; Keyword
@@ -683,15 +714,16 @@ 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)))
- ;; Use \hyperlink command for all internal links.
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link contents 'beamer))
+ ;; Use \hyperlink command for all internal links.
((equal type "radio")
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) contents
(format "\\hyperlink%s{%s}{%s}"
(or (org-beamer--element-has-overlay-p link) "")
- (org-export-solidify-link-text
- (org-element-property :value destination))
+ (org-export-get-reference destination info)
contents))))
((and (member type '("custom-id" "fuzzy" "id"))
(let ((destination (if (string= type "fuzzy")
@@ -713,11 +745,11 @@ used as a communication channel."
label
contents))))
(target
- (let ((path (org-export-solidify-link-text path)))
- (if (not contents) (format "\\ref{%s}" path)
+ (let ((ref (org-export-get-reference destination info)))
+ (if (not contents) (format "\\ref{%s}" ref)
(format "\\hyperlink%s{%s}{%s}"
(or (org-beamer--element-has-overlay-p link) "")
- path
+ ref
contents))))))))
;; Otherwise, use `latex' back-end.
(t (org-export-with-backend 'latex link contents info)))))
@@ -755,7 +787,8 @@ contextual information."
'option)
;; Eventually insert contents and close environment.
contents
- latex-type))))
+ latex-type)
+ info)))
;;;; Radio Target
@@ -766,8 +799,7 @@ TEXT is the text of the target. INFO is a plist holding
contextual information."
(format "\\hypertarget%s{%s}{%s}"
(or (org-beamer--element-has-overlay-p radio-target) "")
- (org-export-solidify-link-text
- (org-element-property :value radio-target))
+ (org-export-get-reference radio-target info)
text))
@@ -777,8 +809,7 @@ contextual information."
"Transcode a TARGET object into Beamer code.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "\\hypertarget{%s}{}"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "\\label{%s}" (org-export-get-reference target info)))
;;;; Template
@@ -790,7 +821,8 @@ information."
"Return complete document string after Beamer conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- (let ((title (org-export-data (plist-get info :title) info)))
+ (let ((title (org-export-data (plist-get info :title) info))
+ (subtitle (org-export-data (plist-get info :subtitle) info)))
(concat
;; 1. Time-stamp.
(and (plist-get info :time-stamp-file)
@@ -817,8 +849,7 @@ holding export options."
(concat (org-element-normalize-string
(plist-get info :latex-header))
(org-element-normalize-string
- (plist-get info :latex-header-extra))
- (plist-get info :beamer-header-extra)))))
+ (plist-get info :latex-header-extra))))))
info)))
;; 3. Insert themes.
(let ((format-theme
@@ -852,52 +883,52 @@ holding export options."
(org-export-data (plist-get info :email) info))))
(cond ((and author email (not (string= "" email)))
(format "\\author{%s\\thanks{%s}}\n" author email))
- (author (format "\\author{%s}\n" author))
- (t "\\author{}\n")))
+ ((or author email) (format "\\author{%s}\n" (or author email)))))
;; 6. 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
(format "\\title{%s}\n" title)
- ;; 8. Hyperref options.
- (when (plist-get info :latex-hyperref-p)
- (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
- (or (plist-get info :keywords) "")
- (or (plist-get info :description) "")
- (if (not (plist-get info :with-creator)) ""
- (plist-get info :creator))))
- ;; 9. Document start.
+ (when (org-string-nw-p subtitle)
+ (concat (format (plist-get info :beamer-subtitle-format) subtitle) "\n"))
+ ;; 8. Beamer-header
+ (let ((beamer-header (plist-get info :beamer-header)))
+ (when beamer-header
+ (format "%s\n" (plist-get info :beamer-header))))
+ ;; 9. Hyperref options.
+ (let ((template (plist-get info :latex-hyperref-template)))
+ (and (stringp template)
+ (format-spec template (org-latex--format-spec info))))
+ ;; 10. Document start.
"\\begin{document}\n\n"
- ;; 10. Title command.
+ ;; 11. Title command.
(org-element-normalize-string
- (cond ((string= "" title) nil)
+ (cond ((not (plist-get info :with-title)) nil)
+ ((string= "" title) nil)
((not (stringp org-latex-title-command)) nil)
((string-match "\\(?:[^%]\\|^\\)%s"
org-latex-title-command)
(format org-latex-title-command title))
(t org-latex-title-command)))
- ;; 11. Table of contents.
+ ;; 12. Table of contents.
(let ((depth (plist-get info :with-toc)))
(when depth
(concat
(format "\\begin{frame}%s{%s}\n"
(org-beamer--normalize-argument
- org-beamer-outline-frame-options 'option)
- org-beamer-outline-frame-title)
+ (plist-get info :beamer-outline-frame-options) 'option)
+ (plist-get info :beamer-outline-frame-title))
(when (wholenump depth)
(format "\\setcounter{tocdepth}{%d}\n" depth))
"\\tableofcontents\n"
"\\end{frame}\n\n")))
- ;; 12. Document's body.
+ ;; 13. Document's body.
contents
- ;; 13. Creator.
- (let ((creator-info (plist-get info :with-creator)))
- (cond
- ((not creator-info) "")
- ((eq creator-info 'comment)
- (format "%% %s\n" (plist-get info :creator)))
- (t (concat (plist-get info :creator) "\n"))))
- ;; 14. Document end.
+ ;; 14. Creator.
+ (if (plist-get info :with-creator)
+ (concat (plist-get info :creator) "\n")
+ "")
+ ;; 15. Document end.
"\\end{document}")))
@@ -1121,30 +1152,6 @@ aid, but the tag does not have any semantic meaning."
(t (org-entry-delete nil "BEAMER_env"))))))
;;;###autoload
-(defun org-beamer-insert-options-template (&optional kind)
- "Insert a settings template, to make sure users do this right."
- (interactive (progn
- (message "Current [s]ubtree or [g]lobal?")
- (if (eq (read-char-exclusive) ?g) (list 'global)
- (list 'subtree))))
- (if (eq kind 'subtree)
- (progn
- (org-back-to-heading t)
- (org-reveal)
- (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer")
- (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]")
- (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf")
- (when org-beamer-column-view-format
- (org-entry-put nil "COLUMNS" org-beamer-column-view-format))
- (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths))
- (insert "#+LaTeX_CLASS: beamer\n")
- (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n")
- (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n"))
- (when org-beamer-column-view-format
- (insert "#+COLUMNS: " org-beamer-column-view-format "\n"))
- (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n")))
-
-;;;###autoload
(defun org-beamer-publish-to-latex (plist filename pub-dir)
"Publish an Org file to a Beamer presentation (LaTeX).
diff --git a/lisp/ox-html.el b/lisp/ox-html.el
index 23498b2..679792a 100644
--- a/lisp/ox-html.el
+++ b/lisp/ox-html.el
@@ -1,6 +1,6 @@
;;; ox-html.el --- HTML Back-End for Org Export Engine
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Jambunathan K <kjambunathan at gmail dot com>
@@ -72,13 +72,13 @@
(latex-fragment . org-html-latex-fragment)
(line-break . org-html-line-break)
(link . org-html-link)
+ (node-property . org-html-node-property)
(paragraph . org-html-paragraph)
(plain-list . org-html-plain-list)
(plain-text . org-html-plain-text)
(planning . org-html-planning)
(property-drawer . org-html-property-drawer)
(quote-block . org-html-quote-block)
- (quote-section . org-html-quote-section)
(radio-target . org-html-radio-target)
(section . org-html-section)
(special-block . org-html-special-block)
@@ -108,25 +108,66 @@
(if a (org-html-export-to-html t s v b)
(org-open-file (org-html-export-to-html nil s v b)))))))
:options-alist
- '((:html-extension nil nil org-html-extension)
- (:html-link-org-as-html nil nil org-html-link-org-files-as-html)
- (:html-doctype "HTML_DOCTYPE" nil org-html-doctype)
+ '((:html-doctype "HTML_DOCTYPE" nil org-html-doctype)
(:html-container "HTML_CONTAINER" nil org-html-container-element)
+ (:description "DESCRIPTION" nil nil newline)
+ (:keywords "KEYWORDS" nil nil space)
(:html-html5-fancy nil "html5-fancy" org-html-html5-fancy)
(:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url)
(: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)
(:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline)
- (:html-head-include-default-style nil "html-style" org-html-head-include-default-style)
+ (:subtitle "SUBTITLE" nil nil parse)
+ (:html-head-include-default-style
+ nil "html-style" org-html-head-include-default-style)
(:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts)
+ (:html-allow-name-attribute-in-anchors
+ nil nil org-html-allow-name-attribute-in-anchors)
+ (:html-divs nil nil org-html-divs)
+ (:html-checkbox-type nil nil org-html-checkbox-type)
+ (:html-extension nil nil org-html-extension)
+ (:html-footnote-format nil nil org-html-footnote-format)
+ (:html-footnote-separator nil nil org-html-footnote-separator)
+ (:html-footnotes-section nil nil org-html-footnotes-section)
+ (:html-format-drawer-function nil nil org-html-format-drawer-function)
+ (:html-format-headline-function nil nil org-html-format-headline-function)
+ (:html-format-inlinetask-function
+ nil nil org-html-format-inlinetask-function)
+ (:html-home/up-format nil nil org-html-home/up-format)
+ (:html-indent nil nil org-html-indent)
+ (:html-infojs-options nil nil org-html-infojs-options)
+ (:html-infojs-template nil nil org-html-infojs-template)
+ (:html-inline-image-rules nil nil org-html-inline-image-rules)
+ (:html-link-org-files-as-html nil nil org-html-link-org-files-as-html)
+ (:html-mathjax-options nil nil org-html-mathjax-options)
+ (:html-mathjax-template nil nil org-html-mathjax-template)
+ (:html-metadata-timestamp-format nil nil org-html-metadata-timestamp-format)
+ (:html-postamble-format nil nil org-html-postamble-format)
+ (:html-preamble-format nil nil org-html-preamble-format)
+ (:html-table-align-individual-fields
+ nil nil org-html-table-align-individual-fields)
+ (:html-table-caption-above nil nil org-html-table-caption-above)
+ (:html-table-data-tags nil nil org-html-table-data-tags)
+ (:html-table-header-tags nil nil org-html-table-header-tags)
+ (:html-table-use-header-tags-for-first-column
+ nil nil org-html-table-use-header-tags-for-first-column)
+ (:html-tag-class-prefix nil nil org-html-tag-class-prefix)
+ (:html-text-markup-alist nil nil org-html-text-markup-alist)
+ (:html-todo-kwd-class-prefix nil nil org-html-todo-kwd-class-prefix)
+ (:html-toplevel-hlevel nil nil org-html-toplevel-hlevel)
+ (:html-use-infojs nil nil org-html-use-infojs)
+ (:html-use-unicode-chars nil nil org-html-use-unicode-chars)
+ (:html-validation-link nil nil org-html-validation-link)
+ (: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-xml-declaration nil nil org-html-xml-declaration)
- (:html-inline-images nil nil org-html-inline-images)
(:infojs-opt "INFOJS_OPT" nil nil)
;; Redefine regular options.
(:creator "CREATOR" nil org-html-creator-string)
@@ -232,16 +273,22 @@ for the JavaScript code in this tag.
(defconst org-html-style-default
"<style type=\"text/css\">
<!--/*--><![CDATA[/*><!--*/
- .title { text-align: center; }
+ .title { text-align: center;
+ margin-bottom: .2em; }
+ .subtitle { text-align: center;
+ font-size: medium;
+ font-weight: bold;
+ margin-top:0; }
.todo { font-family: monospace; color: red; }
- .done { color: green; }
+ .done { font-family: monospace; color: green; }
+ .priority { font-family: monospace; color: orange; }
.tag { background-color: #eee; font-family: monospace;
padding: 2px; font-size: 80%; font-weight: normal; }
.timestamp { color: #bebebe; }
.timestamp-kwd { color: #5f9ea0; }
- .right { margin-left: auto; margin-right: 0px; text-align: right; }
- .left { margin-left: 0px; margin-right: auto; text-align: left; }
- .center { margin-left: auto; margin-right: auto; text-align: center; }
+ .org-right { margin-left: auto; margin-right: 0px; text-align: right; }
+ .org-left { margin-left: 0px; margin-right: auto; text-align: left; }
+ .org-center { margin-left: auto; margin-right: auto; text-align: center; }
.underline { text-decoration: underline; }
#postamble p, #preamble p { font-size: 90%; margin: .2em; }
p.verse { margin-left: 3%; }
@@ -280,15 +327,14 @@ for the JavaScript code in this tag.
caption.t-above { caption-side: top; }
caption.t-bottom { caption-side: bottom; }
td, th { vertical-align:top; }
- th.right { text-align: center; }
- th.left { text-align: center; }
- th.center { text-align: center; }
- td.right { text-align: right; }
- td.left { text-align: left; }
- td.center { text-align: center; }
+ th.org-right { text-align: center; }
+ th.org-left { text-align: center; }
+ th.org-center { text-align: center; }
+ td.org-right { text-align: right; }
+ td.org-left { text-align: left; }
+ td.org-center { text-align: center; }
dt { font-weight: bold; }
- .footpara:nth-child(2) { display: inline; }
- .footpara { display: block; }
+ .footpara { display: inline; }
.footdef { margin-bottom: 1em; }
.figure { padding: 1em; }
.figure p { text-align: center; }
@@ -452,18 +498,19 @@ Option settings will replace the %MANAGER-OPTIONS cookie."
EXP-PLIST is a plist containing export options. BACKEND is the
export back-end currently used."
(unless (or (memq 'body-only (plist-get exp-plist :export-options))
- (not org-html-use-infojs)
- (and (eq org-html-use-infojs 'when-configured)
- (or (not (plist-get exp-plist :infojs-opt))
- (string= "" (plist-get exp-plist :infojs-opt))
- (string-match "\\<view:nil\\>"
- (plist-get exp-plist :infojs-opt)))))
- (let* ((template org-html-infojs-template)
+ (not (plist-get exp-plist :html-use-infojs))
+ (and (eq (plist-get exp-plist :html-use-infojs) 'when-configured)
+ (let ((opt (plist-get exp-plist :infojs-opt)))
+ (or (not opt)
+ (string= "" opt)
+ (string-match "\\<view:nil\\>" opt)))))
+ (let* ((template (plist-get exp-plist :html-infojs-template))
(ptoc (plist-get exp-plist :with-toc))
(hlevels (plist-get exp-plist :headline-levels))
(sdepth hlevels)
(tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels))
(options (plist-get exp-plist :infojs-opt))
+ (infojs-opt (plist-get exp-plist :html-infojs-options))
(table org-html-infojs-opts-table)
style)
(dolist (entry table)
@@ -472,7 +519,7 @@ export back-end currently used."
;; Compute default values for script option OPT from
;; `org-html-infojs-options' variable.
(default
- (let ((default (cdr (assq opt org-html-infojs-options))))
+ (let ((default (cdr (assq opt infojs-opt))))
(if (and (symbolp default) (not (memq default '(t nil))))
(plist-get exp-plist default)
default)))
@@ -509,9 +556,9 @@ export back-end currently used."
(push (cons "TOC_DEPTH" tdepth) style)
;; Build style string.
(setq style (mapconcat
- (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
- (car x)
- (cdr x)))
+ (lambda (x)
+ (format "org_html_manager.set(\"%s\", \"%s\");"
+ (car x) (cdr x)))
style "\n"))
(when (and style (> (length style) 0))
(and (string-match "%MANAGER_OPTIONS" template)
@@ -570,8 +617,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:
@@ -581,7 +627,7 @@ The function must accept two parameters:
The function should return the string to be exported.
For example, the variable could be set to the following function
-in order to mimic default behaviour:
+in order to mimic default behavior:
The default value simply returns the value of CONTENTS."
:group 'org-export-html
@@ -628,28 +674,30 @@ document title."
:group 'org-export-html
:type 'integer)
-(defcustom org-html-format-headline-function 'ignore
+(defcustom org-html-format-headline-function
+ 'org-html-format-headline-default-function
"Function to format headline text.
-This function will be called with 5 arguments:
+This function will be called with six arguments:
TODO the todo keyword (string or nil).
TODO-TYPE the type of todo (symbol: `todo', `done', nil)
PRIORITY the priority of the headline (integer or nil)
TEXT the main headline text (string).
TAGS the tags (string or nil).
+INFO the export options (plist).
The function result will be used in the section format string."
:group 'org-export-html
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type 'function)
;;;; HTML-specific
-(defcustom org-html-allow-name-attribute-in-anchors t
+(defcustom org-html-allow-name-attribute-in-anchors nil
"When nil, do not set \"name\" attribute in anchors.
-By default, anchors are formatted with both \"id\" and \"name\"
-attributes, when appropriate."
+By default, when appropriate, anchors are formatted with \"id\"
+but without \"name\" attribute."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
@@ -657,21 +705,23 @@ attributes, when appropriate."
;;;; Inlinetasks
-(defcustom org-html-format-inlinetask-function 'ignore
+(defcustom org-html-format-inlinetask-function
+ 'org-html-format-inlinetask-default-function
"Function called to format an inlinetask in HTML code.
-The function must accept six parameters:
+The function must accept seven parameters:
TODO the todo keyword, as a string
TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
PRIORITY the inlinetask priority, as a string
NAME the inlinetask name, as a string.
TAGS the inlinetask tags, as a list of strings.
CONTENTS the contents of the inlinetask, as a string.
+ INFO the export options, as a plist
The function should return the string to be exported."
:group 'org-export-html
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type 'function)
;;;; LaTeX
@@ -711,7 +761,7 @@ t Synonym for `mathjax'."
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
+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."
@@ -745,22 +795,20 @@ link's path."
;;;; Plain Text
-(defcustom org-html-protect-char-alist
+(defvar org-html-protect-char-alist
'(("&" . "&amp;")
("<" . "&lt;")
(">" . "&gt;"))
- "Alist of characters to be converted by `org-html-protect'."
- :group 'org-export-html
- :type '(repeat (cons (string :tag "Character")
- (string :tag "HTML equivalent"))))
+ "Alist of characters to be converted by `org-html-encode-plain-text'.")
;;;; Src Block
(defcustom org-html-htmlize-output-type 'inline-css
"Output type to be used by htmlize when formatting code snippets.
-Choices are `css', to export the CSS selectors only, or `inline-css', to
-export the CSS attribute values inline in the HTML. We use as default
-`inline-css', in order to make the resulting HTML self-containing.
+Choices are `css' to export the CSS selectors only,`inline-css'
+to export the CSS attribute values inline in the HTML or `nil' to
+export plain text. We use as default `inline-css', in order to
+make the resulting HTML self-containing.
However, this will fail when using Emacs in batch mode for export, because
then no rich font definitions are in place. It will also not be good if
@@ -773,7 +821,7 @@ 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."
:group 'org-export-html
- :type '(choice (const css) (const inline-css)))
+ :type '(choice (const css) (const inline-css) (const nil)))
(defcustom org-html-htmlize-font-prefix "org-"
"The prefix for CSS class names for htmlize font specifications."
@@ -796,7 +844,7 @@ When exporting to HTML5, these values will be disregarded."
:value-type (string :tag "Value")))
(defcustom org-html-table-header-tags '("<th scope=\"%s\"%s>" . "</th>")
- "The opening tag for table header fields.
+ "The opening and ending tags for table header fields.
This is customizable so that alignment options can be specified.
The first %s will be filled with the scope of the field, either row or col.
The second %s will be replaced by a style entry to align the field.
@@ -806,7 +854,7 @@ See also the variable `org-html-table-align-individual-fields'."
:type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
(defcustom org-html-table-data-tags '("<td%s>" . "</td>")
- "The opening tag for table data fields.
+ "The opening and ending tags for table data fields.
This is customizable so that alignment options can be specified.
The first %s will be filled with the scope of the field, either row or col.
The second %s will be replaced by a style entry to align the field.
@@ -921,7 +969,10 @@ publishing, with :html-doctype."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
- :type 'string)
+ :type (append
+ '(choice)
+ (mapcar (lambda (x) `(const ,(car x))) org-html-doctype-alist)
+ '((string :tag "Custom doctype" ))))
(defcustom org-html-html5-fancy nil
"Non-nil means using new HTML5 elements.
@@ -973,6 +1024,41 @@ org-info.js for your website."
(list :tag "Postamble" (const :format "" postamble)
(string :tag " id") (string :tag "element"))))
+(defconst org-html-checkbox-types
+ '((unicode .
+ ((on . "&#x2611;") (off . "&#x2610;") (trans . "&#x2610;")))
+ (ascii .
+ ((on . "<code>[X]</code>")
+ (off . "<code>[&#xa0;]</code>")
+ (trans . "<code>[-]</code>")))
+ (html .
+ ((on . "<input type='checkbox' checked='checked' />")
+ (off . "<input type='checkbox' />")
+ (trans . "<input type='checkbox' />"))))
+ "Alist of checkbox types.
+The cdr of each entry is an alist list three checkbox types for
+HTML export: `on', `off' and `trans'.
+
+The choices are:
+ `unicode' Unicode characters (HTML entities)
+ `ascii' ASCII characters
+ `html' HTML checkboxes
+
+Note that only the ascii characters implement tri-state
+checkboxes. The other two use the `off' checkbox for `trans'.")
+
+(defcustom org-html-checkbox-type 'ascii
+ "The type of checkboxes to use for HTML export.
+See `org-html-checkbox-types' for for the values used for each
+option."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "ASCII characters" ascii)
+ (const :tag "Unicode characters" unicode)
+ (const :tag "HTML checkboxes" html)))
+
(defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M"
"Format used for timestamps in preamble, postamble and metadata.
See `format-time-string' for more information on its components."
@@ -984,82 +1070,112 @@ See `format-time-string' for more information on its components."
;;;; Template :: Mathjax
(defcustom org-html-mathjax-options
- '((path "http://orgmode.org/mathjax/MathJax.js")
+ '((path "http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS_HTML" )
(scale "100")
(align "center")
- (indent "2em")
- (mathml nil))
+ (font "TeX")
+ (linebreaks "false")
+ (autonumber "AMS")
+ (indent "0em")
+ (multlinewidth "85%")
+ (tagindent ".8em")
+ (tagside "right"))
"Options for MathJax setup.
-path The path where to find MathJax
-scale Scaling for the HTML-CSS backend, usually between 100 and 133
-align How to align display math: left, center, or right
-indent If align is not center, how far from the left/right side?
-mathml Should a MathML player be used if available?
- This is faster and reduces bandwidth use, but currently
- sometimes has lower spacing quality. Therefore, the default is
- nil. When browsers get better, this switch can be flipped.
+Alist of the following elements. All values are strings.
+
+path The path to MathJax.
+scale Scaling with HTML-CSS, MathML and SVG output engines.
+align How to align display math: left, center, or right.
+font The font to use with HTML-CSS and SVG output. As of MathJax 2.5
+ the following values are understood: \"TeX\", \"STIX-Web\",
+ \"Asana-Math\", \"Neo-Euler\", \"Gyre-Pagella\",
+ \"Gyre-Termes\", and \"Latin-Modern\".
+linebreaks Let MathJax perform automatic linebreaks. Valid values
+ are \"true\" and \"false\".
+indent If align is not center, how far from the left/right side?
+ Valid values are \"left\" and \"right\"
+multlinewidth The width of the multline environment.
+autonumber How to number equations. Valid values are \"None\",
+ \"all\" and \"AMS Math\".
+tagindent The amount tags are indented.
+tagside Which side to show tags/labels on. Valid values are
+ \"left\" and \"right\"
You can also customize this for each buffer, using something like
-#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
+#+HTML_MATHJAX: align: left indent: 5em tagside: left font: Neo-Euler
+
+For further information about MathJax options, see the MathJax documentation:
+
+ http://docs.mathjax.org/
+
+Please note that by using the default CDN one must agree with
+MathJax CDN Terms of Service.
+
+ http://www.mathjax.org/mathjax-cdn-terms-of-service.html"
:group 'org-export-html
+ :package-version '(Org . "8.3")
:type '(list :greedy t
- (list :tag "path (the path from where to load MathJax.js)"
- (const :format " " path) (string))
- (list :tag "scale (scaling for the displayed math)"
- (const :format " " scale) (string))
- (list :tag "align (alignment of displayed equations)"
- (const :format " " align) (string))
- (list :tag "indent (indentation with left or right alignment)"
- (const :format " " indent) (string))
- (list :tag "mathml (should MathML display be used is possible)"
- (const :format " " mathml) (boolean))))
+ (list :tag "path (the path from where to load MathJax.js)"
+ (const :format " " path) (string))
+ (list :tag "scale (scaling for the displayed math)"
+ (const :format " " scale) (string))
+ (list :tag "align (alignment of displayed equations)"
+ (const :format " " align) (string))
+ (list :tag "font (used to display math)"
+ (const :format " " font)
+ (choice (const "TeX")
+ (const "STIX-Web")
+ (const "Asana-Math")
+ (const "Neo-Euler")
+ (const "Gyre-Pagella")
+ (const "Gyre-Termes")
+ (const "Latin-Modern")))
+ (list :tag "linebreaks (automatic line-breaking)"
+ (const :format " " linebreaks)
+ (choice (const "true")
+ (const "false")))
+ (list :tag "autonumber (when should equations be numbered)"
+ (const :format " " autonumber)
+ (choice (const "AMS")
+ (const "None")
+ (const "All")))
+ (list :tag "indent (indentation with left or right alignment)"
+ (const :format " " indent) (string))
+ (list :tag "multlinewidth (width to use for the multline environment)"
+ (const :format " " multlinewidth) (string))
+ (list :tag "tagindent (the indentation of tags from left or right)"
+ (const :format " " tagindent) (string))
+ (list :tag "tagside (location of tags)"
+ (const :format " " tagside)
+ (choice (const "left")
+ (const "right")))))
(defcustom org-html-mathjax-template
- "<script type=\"text/javascript\" src=\"%PATH\"></script>
-<script type=\"text/javascript\">
-<!--/*--><![CDATA[/*><!--*/
+ "<script type=\"text/x-mathjax-config\">
MathJax.Hub.Config({
- // Only one of the two following lines, depending on user settings
- // First allows browser-native MathML display, second forces HTML/CSS
- :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"],
- :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"],
- extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\",
- \"TeX/noUndefined.js\"],
- tex2jax: {
- inlineMath: [ [\"\\\\(\",\"\\\\)\"] ],
- displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ],
- skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],
- ignoreClass: \"tex2jax_ignore\",
- processEscapes: false,
- processEnvironments: true,
- preview: \"TeX\"
- },
- showProcessingMessages: true,
displayAlign: \"%ALIGN\",
displayIndent: \"%INDENT\",
- \"HTML-CSS\": {
- scale: %SCALE,
- availableFonts: [\"STIX\",\"TeX\"],
- preferredFont: \"TeX\",
- webFont: \"TeX\",
- imageFont: \"TeX\",
- showMathMenu: true,
- },
- MMLorHTML: {
- prefer: {
- MSIE: \"MML\",
- Firefox: \"MML\",
- Opera: \"HTML\",
- other: \"HTML\"
+ \"HTML-CSS\": { scale: %SCALE,
+ linebreaks: { automatic: \"%LINEBREAKS\" },
+ webFont: \"%FONT\"
+ },
+ SVG: {scale: %SCALE,
+ linebreaks: { automatic: \"%LINEBREAKS\" },
+ font: \"%FONT\"},
+ NativeMML: {scale: %SCALE},
+ TeX: { equationNumbers: {autoNumber: \"%AUTONUMBER\"},
+ MultLineWidth: \"%MULTLINEWIDTH\",
+ TagSide: \"%TAGSIDE\",
+ TagIndent: \"%TAGINDENT\"
}
- }
- });
-/*]]>*///-->
-</script>"
- "The MathJax setup for XHTML files."
+});
+</script>
+<script type=\"text/javascript\"
+ src=\"%PATH\"></script>"
+ "The MathJax template. See also `org-html-mathjax-options'."
:group 'org-export-html
:type 'string)
@@ -1101,6 +1217,7 @@ The second element of each list is a format string to format the
postamble itself. This format string can contain these elements:
%t stands for the title.
+ %s stands for the subtitle.
%a stands for the author's name.
%e stands for the author's email.
%d stands for the date.
@@ -1165,6 +1282,7 @@ The second element of each list is a format string to format the
preamble itself. This format string can contain these elements:
%t stands for the title.
+ %s stands for the subtitle.
%a stands for the author's name.
%e stands for the author's email.
%d stands for the date.
@@ -1293,6 +1411,54 @@ or for publication projects using the :html-head-extra property."
;;;###autoload
(put 'org-html-head-extra 'safe-local-variable 'stringp)
+;;;; Template :: Viewport
+
+(defcustom org-html-viewport '((width "device-width")
+ (initial-scale "1")
+ (minimum-scale "")
+ (maximum-scale "")
+ (user-scalable ""))
+ "Viewport options for mobile-optimized sites.
+
+The following values are recognized
+
+width Size of the viewport.
+initial-scale Zoom level when the page is first loaded.
+minimum-scale Minimum allowed zoom level.
+maximum-scale Maximum allowed zoom level.
+user-scalable Whether zoom can be changed.
+
+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"
+ :package-version '(Org . "8.3")
+ :type '(choice (const :tag "Disable" nil)
+ (list :tag "Enable"
+ (list :tag "Width of viewport"
+ (const :format " " width)
+ (choice (const :tag "unset" "")
+ (string)))
+ (list :tag "Initial scale"
+ (const :format " " initial-scale)
+ (choice (const :tag "unset" "")
+ (string)))
+ (list :tag "Minimum scale/zoom"
+ (const :format " " minimum-scale)
+ (choice (const :tag "unset" "")
+ (string)))
+ (list :tag "Maximum scale/zoom"
+ (const :format " " maximum-scale)
+ (choice (const :tag "unset" "")
+ (string)))
+ (list :tag "User scalable/zoomable"
+ (const :format " " user-scalable)
+ (choice (const :tag "unset" "")
+ (const "true")
+ (const "false"))))))
+
;;;; Todos
(defcustom org-html-todo-kwd-class-prefix ""
@@ -1350,8 +1516,7 @@ arguments CAPTION and LABEL are given, use them for caption and
(format (if html5-fancy "\n<figure%s>%s%s\n</figure>"
"\n<div%s class=\"figure\">%s%s\n</div>")
;; ID.
- (if (not (org-string-nw-p label)) ""
- (format " id=\"%s\"" (org-export-solidify-link-text label)))
+ (if (org-string-nw-p label) (format " id=\"%s\"" label) "")
;; Contents.
(format "\n<p>%s</p>" contents)
;; Caption.
@@ -1366,17 +1531,36 @@ SOURCE is a string specifying the location of the image.
ATTRIBUTES is a plist, as returned by
`org-export-read-attribute'. INFO is a plist used as
a communication channel."
- (org-html-close-tag
- "img"
- (org-html--make-attribute-string
- (org-combine-plists
- (list :src source
- :alt (if (string-match-p "^ltxpng/" source)
- (org-html-encode-plain-text
- (org-find-text-property-in-string 'org-latex-src source))
- (file-name-nondirectory source)))
- attributes))
- info))
+ (if (string= "svg" (file-name-extension source))
+ (org-html--svg-image source attributes info)
+ (org-html-close-tag
+ "img"
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (list :src source
+ :alt (if (string-match-p "^ltxpng/" source)
+ (org-html-encode-plain-text
+ (org-find-text-property-in-string 'org-latex-src source))
+ (file-name-nondirectory source)))
+ attributes))
+ 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.
+
+The special attribute \"fallback\" can be used to specify a fallback
+image file to use if the object embedding is not supported."
+ (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."))))
(defun org-html--textarea-block (element)
"Transcode ELEMENT into a textarea block.
@@ -1457,49 +1641,37 @@ Replaces invalid characters with \"_\"."
(setq kwd (replace-match "_" t t kwd))))
kwd)
-(defun org-html-format-footnote-reference (n def refcnt)
- "Format footnote reference N with definition DEF into HTML."
- (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt))))
- (format org-html-footnote-format
- (let* ((id (format "fnr.%s%s" n extra))
- (href (format " href=\"#fn.%s\"" n))
- (attributes (concat " class=\"footref\"" href)))
- (org-html--anchor id n attributes)))))
-
-(defun org-html-format-footnotes-section (section-name definitions)
- "Format footnotes section SECTION-NAME."
- (if (not definitions) ""
- (format org-html-footnotes-section section-name definitions)))
-
-(defun org-html-format-footnote-definition (fn)
- "Format the footnote definition FN."
- (let ((n (car fn)) (def (cdr fn)))
- (format
- "<div class=\"footdef\">%s %s</div>\n"
- (format org-html-footnote-format
- (let* ((id (format "fn.%s" n))
- (href (format " href=\"#fnr.%s\"" n))
- (attributes (concat " class=\"footnum\"" href)))
- (org-html--anchor id n attributes)))
- def)))
-
(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
- (plist-get info :parse-tree) info))
+ (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 "<p>%s</p>"
+ (format "<div class=\"footpara\">%s</div>"
(org-trim (org-export-data raw info))))))))
(when fn-alist
- (org-html-format-footnotes-section
+ (format
+ (plist-get info :html-footnotes-section)
(org-html--translate "Footnotes" info)
(format
"\n%s\n"
- (mapconcat 'org-html-format-footnote-definition fn-alist "\n"))))))
+ (mapconcat
+ (lambda (fn)
+ (let ((n (car fn)) (def (cdr fn)))
+ (format
+ "<div class=\"footdef\">%s %s</div>\n"
+ (format
+ (plist-get info :html-footnote-format)
+ (org-html--anchor
+ (format "fn.%d" n)
+ n
+ (format " class=\"footnum\" href=\"#fnr.%d\"" n)
+ info))
+ def)))
+ fn-alist
+ "\n"))))))
;;; Template
@@ -1529,10 +1701,11 @@ INFO is a plist used as a communication channel."
'mime-charset))
"iso-8859-1")))
(concat
- (format "<title>%s</title>\n" title)
(when (plist-get info :time-stamp-file)
(format-time-string
- (concat "<!-- " org-html-metadata-timestamp-format " -->\n")))
+ (concat "<!-- "
+ (plist-get info :html-metadata-timestamp-format)
+ " -->\n")))
(format
(if (org-html-html5-p info)
(org-html-close-tag "meta" " charset=\"%s\"" info)
@@ -1540,6 +1713,20 @@ INFO is a plist used as a communication channel."
"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)))
+ (plist-get info :html-viewport))))
+ (and viewport-options
+ (concat
+ (org-html-close-tag
+ "meta"
+ (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)
"\n"
(and (org-string-nw-p author)
@@ -1587,10 +1774,10 @@ INFO is a plist used as a communication channel."
(when (and (memq (plist-get info :with-latex) '(mathjax t))
(org-element-map (plist-get info :parse-tree)
'(latex-fragment latex-environment) 'identity info t))
- (let ((template org-html-mathjax-template)
- (options org-html-mathjax-options)
+ (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 (yes " ") (no "// ") x)
+ name val x)
(mapc
(lambda (e)
(setq name (car e) val (nth 1 e))
@@ -1598,20 +1785,9 @@ INFO is a plist used as a communication channel."
(setq val (car (read-from-string
(substring in-buffer (match-end 0))))))
(if (not (stringp val)) (setq val (format "%s" val)))
- (if (string-match (concat "%" (upcase (symbol-name name))) template)
- (setq template (replace-match val t t template))))
+ (while (string-match (concat "%" (upcase (symbol-name name))) template)
+ (setq template (replace-match val t t template))))
options)
- (setq val (nth 1 (assq 'mathml options)))
- (if (string-match (concat "\\<mathml:") in-buffer)
- (setq val (car (read-from-string
- (substring in-buffer (match-end 0))))))
- ;; Exchange prefixes depending on mathml setting.
- (if (not val) (setq x yes yes no no x))
- ;; Replace cookies to turn on or off the config/jax lines.
- (if (string-match ":MMLYES:" template)
- (setq template (replace-match yes t t template)))
- (if (string-match ":MMLNO:" template)
- (setq template (replace-match no t t template)))
;; Return the modified template.
(org-element-normalize-string template))))
@@ -1619,8 +1795,10 @@ INFO is a plist used as a communication channel."
"Return format specification for elements that can be
used in the preamble or postamble."
`((?t . ,(org-export-data (plist-get info :title) info))
+ (?s . ,(org-export-data (plist-get info :subtitle) info))
(?d . ,(org-export-data (org-export-get-date info) info))
- (?T . ,(format-time-string org-html-metadata-timestamp-format))
+ (?T . ,(format-time-string
+ (plist-get info :html-metadata-timestamp-format)))
(?a . ,(org-export-data (plist-get info :author) info))
(?e . ,(mapconcat
(lambda (e)
@@ -1629,10 +1807,10 @@ used in the preamble or postamble."
", "))
(?c . ,(plist-get info :creator))
(?C . ,(let ((file (plist-get info :input-file)))
- (format-time-string org-html-metadata-timestamp-format
- (if file (nth 5 (file-attributes file))
- (current-time)))))
- (?v . ,(or org-html-validation-link ""))))
+ (format-time-string
+ (plist-get info :html-metadata-timestamp-format)
+ (when file (nth 5 (file-attributes file))))))
+ (?v . ,(or (plist-get info :html-validation-link) ""))))
(defun org-html--build-pre/postamble (type info)
"Return document preamble or postamble as a string, or nil.
@@ -1672,7 +1850,8 @@ communication channel."
(format
"<p class=\"date\">%s: %s</p>\n"
(org-html--translate "Created" info)
- (format-time-string org-html-metadata-timestamp-format)))
+ (format-time-string
+ (plist-get info :html-metadata-timestamp-format))))
(when (plist-get info :with-creator)
(format "<p class=\"creator\">%s</p>\n" creator))
(format "<p class=\"validation\">%s</p>\n"
@@ -1688,14 +1867,15 @@ communication channel."
(eval
(intern (format "org-html-%s-format" type))))))
spec))))))
- (when (org-string-nw-p section-contents)
- (concat
- (format "<%s id=\"%s\" class=\"%s\">\n"
- (nth 1 (assq type org-html-divs))
- (nth 2 (assq type org-html-divs))
- org-html--pre/postamble-class)
- (org-element-normalize-string section-contents)
- (format "</%s>\n" (nth 1 (assq type org-html-divs)))))))))
+ (let ((div (assq type (plist-get info :html-divs))))
+ (when (org-string-nw-p section-contents)
+ (concat
+ (format "<%s id=\"%s\" class=\"%s\">\n"
+ (nth 1 div)
+ (nth 2 div)
+ org-html--pre/postamble-class)
+ (org-element-normalize-string section-contents)
+ (format "</%s>\n" (nth 1 div)))))))))
(defun org-html-inner-template (contents info)
"Return body of document string after HTML conversion.
@@ -1716,20 +1896,19 @@ CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(concat
(when (and (not (org-html-html5-p info)) (org-html-xhtml-p info))
- (let ((decl (or (and (stringp org-html-xml-declaration)
- org-html-xml-declaration)
- (cdr (assoc (plist-get info :html-extension)
- org-html-xml-declaration))
- (cdr (assoc "html" org-html-xml-declaration))
-
- "")))
- (when (not (or (eq nil decl) (string= "" decl)))
+ (let* ((xml-declaration (plist-get info :html-xml-declaration))
+ (decl (or (and (stringp xml-declaration) xml-declaration)
+ (cdr (assoc (plist-get info :html-extension)
+ xml-declaration))
+ (cdr (assoc "html" xml-declaration))
+ "")))
+ (when (not (or (not decl) (string= "" decl)))
(format "%s\n"
(format decl
- (or (and org-html-coding-system
- (fboundp 'coding-system-get)
- (coding-system-get org-html-coding-system 'mime-charset))
- "iso-8859-1"))))))
+ (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system 'mime-charset))
+ "iso-8859-1"))))))
(org-html-doctype info)
"\n"
(concat "<html"
@@ -1747,21 +1926,33 @@ holding export options."
(let ((link-up (org-trim (plist-get info :html-link-up)))
(link-home (org-trim (plist-get info :html-link-home))))
(unless (and (string= link-up "") (string= link-home ""))
- (format org-html-home/up-format
+ (format (plist-get info :html-home/up-format)
(or link-up link-home)
(or link-home link-up))))
;; Preamble.
(org-html--build-pre/postamble 'preamble info)
;; Document contents.
- (format "<%s id=\"%s\">\n"
- (nth 1 (assq 'content org-html-divs))
- (nth 2 (assq 'content org-html-divs)))
+ (let ((div (assq 'content (plist-get info :html-divs))))
+ (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div)))
;; Document title.
- (let ((title (plist-get info :title)))
- (format "<h1 class=\"title\">%s</h1>\n" (org-export-data (or title "") info)))
+ (when (plist-get info :with-title)
+ (let ((title (plist-get info :title))
+ (subtitle (plist-get info :subtitle)))
+ (when title
+ (format
+ (if (plist-get info :html-html5-fancy)
+ "<header>\n<h1 class=\"title\">%s</h1>\n%s</header>"
+ "<h1 class=\"title\">%s%s</h1>\n")
+ (org-export-data title info)
+ (if subtitle
+ (format
+ (if (plist-get info :html-html5-fancy)
+ "<p class=\"subtitle\">%s</p>\n"
+ "\n<br>\n<span class=\"subtitle\">%s</span>\n")
+ (org-export-data subtitle info))
+ "")))))
contents
- (format "</%s>\n"
- (nth 1 (assq 'content org-html-divs)))
+ (format "</%s>\n" (nth 1 (assq 'content (plist-get info :html-divs))))
;; Postamble.
(org-html--build-pre/postamble 'postamble info)
;; Closing document.
@@ -1774,9 +1965,9 @@ INFO is a plist used as a communication channel."
;;;; Anchor
-(defun org-html--anchor (&optional id desc attributes)
+(defun org-html--anchor (id desc attributes info)
"Format a HTML anchor."
- (let* ((name (and org-html-allow-name-attribute-in-anchors id))
+ (let* ((name (and (plist-get info :html-allow-name-attribute-in-anchors) id))
(attributes (concat (and id (format " id=\"%s\"" id))
(and name (format " name=\"%s\"" name))
attributes)))
@@ -1784,43 +1975,38 @@ INFO is a plist used as a communication channel."
;;;; Todo
-(defun org-html--todo (todo)
+(defun org-html--todo (todo info)
"Format TODO keywords into HTML."
(when todo
(format "<span class=\"%s %s%s\">%s</span>"
(if (member todo org-done-keywords) "done" "todo")
- org-html-todo-kwd-class-prefix (org-html-fix-class-name todo)
+ (plist-get info :html-todo-kwd-class-prefix)
+ (org-html-fix-class-name todo)
todo)))
+;;;; Priority
+
+(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."
+ (and priority (format "<span class=\"priority\">[%c]</span>" priority)))
+
;;;; Tags
-(defun org-html--tags (tags)
- "Format TAGS into HTML."
+(defun org-html--tags (tags info)
+ "Format TAGS into HTML.
+INFO is a plist containing export options."
(when tags
(format "<span class=\"tag\">%s</span>"
(mapconcat
(lambda (tag)
(format "<span class=\"%s\">%s</span>"
- (concat org-html-tag-class-prefix
+ (concat (plist-get info :html-tag-class-prefix)
(org-html-fix-class-name tag))
tag))
tags "&#xa0;"))))
-;;;; Headline
-
-(defun* org-html-format-headline
- (todo todo-type priority text tags
- &key level section-number headline-label &allow-other-keys)
- "Format a headline in HTML."
- (let ((section-number
- (when section-number
- (format "<span class=\"section-number-%d\">%s</span> "
- level section-number)))
- (todo (org-html--todo todo))
- (tags (org-html--tags tags)))
- (concat section-number todo (and todo " ") text
- (and tags "&#xa0;&#xa0;&#xa0;") tags)))
-
;;;; Src Code
(defun org-html-fontify-code (code lang)
@@ -1839,6 +2025,10 @@ is the language used for CODE, as a string, or nil."
(message "Cannot fontify src block (htmlize.el >= 1.34 required)")
;; Simple transcoding.
(org-html-encode-plain-text code))
+ ;; Case 3: plain text explicitly set
+ ((not org-html-htmlize-output-type)
+ ;; Simple transcoding.
+ (org-html-encode-plain-text code))
(t
;; Map language
(setq lang (or (assoc-default lang org-src-lang-modes) lang))
@@ -1851,25 +2041,30 @@ is the language used for CODE, as a string, or nil."
;; Case 2: Default. Fontify code.
(t
;; htmlize
- (setq code (with-temp-buffer
- ;; Switch to language-specific mode.
- (funcall lang-mode)
- (insert code)
- ;; Fontify buffer.
- (font-lock-fontify-buffer)
- ;; Remove formatting on newline characters.
- (save-excursion
- (let ((beg (point-min))
- (end (point-max)))
- (goto-char beg)
- (while (progn (end-of-line) (< (point) end))
- (put-text-property (point) (1+ (point)) 'face nil)
- (forward-char 1))))
- (org-src-mode)
- (set-buffer-modified-p nil)
- ;; Htmlize region.
- (org-html-htmlize-region-for-paste
- (point-min) (point-max))))
+ (setq code
+ (let ((output-type org-html-htmlize-output-type)
+ (font-prefix org-html-htmlize-font-prefix))
+ (with-temp-buffer
+ ;; Switch to language-specific mode.
+ (funcall lang-mode)
+ (insert code)
+ ;; Fontify buffer.
+ (font-lock-ensure)
+ ;; Remove formatting on newline characters.
+ (save-excursion
+ (let ((beg (point-min))
+ (end (point-max)))
+ (goto-char beg)
+ (while (progn (end-of-line) (< (point) end))
+ (put-text-property (point) (1+ (point)) 'face nil)
+ (forward-char 1))))
+ (org-src-mode)
+ (set-buffer-modified-p nil)
+ ;; Htmlize region.
+ (let ((org-html-htmlize-output-type output-type)
+ (org-html-htmlize-font-prefix font-prefix))
+ (org-html-htmlize-region-for-paste
+ (point-min) (point-max))))))
;; Strip any enclosing <pre></pre> tags.
(let* ((beg (and (string-match "\\`<pre[^>]*>\n*" code) (match-end 0)))
(end (and beg (string-match "</pre>\\'" code))))
@@ -1930,30 +2125,34 @@ a plist used as a communication channel."
;;; Tables of Contents
-(defun org-html-toc (depth info)
+(defun org-html-toc (depth info &optional scope)
"Build a table of contents.
-DEPTH is an integer specifying the depth of the table. INFO is a
-plist used as a communication channel. Return the table of
-contents as a string, or nil if it is empty."
+DEPTH is an integer specifying the depth of the table. INFO is
+a plist used as a communication channel. Optional argument SCOPE
+is an element defining the scope of the table. Return the table
+of contents as a string, or nil if it is empty."
(let ((toc-entries
(mapcar (lambda (headline)
(cons (org-html--format-toc-headline headline info)
(org-export-get-relative-level headline info)))
- (org-export-collect-headlines info depth)))
- (outer-tag (if (and (org-html-html5-p info)
- (plist-get info :html-html5-fancy))
- "nav"
- "div")))
+ (org-export-collect-headlines info depth scope))))
(when toc-entries
- (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
- (format "<h%d>%s</h%d>\n"
- org-html-toplevel-hlevel
- (org-html--translate "Table of Contents" info)
- org-html-toplevel-hlevel)
- "<div id=\"text-table-of-contents\">"
- (org-html--toc-text toc-entries)
- "</div>\n"
- (format "</%s>\n" outer-tag)))))
+ (let ((toc (concat "<div id=\"text-table-of-contents\">"
+ (org-html--toc-text toc-entries)
+ "</div>\n")))
+ (if scope toc
+ (let ((outer-tag (if (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy))
+ "nav"
+ "div")))
+ (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
+ (let ((top-level (plist-get info :html-toplevel-hlevel)))
+ (format "<h%d>%s</h%d>\n"
+ top-level
+ (org-html--translate "Table of Contents" info)
+ top-level))
+ toc
+ (format "</%s>\n" outer-tag))))))))
(defun org-html--toc-text (toc-entries)
"Return innards of a table of contents, as a string.
@@ -2006,21 +2205,15 @@ INFO is a plist used as a communication channel."
(org-export-get-tags headline info))))
(format "<a href=\"#%s\">%s</a>"
;; Label.
- (org-export-solidify-link-text
- (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-"
- (mapconcat #'number-to-string headline-number "-"))))
+ (or (org-element-property :CUSTOM_ID headline)
+ (org-export-get-reference headline info))
;; Body.
(concat
(and (not (org-export-low-level-p headline info))
(org-export-numbered-headline-p headline info)
(concat (mapconcat #'number-to-string headline-number ".")
". "))
- (apply (if (not (eq org-html-format-headline-function 'ignore))
- (lambda (todo todo-type priority text tags &rest ignore)
- (funcall org-html-format-headline-function
- todo todo-type priority text tags))
- #'org-html-format-headline)
+ (apply (plist-get info :html-format-headline-function)
todo todo-type priority text tags :section-number nil)))))
(defun org-html-list-of-listings (info)
@@ -2030,17 +2223,19 @@ of listings as a string, or nil if it is empty."
(let ((lol-entries (org-export-collect-listings info)))
(when lol-entries
(concat "<div id=\"list-of-listings\">\n"
- (format "<h%d>%s</h%d>\n"
- org-html-toplevel-hlevel
- (org-html--translate "List of Listings" info)
- org-html-toplevel-hlevel)
+ (let ((top-level (plist-get info :html-toplevel-hlevel)))
+ (format "<h%d>%s</h%d>\n"
+ top-level
+ (org-html--translate "List of Listings" info)
+ top-level))
"<div id=\"text-list-of-listings\">\n<ul>\n"
(let ((count 0)
(initial-fmt (format "<span class=\"listing-number\">%s</span>"
(org-html--translate "Listing %d:" info))))
(mapconcat
(lambda (entry)
- (let ((label (org-element-property :name entry))
+ (let ((label (and (org-element-property :name entry)
+ (org-export-get-reference entry info)))
(title (org-trim
(org-export-data
(or (org-export-get-caption entry t)
@@ -2051,7 +2246,7 @@ of listings as a string, or nil if it is empty."
(if (not label)
(concat (format initial-fmt (incf count)) " " title)
(format "<a href=\"#%s\">%s %s</a>"
- (org-export-solidify-link-text label)
+ label
(format initial-fmt (incf count))
title))
"</li>")))
@@ -2065,17 +2260,19 @@ of tables as a string, or nil if it is empty."
(let ((lol-entries (org-export-collect-tables info)))
(when lol-entries
(concat "<div id=\"list-of-tables\">\n"
- (format "<h%d>%s</h%d>\n"
- org-html-toplevel-hlevel
- (org-html--translate "List of Tables" info)
- org-html-toplevel-hlevel)
+ (let ((top-level (plist-get info :html-toplevel-hlevel)))
+ (format "<h%d>%s</h%d>\n"
+ top-level
+ (org-html--translate "List of Tables" info)
+ top-level))
"<div id=\"text-list-of-tables\">\n<ul>\n"
(let ((count 0)
(initial-fmt (format "<span class=\"table-number\">%s</span>"
(org-html--translate "Table %d:" info))))
(mapconcat
(lambda (entry)
- (let ((label (org-element-property :name entry))
+ (let ((label (and (org-element-property :name entry)
+ (org-export-get-reference entry info)))
(title (org-trim
(org-export-data
(or (org-export-get-caption entry t)
@@ -2086,7 +2283,7 @@ of tables as a string, or nil if it is empty."
(if (not label)
(concat (format initial-fmt (incf count)) " " title)
(format "<a href=\"#%s\">%s %s</a>"
- (org-export-solidify-link-text label)
+ label
(format initial-fmt (incf count))
title))
"</li>")))
@@ -2102,7 +2299,7 @@ of tables as a string, or nil if it is empty."
"Transcode BOLD from Org to HTML.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
- (format (or (cdr (assq 'bold org-html-text-markup-alist)) "%s")
+ (format (or (cdr (assq 'bold (plist-get info :html-text-markup-alist))) "%s")
contents))
;;;; Center Block
@@ -2125,9 +2322,7 @@ channel."
</span>
</p>"
org-clock-string
- (org-translate-time
- (org-element-property :raw-value
- (org-element-property :value clock)))
+ (org-timestamp-translate (org-element-property :value clock))
(let ((time (org-element-property :duration clock)))
(and time (format " <span class=\"timestamp\">(%s)</span>" time)))))
@@ -2137,7 +2332,7 @@ channel."
"Transcode CODE from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format (or (cdr (assq 'code org-html-text-markup-alist)) "%s")
+ (format (or (cdr (assq 'code (plist-get info :html-text-markup-alist))) "%s")
(org-html-encode-plain-text (org-element-property :value code))))
;;;; Drawer
@@ -2146,13 +2341,9 @@ information."
"Transcode a DRAWER element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (if (functionp org-html-format-drawer-function)
- (funcall org-html-format-drawer-function
- (org-element-property :drawer-name drawer)
- contents)
- ;; If there's no user defined function: simply
- ;; display contents of the drawer.
- contents))
+ (funcall (plist-get info :html-format-drawer-function)
+ (org-element-property :drawer-name drawer)
+ contents))
;;;; Dynamic Block
@@ -2217,128 +2408,111 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; 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)
- org-html-footnote-separator))
- (cond
- ((not (org-export-footnote-first-reference-p footnote-reference info))
- (org-html-format-footnote-reference
- (org-export-get-footnote-number footnote-reference info)
- "IGNORED" 100))
- ;; Inline definitions are secondary strings.
- ((eq (org-element-property :type footnote-reference) 'inline)
- (org-html-format-footnote-reference
- (org-export-get-footnote-number footnote-reference info)
- "IGNORED" 1))
- ;; Non-inline footnotes definitions are full Org data.
- (t (org-html-format-footnote-reference
- (org-export-get-footnote-number footnote-reference info)
- "IGNORED" 1)))))
+ (plist-get info :html-footnote-separator)))
+ (let* ((n (org-export-get-footnote-number footnote-reference info))
+ (id (format "fnr.%d%s"
+ n
+ (if (org-export-footnote-first-reference-p
+ footnote-reference info)
+ ""
+ ".100"))))
+ (format
+ (plist-get info :html-footnote-format)
+ (org-html--anchor
+ id n (format " class=\"footref\" href=\"#fn.%d\"" n) info)))))
;;;; Headline
-(defun org-html-format-headline--wrap
- (headline info &optional format-function &rest extra-keys)
- "Transcode a HEADLINE element from Org to HTML.
-CONTENTS holds the contents of the headline. INFO is a plist
-holding contextual information."
- (let* ((level (+ (org-export-get-relative-level headline info)
- (1- org-html-toplevel-hlevel)))
- (headline-number (org-export-get-headline-number headline info))
- (section-number (and (not (org-export-low-level-p headline info))
- (org-export-numbered-headline-p headline info)
- (mapconcat 'number-to-string
- headline-number ".")))
- (todo (and (plist-get info :with-todo-keywords)
- (let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data todo info)))))
- (todo-type (and todo (org-element-property :todo-type headline)))
- (priority (and (plist-get info :with-priority)
- (org-element-property :priority headline)))
- (text (org-export-data (org-element-property :title headline) info))
- (tags (and (plist-get info :with-tags)
- (org-export-get-tags headline info)))
- (headline-label (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-" (mapconcat 'number-to-string
- headline-number "-"))))
- (format-function
- (cond ((functionp format-function) format-function)
- ((not (eq org-html-format-headline-function 'ignore))
- (lambda (todo todo-type priority text tags &rest ignore)
- (funcall org-html-format-headline-function
- todo todo-type priority text tags)))
- (t 'org-html-format-headline))))
- (apply format-function
- todo todo-type priority text tags
- :headline-label headline-label :level level
- :section-number section-number extra-keys)))
-
(defun org-html-headline (headline contents info)
"Transcode a HEADLINE element from Org to HTML.
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
(unless (org-element-property :footnote-section-p headline)
- (let* ((contents (or contents ""))
- (numberedp (org-export-numbered-headline-p headline info))
- (level (org-export-get-relative-level headline info))
- (text (org-export-data (org-element-property :title headline) info))
- (todo (and (plist-get info :with-todo-keywords)
- (let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data todo info)))))
- (todo-type (and todo (org-element-property :todo-type headline)))
- (tags (and (plist-get info :with-tags)
- (org-export-get-tags headline info)))
- (priority (and (plist-get info :with-priority)
- (org-element-property :priority headline)))
- (section-number (mapconcat #'number-to-string
- (org-export-get-headline-number
- headline info) "-"))
- (ids (delq 'nil
- (list (org-element-property :CUSTOM_ID headline)
- (concat "sec-" section-number)
- (org-element-property :ID headline))))
- (preferred-id (car ids))
- (extra-ids (mapconcat
- (lambda (id)
- (org-html--anchor
- (org-export-solidify-link-text
- (if (org-uuidgen-p id) (concat "ID-" id) id))))
- (cdr ids) ""))
- ;; Create the headline text.
- (full-text (org-html-format-headline--wrap headline info)))
+ (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)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-export-data (org-element-property :title headline) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (full-text (funcall (plist-get info :html-format-headline-function)
+ todo todo-type priority text tags info))
+ (contents (or contents ""))
+ (ids (delq nil
+ (list (org-element-property :CUSTOM_ID headline)
+ (org-export-get-reference headline info)
+ (org-element-property :ID headline))))
+ (preferred-id (car ids))
+ (extra-ids
+ (mapconcat
+ (lambda (id)
+ (org-html--anchor
+ (if (org-uuidgen-p id) (concat "ID-" id) id)
+ nil nil info))
+ (cdr ids) "")))
(if (org-export-low-level-p headline info)
- ;; This is a deep sub-tree: export it as a list item.
- (let* ((type (if numberedp 'ordered 'unordered))
- (itemized-body
- (org-html-format-list-item
- contents type nil info nil
- (concat (org-html--anchor preferred-id) extra-ids
- full-text))))
- (concat
- (and (org-export-first-sibling-p headline info)
- (org-html-begin-plain-list type))
- itemized-body
- (and (org-export-last-sibling-p headline info)
- (org-html-end-plain-list type))))
- ;; Standard headline. Export it as a section.
- (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
- (level1 (+ level (1- org-html-toplevel-hlevel)))
- (first-content (car (org-element-contents headline))))
- (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
- (org-html--container headline info)
- (format "outline-container-%s"
- (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-" section-number)))
- (concat (format "outline-%d" level1) (and extra-class " ")
- extra-class)
- (format "\n<h%d id=\"%s\">%s%s</h%d>\n"
- level1 preferred-id extra-ids full-text level1)
- ;; When there is no section, pretend there is an
- ;; empty one to get the correct <div class="outline-
- ;; ...> which is needed by `org-info.js'.
- (if (not (eq (org-element-type first-content) 'section))
- (concat (org-html-section first-content "" info)
- contents)
- contents)
- (org-html--container headline info)))))))
+ ;; This is a deep sub-tree: export it as a list item.
+ (let* ((type (if numberedp 'ordered 'unordered))
+ (itemized-body
+ (org-html-format-list-item
+ contents type nil info nil
+ (concat (org-html--anchor preferred-id nil nil info)
+ extra-ids
+ full-text))))
+ (concat (and (org-export-first-sibling-p headline info)
+ (org-html-begin-plain-list type))
+ itemized-body
+ (and (org-export-last-sibling-p headline info)
+ (org-html-end-plain-list type))))
+ (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
+ (first-content (car (org-element-contents headline))))
+ ;; Standard headline. Export it as a section.
+ (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
+ (org-html--container headline info)
+ (concat "outline-container-"
+ (org-export-get-reference headline info))
+ (concat (format "outline-%d" level)
+ (and extra-class " ")
+ extra-class)
+ (format "\n<h%d id=\"%s\">%s%s</h%d>\n"
+ level
+ preferred-id
+ extra-ids
+ (concat
+ (and numberedp
+ (format
+ "<span class=\"section-number-%d\">%s</span> "
+ level
+ (mapconcat #'number-to-string numbers ".")))
+ full-text)
+ level)
+ ;; When there is no section, pretend there is an
+ ;; empty one to get the correct <div
+ ;; class="outline-...> which is needed by
+ ;; `org-info.js'.
+ (if (eq (org-element-type first-content) 'section) contents
+ (concat (org-html-section first-content "" info) contents))
+ (org-html--container headline info)))))))
+
+(defun org-html-format-headline-default-function
+ (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))
+ (priority (org-html--priority priority info))
+ (tags (org-html--tags tags info)))
+ (concat todo (and todo " ")
+ priority (and priority " ")
+ text
+ (and tags "&#xa0;&#xa0;&#xa0;") tags)))
(defun org-html--container (headline info)
(or (org-element-property :HTML_CONTAINER headline)
@@ -2359,38 +2533,41 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"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* ((org-lang (org-element-property :language inline-src-block))
- (code (org-element-property :value inline-src-block)))
- (error "Cannot export inline src block")))
+ (let ((lang (org-element-property :language inline-src-block))
+ (code (org-html-format-code inline-src-block info))
+ (label
+ (let ((lbl (and (org-element-property :name inline-src-block)
+ (org-export-get-reference inline-src-block info))))
+ (if (not lbl) "" (format " id=\"%s\"" lbl)))))
+ (format "<code class=\"src src-%s\"%s>%s</code>" lang label code)))
;;;; Inlinetask
-(defun org-html-format-section (text class &optional id)
- "Format a section with TEXT into a HTML div with CLASS and ID."
- (let ((extra (concat (when id (format " id=\"%s\"" id)))))
- (concat (format "<div class=\"%s\"%s>\n" class extra) text "</div>\n")))
-
(defun org-html-inlinetask (inlinetask contents info)
"Transcode an INLINETASK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (cond
- ;; If `org-html-format-inlinetask-function' is not 'ignore, call it
- ;; with appropriate arguments.
- ((not (eq org-html-format-inlinetask-function 'ignore))
- (let ((format-function
- (function*
- (lambda (todo todo-type priority text tags
- &key contents &allow-other-keys)
- (funcall org-html-format-inlinetask-function
- todo todo-type priority text tags contents)))))
- (org-html-format-headline--wrap
- inlinetask info format-function :contents contents)))
- ;; Otherwise, use a default template.
- (t (format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
- (org-html-format-headline--wrap inlinetask info)
- (org-html-close-tag "br" nil info)
- contents))))
+ (let* ((todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type inlinetask)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask)))
+ (text (org-export-data (org-element-property :title inlinetask) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info))))
+ (funcall (plist-get info :html-format-inlinetask-function)
+ todo todo-type priority text tags contents info)))
+
+(defun org-html-format-inlinetask-default-function
+ (todo todo-type priority text tags contents info)
+ "Default format function for a inlinetasks.
+See `org-html-format-inlinetask-function' for details."
+ (format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
+ (org-html-format-headline-default-function
+ todo todo-type priority text tags info)
+ (org-html-close-tag "br" nil info)
+ contents))
;;;; Italic
@@ -2398,22 +2575,29 @@ holding contextual information."
"Transcode ITALIC from Org to HTML.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
- (format (or (cdr (assq 'italic org-html-text-markup-alist)) "%s") contents))
+ (format
+ (or (cdr (assq 'italic (plist-get info :html-text-markup-alist))) "%s")
+ contents))
;;;; Item
-(defun org-html-checkbox (checkbox)
- "Format CHECKBOX into HTML."
- (case checkbox (on "<code>[X]</code>")
- (off "<code>[&#xa0;]</code>")
- (trans "<code>[-]</code>")
- (t "")))
+(defun org-html-checkbox (checkbox info)
+ "Format CHECKBOX into HTML.
+INFO is a plist holding contextual information. See
+`org-html-checkbox-type' for customization options."
+ (cdr (assq checkbox
+ (cdr (assq (plist-get info :html-checkbox-type)
+ org-html-checkbox-types)))))
(defun org-html-format-list-item (contents type checkbox info
&optional term-counter-id
headline)
"Format a list item into HTML."
- (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " ")))
+ (let ((class (if checkbox
+ (format " class=\"%s\""
+ (symbol-name checkbox)) ""))
+ (checkbox (concat (org-html-checkbox checkbox info)
+ (and checkbox " ")))
(br (org-html-close-tag "br" nil info)))
(concat
(case type
@@ -2421,23 +2605,23 @@ contextual information."
(let* ((counter term-counter-id)
(extra (if counter (format " value=\"%s\"" counter) "")))
(concat
- (format "<li%s>" extra)
+ (format "<li%s%s>" class extra)
(when headline (concat headline br)))))
(unordered
(let* ((id term-counter-id)
(extra (if id (format " id=\"%s\"" id) "")))
(concat
- (format "<li%s>" extra)
+ (format "<li%s%s>" class extra)
(when headline (concat headline br)))))
(descriptive
(let* ((term term-counter-id))
(setq term (or term "(no term)"))
;; Check-boxes in descriptive lists are associated to tag.
- (concat (format "<dt> %s </dt>"
- (concat checkbox term))
+ (concat (format "<dt%s>%s</dt>"
+ class (concat checkbox term))
"<dd>"))))
(unless (eq type 'descriptive) checkbox)
- contents
+ (and contents (org-trim contents))
(case type
(ordered "</li>")
(unordered "</li>")
@@ -2466,13 +2650,13 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(cond
((string= key "HTML") value)
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (org-html-toc depth info)))
+ (let ((depth (and (string-match "\\<[0-9]+\\>" value)
+ (string-to-number (match-string 0 value))))
+ (localp (org-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))))))))
@@ -2509,7 +2693,7 @@ a plist containing export properties."
(with-temp-buffer
(insert latex-frag)
(org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..."
- nil nil processing-type)
+ nil processing-type)
(buffer-string))))
(defun org-html-latex-environment (latex-environment contents info)
@@ -2566,7 +2750,8 @@ inline image when it has no description and targets an image
file (see `org-html-inline-image-rules' for more information), or
if its description is a single link targeting an image file."
(if (not (org-element-contents link))
- (org-export-inline-image-p link org-html-inline-image-rules)
+ (org-export-inline-image-p
+ link (plist-get info :html-inline-image-rules))
(not
(let ((link-count 0))
(org-element-map (org-element-contents link)
@@ -2577,7 +2762,7 @@ if its description is a single link targeting an image file."
(link (if (= link-count 1) t
(incf link-count)
(not (org-export-inline-image-p
- obj org-html-inline-image-rules))))
+ obj (plist-get info :html-inline-image-rules)))))
(otherwise t)))
info t)))))
@@ -2622,7 +2807,6 @@ images, set it to:
(defun org-html-link (link desc info)
"Transcode a LINK object from Org to HTML.
-
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
@@ -2635,7 +2819,7 @@ INFO is a plist holding contextual information. See
"Treat links to `file.org' as links to `file.html', if needed.
See `org-html-link-org-files-as-html'."
(cond
- ((and org-html-link-org-files-as-html
+ ((and (plist-get info :html-link-org-files-as-html)
(string= ".org"
(downcase (file-name-extension raw-path "."))))
(concat (file-name-sans-extension raw-path) "."
@@ -2648,38 +2832,30 @@ INFO is a plist holding contextual information. See
(path
(cond
((member type '("http" "https" "ftp" "mailto"))
- (org-link-escape
- (org-link-unescape
- (concat type ":" raw-path)) org-link-escape-chars-browser))
+ (org-html-encode-plain-text
+ (org-link-escape-browser
+ (org-link-unescape (concat type ":" raw-path)))))
((string= type "file")
;; Treat links to ".org" files as ".html", if needed.
(setq raw-path
(funcall link-org-files-as-html-maybe raw-path info))
;; If file path is absolute, prepend it with protocol
- ;; component - "file:".
+ ;; component - "file://".
(cond
((file-name-absolute-p raw-path)
- (setq raw-path (concat "file:" raw-path)))
+ (setq raw-path (org-export-file-uri raw-path)))
((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 or a headline title. Any other
- ;; option is ignored.
+ ;; relative to a custom-id, a headline title a name,
+ ;; a target or a radio-target.
(let ((option (org-element-property :search-option link)))
- (cond ((not option) raw-path)
- ((eq (aref option 0) ?#) (concat raw-path option))
- ;; External fuzzy link: try to resolve it if path
- ;; belongs to current project, if any.
- ((eq (aref option 0) ?*)
- (concat
- raw-path
- (let ((numbers
- (org-publish-resolve-external-fuzzy-link
- (org-element-property :path link) option)))
- (and numbers (concat "#sec-"
- (mapconcat 'number-to-string
- numbers "-"))))))
- (t raw-path))))
+ (if (not option) raw-path
+ (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
@@ -2696,12 +2872,14 @@ INFO is a plist holding contextual information. See
(org-export-read-attribute :attr_html parent))))
(attributes
(let ((attr (org-html--make-attribute-string attributes-plist)))
- (if (org-string-nw-p attr) (concat " " attr) "")))
- protocol)
+ (if (org-string-nw-p attr) (concat " " attr) ""))))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc 'html))
;; Image file.
- ((and org-html-inline-images
- (org-export-inline-image-p link org-html-inline-image-rules))
+ ((and (plist-get info :html-inline-images)
+ (org-export-inline-image-p
+ link (plist-get info :html-inline-image-rules)))
(org-html--format-image path attributes-plist info))
;; Radio target: Transcode target's contents and use them as
;; link's description.
@@ -2709,9 +2887,9 @@ INFO is a plist holding contextual information. See
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
(format "<a href=\"#%s\"%s>%s</a>"
- (org-export-solidify-link-text
- (org-element-property :value destination))
- attributes desc))))
+ (org-export-get-reference destination info)
+ attributes
+ desc))))
;; Links pointing to a headline: Find destination and build
;; appropriate referencing command.
((member type '("custom-id" "fuzzy" "id"))
@@ -2735,55 +2913,43 @@ INFO is a plist holding contextual information. See
(org-element-property :raw-link link) info))))
;; Link points to a headline.
(headline
- (let ((href
- ;; What href to use?
- (cond
- ;; Case 1: Headline is linked via it's CUSTOM_ID
- ;; property. Use CUSTOM_ID.
- ((string= type "custom-id")
- (org-element-property :CUSTOM_ID destination))
- ;; Case 2: Headline is linked via it's ID property
- ;; or through other means. Use the default href.
- ((member type '("id" "fuzzy"))
- (format "sec-%s"
- (mapconcat 'number-to-string
- (org-export-get-headline-number
- destination info) "-")))
- (t (error "Shouldn't reach here"))))
+ (let ((href (or (org-element-property :CUSTOM_ID destination)
+ (org-export-get-reference destination info)))
;; What description to use?
(desc
;; Case 1: Headline is numbered and LINK has no
;; description. Display section number.
(if (and (org-export-numbered-headline-p destination info)
(not desc))
- (mapconcat 'number-to-string
+ (mapconcat #'number-to-string
(org-export-get-headline-number
destination info) ".")
;; Case 2: Either the headline is un-numbered or
;; LINK has a custom description. Display LINK's
;; description or headline's title.
- (or desc (org-export-data (org-element-property
- :title destination) info)))))
- (format "<a href=\"#%s\"%s>%s</a>"
- (org-export-solidify-link-text href) attributes desc)))
+ (or desc
+ (org-export-data
+ (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* ((path (org-export-solidify-link-text path))
- (org-html-standalone-image-predicate 'org-html--has-caption-p)
+ (let* ((ref (org-export-get-reference destination info))
+ (org-html-standalone-image-predicate
+ #'org-html--has-caption-p)
(number (cond
(desc nil)
((org-html-standalone-image-p destination info)
(org-export-get-ordinal
(org-element-map destination 'link
- 'identity info t)
+ #'identity info t)
info 'link 'org-html-standalone-image-p))
(t (org-export-get-ordinal
destination info nil 'org-html--has-caption-p))))
(desc (cond (desc)
((not number) "No description for this link")
((numberp number) (number-to-string number))
- (t (mapconcat 'number-to-string number ".")))))
- (format "<a href=\"#%s\"%s>%s</a>" path attributes desc))))))
+ (t (mapconcat #'number-to-string number ".")))))
+ (format "<a href=\"#%s\"%s>%s</a>" ref attributes desc))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
@@ -2798,9 +2964,6 @@ INFO is a plist holding contextual information. See
attributes
(format (org-export-get-coderef-format path desc)
(org-export-resolve-coderef path info)))))
- ;; Link type is handled by a special function.
- ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
- (funcall protocol (org-link-unescape path) desc 'html))
;; External link with a description part.
((and path desc) (format "<a href=\"%s\"%s>%s</a>" path attributes desc))
;; External link without a description part.
@@ -2808,6 +2971,17 @@ INFO is a plist holding contextual information. See
;; 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)
+ "Transcode a NODE-PROPERTY element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
+
;;;; Paragraph
(defun org-html-paragraph (paragraph contents info)
@@ -2816,13 +2990,19 @@ CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
(let* ((parent (org-export-get-parent paragraph))
(parent-type (org-element-type parent))
- (style '((footnote-definition " class=\"footpara\"")))
- (extra (or (cadr (assoc parent-type style)) "")))
+ (style '((footnote-definition " class=\"footpara\"")
+ (org-data " class=\"footpara\"")))
+ (attributes (org-html--make-attribute-string
+ (org-export-read-attribute :attr_html paragraph)))
+ (extra (or (cadr (assq parent-type style)) "")))
(cond
- ((and (eq (org-element-type parent) 'item)
- (= (org-element-property :begin paragraph)
- (org-element-property :contents-begin parent)))
- ;; Leading paragraph in a list item have no tags.
+ ((and (eq parent-type 'item)
+ (not (org-export-get-previous-element paragraph info))
+ (let ((followers (org-export-get-next-element paragraph info 2)))
+ (and (not (cdr followers))
+ (memq (org-element-type (car followers)) '(nil plain-list)))))
+ ;; First paragraph in an item has no tag if it is alone or
+ ;; followed, at most, by a sub-list.
contents)
((org-html-standalone-image-p paragraph info)
;; Standalone image.
@@ -2840,10 +3020,14 @@ the plist used as a communication channel."
'identity info t)
info nil 'org-html-standalone-image-p))
"</span> " raw))))
- (label (org-element-property :name paragraph)))
+ (label (and (org-element-property :name paragraph)
+ (org-export-get-reference paragraph info))))
(org-html--wrap-image contents info caption label)))
;; Regular paragraph.
- (t (format "<p%s>\n%s</p>" extra contents)))))
+ (t (format "<p%s%s>\n%s</p>"
+ (if (org-string-nw-p attributes)
+ (concat " " attributes) "")
+ extra contents)))))
;;;; Plain List
@@ -2892,11 +3076,8 @@ contextual information."
(defun org-html-encode-plain-text (text)
"Convert plain text characters from TEXT to HTML equivalent.
Possible conversions are set in `org-html-protect-char-alist'."
- (mapc
- (lambda (pair)
- (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
- org-html-protect-char-alist)
- text)
+ (dolist (pair org-html-protect-char-alist text)
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))))
(defun org-html-plain-text (text info)
"Transcode a TEXT string from Org to HTML.
@@ -2938,29 +3119,25 @@ channel."
(let ((closed (org-element-property :closed planning)))
(when closed
(format span-fmt org-closed-string
- (org-translate-time
- (org-element-property :raw-value closed)))))
+ (org-timestamp-translate closed))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline
(format span-fmt org-deadline-string
- (org-translate-time
- (org-element-property :raw-value deadline)))))
+ (org-timestamp-translate deadline))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
(format span-fmt org-scheduled-string
- (org-translate-time
- (org-element-property :raw-value scheduled)))))))
+ (org-timestamp-translate scheduled))))))
" "))))
;;;; Property Drawer
(defun org-html-property-drawer (property-drawer contents info)
"Transcode a PROPERTY-DRAWER element from Org to HTML.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- ;; The property drawer isn't exported but we want separating blank
- ;; lines nonetheless.
- "")
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format "<pre class=\"example\">\n%s</pre>" contents)))
;;;; Quote Block
@@ -2970,15 +3147,6 @@ CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(format "<blockquote>\n%s</blockquote>" contents))
-;;;; Quote Section
-
-(defun org-html-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to HTML.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format "<pre>\n%s</pre>" value))))
-
;;;; Section
(defun org-html-section (section contents info)
@@ -2990,16 +3158,19 @@ holding contextual information."
(if (not parent) contents
;; Get div's class and id references.
(let* ((class-num (+ (org-export-get-relative-level parent info)
- (1- org-html-toplevel-hlevel)))
+ (1- (plist-get info :html-toplevel-hlevel))))
(section-number
- (mapconcat
- 'number-to-string
- (org-export-get-headline-number parent info) "-")))
+ (and (org-export-numbered-headline-p parent info)
+ (mapconcat
+ #'number-to-string
+ (org-export-get-headline-number parent info) "-"))))
;; Build return value.
(format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>"
class-num
- (or (org-element-property :CUSTOM_ID parent) section-number)
- contents)))))
+ (or (org-element-property :CUSTOM_ID parent)
+ section-number
+ (org-export-get-reference parent info))
+ (or contents ""))))))
;;;; Radio Target
@@ -3007,9 +3178,8 @@ holding contextual information."
"Transcode a RADIO-TARGET object from Org to HTML.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- (let ((id (org-export-solidify-link-text
- (org-element-property :value radio-target))))
- (org-html--anchor id text)))
+ (let ((ref (org-export-get-reference radio-target info)))
+ (org-html--anchor ref text nil info)))
;;;; Special Block
@@ -3017,8 +3187,7 @@ contextual information."
"Transcode a SPECIAL-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let* ((block-type (downcase
- (org-element-property :type special-block)))
+ (let* ((block-type (org-element-property :type special-block))
(contents (or contents ""))
(html5-fancy (and (org-html-html5-p info)
(plist-get info :html-html5-fancy)
@@ -3048,10 +3217,9 @@ contextual information."
(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 (org-element-property :name src-block)))
- (if (not lbl) ""
- (format " id=\"%s\""
- (org-export-solidify-link-text lbl))))))
+ (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>"
@@ -3074,8 +3242,10 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode STRIKE-THROUGH from Org to HTML.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
- (format (or (cdr (assq 'strike-through org-html-text-markup-alist)) "%s")
- contents))
+ (format
+ (or (cdr (assq 'strike-through (plist-get info :html-text-markup-alist)))
+ "%s")
+ contents))
;;;; Subscript
@@ -3102,24 +3272,30 @@ channel."
(let* ((table-row (org-export-get-parent table-cell))
(table (org-export-get-parent-table table-cell))
(cell-attrs
- (if (not org-html-table-align-individual-fields) ""
+ (if (not (plist-get info :html-table-align-individual-fields)) ""
(format (if (and (boundp 'org-html-format-table-no-css)
org-html-format-table-no-css)
- " align=\"%s\"" " class=\"%s\"")
+ " align=\"%s\"" " class=\"org-%s\"")
(org-export-table-cell-alignment table-cell info)))))
(when (or (not contents) (string= "" (org-trim contents)))
(setq contents "&#xa0;"))
(cond
((and (org-export-table-has-header-p table info)
(= 1 (org-export-table-row-group table-row info)))
- (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs)
- contents (cdr org-html-table-header-tags)))
- ((and org-html-table-use-header-tags-for-first-column
+ (let ((header-tags (plist-get info :html-table-header-tags)))
+ (concat "\n" (format (car header-tags) "col" cell-attrs)
+ contents
+ (cdr header-tags))))
+ ((and (plist-get info :html-table-use-header-tags-for-first-column)
(zerop (cdr (org-export-table-cell-address table-cell info))))
- (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs)
- contents (cdr org-html-table-header-tags)))
- (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs)
- contents (cdr org-html-table-data-tags))))))
+ (let ((header-tags (plist-get info :html-table-header-tags)))
+ (concat "\n" (format (car header-tags) "row" cell-attrs)
+ contents
+ (cdr header-tags))))
+ (t (let ((data-tags (plist-get info :html-table-data-tags)))
+ (concat "\n" (format (car data-tags) cell-attrs)
+ contents
+ (cdr data-tags)))))))
;;;; Table Row
@@ -3158,10 +3334,10 @@ communication channel."
;; Begin a rowgroup?
(when start-rowgroup-p (car rowgroup-tags))
;; Actual table row
- (concat "\n" (eval (car org-html-table-row-tags))
+ (concat "\n" (eval (car (plist-get info :html-table-row-tags)))
contents
"\n"
- (eval (cdr org-html-table-row-tags)))
+ (eval (cdr (plist-get info :html-table-row-tags))))
;; End a rowgroup?
(when end-rowgroup-p (cdr rowgroup-tags))))))
@@ -3205,21 +3381,21 @@ contextual information."
(table.el (org-html-table--table.el-table table info))
;; Case 2: Standard table.
(t
- (let* ((label (org-element-property :name table))
- (caption (org-export-get-caption table))
+ (let* ((caption (org-export-get-caption table))
(number (org-export-get-ordinal
- table info nil 'org-html--has-caption-p))
+ table info nil #'org-html--has-caption-p))
(attributes
(org-html--make-attribute-string
(org-combine-plists
- (and label (list :id (org-export-solidify-link-text label)))
+ (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=\"%s\""))
+ "align=\"%s\"" "class=\"org-%s\""))
(table-column-specs
(function
(lambda (table info)
@@ -3244,7 +3420,7 @@ contextual information."
(format "<table%s>\n%s\n%s\n%s</table>"
(if (equal attributes "") "" (concat " " attributes))
(if (not caption) ""
- (format (if org-html-table-caption-above
+ (format (if (plist-get info :html-table-caption-above)
"<caption class=\"t-above\">%s</caption>"
"<caption class=\"t-bottom\">%s</caption>")
(concat
@@ -3260,9 +3436,8 @@ contextual information."
"Transcode a TARGET object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((id (org-export-solidify-link-text
- (org-element-property :value target))))
- (org-html--anchor id)))
+ (let ((ref (org-export-get-reference target info)))
+ (org-html--anchor ref nil nil info)))
;;;; Timestamp
@@ -3270,8 +3445,7 @@ information."
"Transcode a TIMESTAMP object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((value (org-html-plain-text
- (org-timestamp-translate timestamp) info)))
+ (let ((value (org-html-plain-text (org-timestamp-translate timestamp) info)))
(format "<span class=\"timestamp-wrapper\"><span class=\"timestamp\">%s</span></span>"
(replace-regexp-in-string "--" "&#x2013;" value))))
@@ -3281,7 +3455,8 @@ information."
"Transcode UNDERLINE from Org to HTML.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
- (format (or (cdr (assq 'underline org-html-text-markup-alist)) "%s")
+ (format (or (cdr (assq 'underline (plist-get info :html-text-markup-alist)))
+ "%s")
contents))
;;;; Verbatim
@@ -3290,7 +3465,7 @@ holding contextual information."
"Transcode VERBATIM from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format (or (cdr (assq 'verbatim org-html-text-markup-alist)) "%s")
+ (format (or (cdr (assq 'verbatim (plist-get info :html-text-markup-alist))) "%s")
(org-html-encode-plain-text (org-element-property :value verbatim))))
;;;; Verse Block
@@ -3323,9 +3498,9 @@ contextual information."
(with-temp-buffer
(insert contents)
(set-auto-mode t)
- (if org-html-indent
+ (if (plist-get info :html-indent)
(indent-region (point-min) (point-max)))
- (when org-html-use-unicode-chars
+ (when (plist-get info :html-use-unicode-chars)
(require 'mm-url)
(mm-url-decode-entities))
(buffer-substring-no-properties (point-min) (point-max))))
@@ -3408,7 +3583,9 @@ file-local settings.
Return output file's name."
(interactive)
- (let* ((extension (concat "." org-html-extension))
+ (let* ((extension (concat "." (or (plist-get ext-plist :html-extension)
+ org-html-extension
+ "html")))
(file (org-export-output-file-name extension subtreep))
(org-export-coding-system org-html-coding-system))
(org-export-to-file 'html file
@@ -3425,7 +3602,8 @@ publishing directory.
Return output file name."
(org-publish-org-to 'html filename
(concat "." (or (plist-get plist :html-extension)
- org-html-extension "html"))
+ org-html-extension
+ "html"))
plist pub-dir))
diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el
index cd48bbf..6778eae 100644
--- a/lisp/ox-icalendar.el
+++ b/lisp/ox-icalendar.el
@@ -85,10 +85,11 @@ keyword."
(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
"Contexts where iCalendar export should use a deadline time stamp.
-This is a list with several symbols in it. Valid symbol are:
+This is a list with possibly several symbols in it. Valid symbols are:
+
`event-if-todo' Deadlines in TODO entries become calendar events.
`event-if-not-todo' Deadlines in non-TODO entries become calendar events.
-`todo-due' Use deadlines in TODO entries as due-dates"
+`todo-due' Use deadlines in TODO entries as due-dates."
:group 'org-export-icalendar
:type '(set :greedy t
(const :tag "Deadlines in non-TODO entries become events"
@@ -101,7 +102,8 @@ This is a list with several symbols in it. Valid symbol are:
(defcustom org-icalendar-use-scheduled '(todo-start)
"Contexts where iCalendar export should use a scheduling time stamp.
-This is a list with several symbols in it. Valid symbol are:
+This is a list with possibly several symbols in it. Valid symbols are:
+
`event-if-todo' Scheduling time stamps in TODO entries become an event.
`event-if-not-todo' Scheduling time stamps in non-TODO entries become an event.
`todo-start' Scheduling time stamps in TODO entries become start date.
@@ -256,11 +258,18 @@ re-read the iCalendar file.")
'((:exclude-tags
"ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split)
(:with-timestamps nil "<" org-icalendar-with-timestamps)
- (:with-vtodo nil nil org-icalendar-include-todo)
- ;; The following property will be non-nil when export has been
- ;; started from org-agenda-mode. In this case, any entry without
- ;; a non-nil "ICALENDAR_MARK" property will be ignored.
- (:icalendar-agenda-view nil nil nil))
+ ;; Other variables.
+ (:icalendar-alarm-time nil nil org-icalendar-alarm-time)
+ (:icalendar-categories nil nil org-icalendar-categories)
+ (:icalendar-date-time-format nil nil org-icalendar-date-time-format)
+ (:icalendar-include-bbdb-anniversaries nil nil org-icalendar-include-bbdb-anniversaries)
+ (:icalendar-include-body nil nil org-icalendar-include-body)
+ (:icalendar-include-sexps nil nil org-icalendar-include-sexps)
+ (:icalendar-include-todo nil nil org-icalendar-include-todo)
+ (:icalendar-store-UID nil nil org-icalendar-store-UID)
+ (:icalendar-timezone nil nil org-icalendar-timezone)
+ (:icalendar-use-deadline nil nil org-icalendar-use-deadline)
+ (:icalendar-use-scheduled nil nil org-icalendar-use-scheduled))
:filters-alist
'((:filter-headline . org-icalendar-clear-blank-lines))
:menu-entry
@@ -275,22 +284,18 @@ re-read the iCalendar file.")
;;; Internal Functions
-(defun org-icalendar-create-uid (file &optional bell h-markers)
+(defun org-icalendar-create-uid (file &optional bell)
"Set ID property on headlines missing it in FILE.
When optional argument BELL is non-nil, inform the user with
-a message if the file was modified. With optional argument
-H-MARKERS non-nil, it is a list of markers for the headlines
-which will be updated."
- (let ((pt (if h-markers (goto-char (car h-markers)) (point-min)))
- modified-flag)
+a message if the file was modified."
+ (let (modified-flag)
(org-map-entries
(lambda ()
(let ((entry (org-element-at-point)))
- (unless (or (< (point) pt) (org-element-property :ID entry))
+ (unless (org-element-property :ID entry)
(org-id-get-create)
(setq modified-flag t)
- (forward-line))
- (when h-markers (setq org-map-continue-from (pop h-markers)))))
+ (forward-line))))
nil nil 'comment)
(when (and bell modified-flag)
(message "ID properties created in file \"%s\"" file)
@@ -318,19 +323,17 @@ A headline is blocked when either
;; Check :ORDERED: node property.
(catch 'blockedp
(let ((current headline))
- (mapc (lambda (parent)
- (cond
- ((not (org-element-property :todo-keyword parent))
- (throw 'blockedp nil))
- ((org-not-nil (org-element-property :ORDERED parent))
- (let ((sibling current))
- (while (setq sibling (org-export-get-previous-element
- sibling info))
- (when (eq (org-element-property :todo-type sibling) 'todo)
- (throw 'blockedp t)))))
- (t (setq current parent))))
- (org-export-get-genealogy headline))
- nil))))
+ (dolist (parent (org-element-lineage headline))
+ (cond
+ ((not (org-element-property :todo-keyword parent))
+ (throw 'blockedp nil))
+ ((org-not-nil (org-element-property :ORDERED parent))
+ (let ((sibling current))
+ (while (setq sibling (org-export-get-previous-element
+ sibling info))
+ (when (eq (org-element-property :todo-type sibling) 'todo)
+ (throw 'blockedp t)))))
+ (t (setq current parent))))))))
(defun org-icalendar-use-UTC-date-time-p ()
"Non-nil when `org-icalendar-date-time-format' requires UTC time."
@@ -521,99 +524,97 @@ inlinetask within the section."
(cons 'org-data
(cons nil (org-element-contents first))))))))
(concat
- (unless (and (plist-get info :icalendar-agenda-view)
- (not (org-element-property :ICALENDAR-MARK entry)))
- (let ((todo-type (org-element-property :todo-type entry))
- (uid (or (org-element-property :ID entry) (org-id-new)))
- (summary (org-icalendar-cleanup-string
- (or (org-element-property :SUMMARY entry)
- (org-export-data
- (org-element-property :title entry) info))))
- (loc (org-icalendar-cleanup-string
- (org-element-property :LOCATION entry)))
- ;; Build description of the entry from associated
- ;; section (headline) or contents (inlinetask).
- (desc
- (org-icalendar-cleanup-string
- (or (org-element-property :DESCRIPTION entry)
- (let ((contents (org-export-data inside info)))
- (cond
- ((not (org-string-nw-p contents)) nil)
- ((wholenump org-icalendar-include-body)
- (let ((contents (org-trim contents)))
- (substring
- contents 0 (min (length contents)
- org-icalendar-include-body))))
- (org-icalendar-include-body (org-trim contents)))))))
- (cat (org-icalendar-get-categories entry info)))
- (concat
- ;; Events: Delegate to `org-icalendar--vevent' to
- ;; generate "VEVENT" component from scheduled, deadline,
- ;; or any timestamp in the entry.
- (let ((deadline (org-element-property :deadline entry)))
- (and deadline
- (memq (if todo-type 'event-if-todo 'event-if-not-todo)
- org-icalendar-use-deadline)
- (org-icalendar--vevent
- entry deadline (concat "DL-" uid)
- (concat "DL: " summary) loc desc cat)))
- (let ((scheduled (org-element-property :scheduled entry)))
- (and scheduled
- (memq (if todo-type 'event-if-todo 'event-if-not-todo)
- org-icalendar-use-scheduled)
- (org-icalendar--vevent
- entry scheduled (concat "SC-" uid)
- (concat "S: " summary) loc desc cat)))
- ;; When collecting plain timestamps from a headline and
- ;; its title, skip inlinetasks since collection will
- ;; happen once ENTRY is one of them.
+ (let ((todo-type (org-element-property :todo-type entry))
+ (uid (or (org-element-property :ID entry) (org-id-new)))
+ (summary (org-icalendar-cleanup-string
+ (or (org-element-property :SUMMARY entry)
+ (org-export-data
+ (org-element-property :title entry) info))))
+ (loc (org-icalendar-cleanup-string
+ (org-element-property :LOCATION entry)))
+ ;; Build description of the entry from associated section
+ ;; (headline) or contents (inlinetask).
+ (desc
+ (org-icalendar-cleanup-string
+ (or (org-element-property :DESCRIPTION entry)
+ (let ((contents (org-export-data inside info)))
+ (cond
+ ((not (org-string-nw-p contents)) nil)
+ ((wholenump org-icalendar-include-body)
+ (let ((contents (org-trim contents)))
+ (substring
+ contents 0 (min (length contents)
+ org-icalendar-include-body))))
+ (org-icalendar-include-body (org-trim contents)))))))
+ (cat (org-icalendar-get-categories entry info)))
+ (concat
+ ;; Events: Delegate to `org-icalendar--vevent' to generate
+ ;; "VEVENT" component from scheduled, deadline, or any
+ ;; timestamp in the entry.
+ (let ((deadline (org-element-property :deadline entry)))
+ (and deadline
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-deadline)
+ (org-icalendar--vevent
+ entry deadline (concat "DL-" uid)
+ (concat "DL: " summary) loc desc cat)))
+ (let ((scheduled (org-element-property :scheduled entry)))
+ (and scheduled
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-scheduled)
+ (org-icalendar--vevent
+ entry scheduled (concat "SC-" uid)
+ (concat "S: " summary) loc desc cat)))
+ ;; When collecting plain timestamps from a headline and its
+ ;; title, skip inlinetasks since collection will happen once
+ ;; ENTRY is one of them.
+ (let ((counter 0))
+ (mapconcat
+ #'identity
+ (org-element-map (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'timestamp
+ (lambda (ts)
+ (when (let ((type (org-element-property :type ts)))
+ (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)))
+ (org-icalendar--vevent
+ entry ts uid summary loc desc cat))))
+ info nil (and (eq type 'headline) 'inlinetask))
+ ""))
+ ;; Task: First check if it is appropriate to export it. If
+ ;; so, call `org-icalendar--vtodo' to transcode it into
+ ;; a "VTODO" component.
+ (when (and todo-type
+ (case (plist-get info :icalendar-include-todo)
+ (all t)
+ (unblocked
+ (and (eq type 'headline)
+ (not (org-icalendar-blocked-headline-p
+ entry info))))
+ ((t) (eq todo-type 'todo))))
+ (org-icalendar--vtodo entry uid summary loc desc cat))
+ ;; Diary-sexp: Collect every diary-sexp element within ENTRY
+ ;; and its title, and transcode them. If ENTRY is
+ ;; a headline, skip inlinetasks: they will be handled
+ ;; separately.
+ (when org-icalendar-include-sexps
(let ((counter 0))
- (mapconcat
- #'identity
- (org-element-map (cons (org-element-property :title entry)
- (org-element-contents inside))
- 'timestamp
- (lambda (ts)
- (when (let ((type (org-element-property :type ts)))
- (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)))
- (org-icalendar--vevent
- entry ts uid summary loc desc cat))))
- info nil (and (eq type 'headline) 'inlinetask))
- ""))
- ;; Task: First check if it is appropriate to export it.
- ;; If so, call `org-icalendar--vtodo' to transcode it
- ;; into a "VTODO" component.
- (when (and todo-type
- (case (plist-get info :with-vtodo)
- (all t)
- (unblocked
- (and (eq type 'headline)
- (not (org-icalendar-blocked-headline-p
- entry info))))
- ((t) (eq todo-type 'todo))))
- (org-icalendar--vtodo entry uid summary loc desc cat))
- ;; Diary-sexp: Collect every diary-sexp element within
- ;; ENTRY and its title, and transcode them. If ENTRY is
- ;; a headline, skip inlinetasks: they will be handled
- ;; separately.
- (when org-icalendar-include-sexps
- (let ((counter 0))
- (mapconcat #'identity
- (org-element-map
- (cons (org-element-property :title entry)
- (org-element-contents inside))
- 'diary-sexp
- (lambda (sexp)
- (org-icalendar-transcode-diary-sexp
- (org-element-property :value sexp)
- (format "DS%d-%s" (incf counter) uid)
- summary))
- info nil (and (eq type 'headline) 'inlinetask))
- ""))))))
+ (mapconcat #'identity
+ (org-element-map
+ (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'diary-sexp
+ (lambda (sexp)
+ (org-icalendar-transcode-diary-sexp
+ (org-element-property :value sexp)
+ (format "DS%d-%s" (incf counter) uid)
+ summary))
+ info nil (and (eq type 'headline) 'inlinetask))
+ "")))))
;; If ENTRY is a headline, call current function on every
;; inlinetask within it. In agenda export, this is independent
;; from the mark (or lack thereof) on the entry.
@@ -678,7 +679,7 @@ Return VTODO component as a string."
(org-element-property :scheduled entry))
;; If we can't use a scheduled time for some
;; reason, start task now.
- (let ((now (decode-time (current-time))))
+ (let ((now (decode-time)))
(list 'timestamp
(list :type 'active
:minute-start (nth 1 now)
@@ -820,7 +821,8 @@ Return ICS file name."
;; links will not be collected at the end of sections.
(let ((outfile (org-export-output-file-name ".ics" subtreep)))
(org-export-to-file 'icalendar outfile
- async subtreep visible-only body-only '(:ascii-charset utf-8)
+ async subtreep visible-only body-only
+ '(:ascii-charset utf-8 :ascii-links-to-notes nil)
(lambda (file)
(run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
@@ -875,50 +877,44 @@ The file is stored under the name chosen in
(org-export-add-to-stack
(expand-file-name org-icalendar-combined-agenda-file)
'icalendar))
- `(apply 'org-icalendar--combine-files nil ',files)))
- (apply 'org-icalendar--combine-files nil (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.
This function assumes major mode for current buffer is
`org-agenda-mode'."
- (let (org-export-babel-evaluate ; Don't evaluate Babel block
- (org-icalendar-combined-agenda-file file)
- (marker-list
- ;; Collect the markers pointing to entries in the current
- ;; agenda buffer.
- (let (markers)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (let ((m (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker))))
- (and m (push m markers)))
- (beginning-of-line 2)))
- (nreverse markers))))
- (apply 'org-icalendar--combine-files
- ;; Build restriction alist.
- (let (restriction)
- ;; Sort markers in each association within RESTRICTION.
- (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
- (dolist (m marker-list restriction)
- (let* ((pos (marker-position m))
- (file (buffer-file-name
- (org-base-buffer (marker-buffer m))))
- (file-markers (assoc file restriction)))
- ;; Add POS in FILE association if one exists
- ;; or create a new association for FILE.
- (if file-markers (push pos (cdr file-markers))
- (push (list file pos) restriction))))))
- (org-agenda-files nil 'ifmode))))
-
-(defun org-icalendar--combine-files (restriction &rest files)
+ (let* ((org-export-babel-evaluate) ; Don't evaluate Babel block.
+ (contents
+ (org-export-string-as
+ (with-output-to-string
+ (save-excursion
+ (let ((p (point-min)))
+ (while (setq p (next-single-property-change p 'org-hd-marker))
+ (let ((m (get-text-property p 'org-hd-marker)))
+ (when m
+ (with-current-buffer (marker-buffer m)
+ (org-with-wide-buffer
+ (goto-char (marker-position m))
+ (princ
+ (org-element-normalize-string
+ (buffer-substring
+ (point) (progn (outline-next-heading) (point)))))))))
+ (forward-line)))))
+ 'icalendar t '(:ascii-charset utf-8 :ascii-links-to-notes nil))))
+ (with-temp-file file
+ (insert
+ (org-icalendar--vcalendar
+ org-icalendar-combined-name
+ user-full-name
+ org-icalendar-combined-description
+ (or (org-string-nw-p org-icalendar-timezone) (cadr (current-time-zone)))
+ contents)))
+ (run-hook-with-args 'org-icalendar-after-save-hook file)))
+
+(defun org-icalendar--combine-files (&rest files)
"Combine entries from multiple files into an iCalendar file.
-RESTRICTION, when non-nil, is an alist where key is a file name
-and value a list of buffer positions pointing to entries that
-should appear in the calendar. It only makes sense if the
-function was called from an agenda buffer. FILES is a list of
-files to build the calendar from."
+FILES is a list of files to build the calendar from."
(org-agenda-prepare-buffers files)
(unwind-protect
(progn
@@ -942,29 +938,12 @@ files to build the calendar from."
(catch 'nextfile
(org-check-agenda-file file)
(with-current-buffer (org-get-agenda-file-buffer file)
- (let ((marks (cdr (assoc (expand-file-name file)
- restriction))))
- ;; Create ID if necessary.
- (when org-icalendar-store-UID
- (org-icalendar-create-uid file t marks))
- (unless (and restriction (not marks))
- ;; Add a hook adding :ICALENDAR_MARK: property
- ;; to each entry appearing in agenda view.
- ;; Use `apply-partially' because the function
- ;; still has to accept one argument.
- (let ((org-export-before-processing-hook
- (cons (apply-partially
- (lambda (m-list dummy)
- (mapc (lambda (m)
- (org-entry-put
- m "ICALENDAR-MARK" "t"))
- m-list))
- (sort marks '>))
- org-export-before-processing-hook)))
- (org-export-as
- 'icalendar nil nil t
- (list :ascii-charset 'utf-8
- :icalendar-agenda-view restriction))))))))
+ ;; Create ID if necessary.
+ (when org-icalendar-store-UID
+ (org-icalendar-create-uid file t))
+ (org-export-as
+ 'icalendar nil nil t
+ '(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
files "")
;; BBDB anniversaries.
(when (and org-icalendar-include-bbdb-anniversaries
diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el
index 2c71f7d..c3eb1ea 100644
--- a/lisp/ox-latex.el
+++ b/lisp/ox-latex.el
@@ -1,6 +1,6 @@
;;; ox-latex.el --- LaTeX Back-End for Org Export Engine
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -43,8 +43,6 @@
(center-block . org-latex-center-block)
(clock . org-latex-clock)
(code . org-latex-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-latex-drawer)
(dynamic-block . org-latex-dynamic-block)
(entity . org-latex-entity)
@@ -65,13 +63,13 @@
(latex-fragment . org-latex-latex-fragment)
(line-break . org-latex-line-break)
(link . org-latex-link)
+ (node-property . org-latex-node-property)
(paragraph . org-latex-paragraph)
(plain-list . org-latex-plain-list)
(plain-text . org-latex-plain-text)
(planning . org-latex-planning)
- (property-drawer . (lambda (&rest args) ""))
+ (property-drawer . org-latex-property-drawer)
(quote-block . org-latex-quote-block)
- (quote-section . org-latex-quote-section)
(radio-target . org-latex-radio-target)
(section . org-latex-section)
(special-block . org-latex-special-block)
@@ -88,7 +86,10 @@
(timestamp . org-latex-timestamp)
(underline . org-latex-underline)
(verbatim . org-latex-verbatim)
- (verse-block . org-latex-verse-block))
+ (verse-block . org-latex-verse-block)
+ ;; 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"
@@ -99,13 +100,52 @@
(lambda (a s v b)
(if a (org-latex-export-to-pdf t s v b)
(org-open-file (org-latex-export-to-pdf nil s v b)))))))
- :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
- (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
- (:latex-header "LATEX_HEADER" nil nil newline)
- (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline)
- (:latex-hyperref-p nil "texht" org-latex-with-hyperref t)
- ;; Redefine regular options.
- (:date "DATE" nil "\\today" t)))
+ :filters-alist '((:filter-options . org-latex-math-block-options-filter)
+ (:filter-parse-tree org-latex-math-block-tree-filter
+ org-latex-matrices-tree-filter))
+ :options-alist
+ '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
+ (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
+ (:latex-header "LATEX_HEADER" nil nil newline)
+ (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline)
+ (:description "DESCRIPTION" nil nil parse)
+ (:keywords "KEYWORDS" nil nil parse)
+ (:subtitle "SUBTITLE" nil nil parse)
+ ;; Other variables.
+ (:latex-active-timestamp-format nil nil org-latex-active-timestamp-format)
+ (:latex-caption-above nil nil org-latex-caption-above)
+ (:latex-classes nil nil org-latex-classes)
+ (:latex-default-figure-position nil nil org-latex-default-figure-position)
+ (: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-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)
+ (:latex-format-inlinetask-function nil nil org-latex-format-inlinetask-function)
+ (:latex-hyperref-template nil nil org-latex-hyperref-template t)
+ (: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-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)
+ (:latex-listings nil nil org-latex-listings)
+ (:latex-listings-langs nil nil org-latex-listings-langs)
+ (:latex-listings-options nil nil org-latex-listings-options)
+ (:latex-minted-langs nil nil org-latex-minted-langs)
+ (:latex-minted-options nil nil org-latex-minted-options)
+ (:latex-prefer-user-labels nil nil org-latex-prefer-user-labels)
+ (:latex-subtitle-format nil nil org-latex-subtitle-format)
+ (:latex-subtitle-separate nil nil org-latex-subtitle-separate)
+ (:latex-table-scientific-notation nil nil org-latex-table-scientific-notation)
+ (:latex-tables-booktabs nil nil org-latex-tables-booktabs)
+ (:latex-tables-centered nil nil org-latex-tables-centered)
+ (: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)
+ ;; Redefine regular options.
+ (:date "DATE" nil "\\today" parse)))
@@ -164,11 +204,112 @@
("uk" . "ukrainian"))
"Alist between language code and corresponding Babel option.")
+(defconst org-latex-polyglossia-language-alist
+ '(("am" "amharic")
+ ("ast" "asturian")
+ ("ar" "arabic")
+ ("bo" "tibetan")
+ ("bn" "bengali")
+ ("bg" "bulgarian")
+ ("br" "breton")
+ ("bt-br" "brazilian")
+ ("ca" "catalan")
+ ("cop" "coptic")
+ ("cs" "czech")
+ ("cy" "welsh")
+ ("da" "danish")
+ ("de" "german" "german")
+ ("de-at" "german" "austrian")
+ ("de-de" "german" "german")
+ ("dv" "divehi")
+ ("el" "greek")
+ ("en" "english" "usmax")
+ ("en-au" "english" "australian")
+ ("en-gb" "english" "uk")
+ ("en-nz" "english" "newzealand")
+ ("en-us" "english" "usmax")
+ ("eo" "esperanto")
+ ("es" "spanish")
+ ("et" "estonian")
+ ("eu" "basque")
+ ("fa" "farsi")
+ ("fi" "finnish")
+ ("fr" "french")
+ ("fu" "friulan")
+ ("ga" "irish")
+ ("gd" "scottish")
+ ("gl" "galician")
+ ("he" "hebrew")
+ ("hi" "hindi")
+ ("hr" "croatian")
+ ("hu" "magyar")
+ ("hy" "armenian")
+ ("id" "bahasai")
+ ("ia" "interlingua")
+ ("is" "icelandic")
+ ("it" "italian")
+ ("kn" "kannada")
+ ("la" "latin" "modern")
+ ("la-modern" "latin" "modern")
+ ("la-classic" "latin" "classic")
+ ("la-medieval" "latin" "medieval")
+ ("lo" "lao")
+ ("lt" "lithuanian")
+ ("lv" "latvian")
+ ("mr" "maranthi")
+ ("ml" "malayalam")
+ ("nl" "dutch")
+ ("nb" "norsk")
+ ("nn" "nynorsk")
+ ("nko" "nko")
+ ("no" "norsk")
+ ("oc" "occitan")
+ ("pl" "polish")
+ ("pms" "piedmontese")
+ ("pt" "portuges")
+ ("rm" "romansh")
+ ("ro" "romanian")
+ ("ru" "russian")
+ ("sa" "sanskrit")
+ ("hsb" "usorbian")
+ ("dsb" "lsorbian")
+ ("sk" "slovak")
+ ("sl" "slovenian")
+ ("se" "samin")
+ ("sq" "albanian")
+ ("sr" "serbian")
+ ("sv" "swedish")
+ ("syr" "syriac")
+ ("ta" "tamil")
+ ("te" "telugu")
+ ("th" "thai")
+ ("tk" "turkmen")
+ ("tr" "turkish")
+ ("uk" "ukrainian")
+ ("ur" "urdu")
+ ("vi" "vietnamese"))
+ "Alist between language code and corresponding Polyglossia option")
+
+
+
(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
- ("qbordermatrix" . "\\cr")
- ("kbordermatrix" . "\\\\"))
+ ("qbordermatrix" . "\\cr")
+ ("kbordermatrix" . "\\\\"))
"Alist between matrix macros and their row ending.")
+(defconst org-latex-math-environments-re
+ (format
+ "\\`[ \t]*\\\\begin{%s\\*?}"
+ (regexp-opt
+ '("equation" "eqnarray" "math" "displaymath"
+ "align" "gather" "multline" "flalign" "alignat"
+ "xalignat" "xxalignat"
+ "subequations"
+ ;; breqn
+ "dmath" "dseries" "dgroup" "darray"
+ ;; empheq
+ "empheq")))
+ "Regexp of LaTeX math environments.")
;;; User Configurable Variables
@@ -178,6 +319,79 @@
:tag "Org Export LaTeX"
:group 'org-export)
+;;;; Generic
+
+(defcustom org-latex-caption-above '(table)
+ "When non-nil, place caption string at the beginning of elements.
+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"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "For all elements" t)
+ (const :tag "For no element" nil)
+ (set :tag "For the following elements only" :greedy t
+ (const :tag "Images" image)
+ (const :tag "Tables" table)
+ (const :tag "Source code" src-block)
+ (const :tag "Special blocks" special-block))))
+
+(defcustom org-latex-prefer-user-labels nil
+ "Use user-provided labels instead of internal ones when non-nil.
+
+When this variable is non-nil, Org will use the value of
+CUSTOM_ID property, NAME keyword or Org target as the key for the
+\\label commands generated.
+
+By default, Org generates its own internal labels during LaTeX
+export. This process ensures that the \\label keys are unique
+and valid, but it means the keys are not available in advance of
+the export process.
+
+Setting this variable gives you control over how Org generates
+labels during LaTeX export, so that you may know their keys in
+advance. One reason to do this is that it allows you to refer to
+various elements using a single label both in Org's link syntax
+and in embedded LaTeX code.
+
+For example, when this variable is non-nil, a headline like this:
+
+ ** Some section
+ :PROPERTIES:
+ :CUSTOM_ID: sec:foo
+ :END:
+ This is section [[#sec:foo]].
+ #+BEGIN_LATEX
+ And this is still section \\ref{sec:foo}.
+ #+END_LATEX
+
+will be exported to LaTeX as:
+
+ \\subsection{Some section}
+ \\label{sec:foo}
+ This is section \\ref{sec:foo}.
+ And this is still section \\ref{sec:foo}.
+
+Note, however, that setting this variable introduces a limitation
+on the possible values for CUSTOM_ID and NAME. When this
+variable is non-nil, Org passes their value to \\label unchanged.
+You are responsible for ensuring that the value is a valid LaTeX
+\\label key, and that no other \\label commands with the same key
+appear elsewhere in your document. (Keys may contain letters,
+numbers, and the following punctuation: '_' '.' '-' ':'.) There
+are no such limitations on CUSTOM_ID and NAME when this variable
+is nil.
+
+For headlines that do not define the CUSTOM_ID property or
+elements without a NAME, Org will continue to use its default
+labeling scheme to generate labels and resolve links into proper
+references."
+ :group 'org-export-latex
+ :type 'boolean
+ :version "25.1"
+ :package-version '(Org . "8.3"))
;;;; Preamble
@@ -264,11 +478,15 @@ AUTO will automatically be replaced with a coding system derived
from `buffer-file-coding-system'. See also the variable
`org-latex-inputenc-alist' for a way to influence this mechanism.
-Likewise, if your header contains \"\\usepackage[AUTO]{babel}\",
-AUTO will be replaced with the language related to the language
-code specified by `org-export-default-language', which see. Note
-that constructions such as \"\\usepackage[french,AUTO,english]{babel}\"
-are permitted.
+Likewise, if your header contains \"\\usepackage[AUTO]{babel}\"
+or \"\\usepackage[AUTO]{polyglossia}\", AUTO will be replaced
+with the language related to the language code specified by
+`org-export-default-language'. Note that constructions such as
+\"\\usepackage[french,AUTO,english]{babel}\" are permitted. For
+Polyglossia the language will be set via the macros
+\"\\setmainlanguage\" and \"\\setotherlanguage\". See also
+`org-latex-guess-babel-language' and
+`org-latex-guess-polyglossia-language'.
The sectioning structure
------------------------
@@ -328,11 +546,42 @@ are written as utf8 files."
(defcustom org-latex-title-command "\\maketitle"
"The command used to insert the title just after \\begin{document}.
-If this string contains the formatting specification \"%s\" then
-it will be used as a formatting string, passing the title as an
-argument."
+
+This format string may contain these elements:
+
+ %a for AUTHOR keyword
+ %t for TITLE keyword
+ %s for SUBTITLE keyword
+ %k for KEYWORDS line
+ %d for DESCRIPTION line
+ %c for CREATOR line
+ %l for Language keyword
+ %L for capitalized language keyword
+ %D for DATE keyword
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\".
+
+Setting :latex-title-command in publishing projects will take
+precedence over this variable."
:group 'org-export-latex
- :type 'string)
+ :type '(string :tag "Format string"))
+
+(defcustom org-latex-subtitle-format "\\\\\\medskip\n\\large %s"
+ "Format string used for transcoded subtitle.
+The format string should have at most one \"%s\"-expression,
+which is replaced with the subtitle."
+ :group 'org-export-latex
+ :version "25.1"
+ :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"
+ :package-version '(Org . "8.3")
+ :type 'boolean)
(defcustom org-latex-toc-command "\\tableofcontents\n\n"
"LaTeX command to set the table of contents, list of figures, etc.
@@ -341,10 +590,32 @@ the toc:nil option, not to those generated with #+TOC keyword."
:group 'org-export-latex
:type 'string)
-(defcustom org-latex-with-hyperref t
- "Toggle insertion of \\hypersetup{...} in the preamble."
+(defcustom org-latex-hyperref-template
+ "\\hypersetup{\n pdfauthor={%a},\n pdftitle={%t},\n pdfkeywords={%k},
+ pdfsubject={%d},\n pdfcreator={%c}, \n pdflang={%L}}\n"
+ "Template for hyperref package options.
+
+This format string may contain these elements:
+
+ %a for AUTHOR keyword
+ %t for TITLE keyword
+ %s for SUBTITLE keyword
+ %k for KEYWORDS line
+ %d for DESCRIPTION line
+ %c for CREATOR line
+ %l for Language keyword
+ %L for capitalized language keyword
+ %D for DATE keyword
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\".
+
+Setting :latex-hyperref-template in publishing projects will take
+precedence over this variable."
:group 'org-export-latex
- :type 'boolean)
+ :version "25.1"
+ :package-version '(Org . "8.3")
+ :type '(string :tag "Format string"))
;;;; Headline
@@ -352,17 +623,15 @@ the toc:nil option, not to those generated with #+TOC keyword."
'org-latex-format-headline-default-function
"Function for formatting the headline's text.
-This function will be called with 5 arguments:
-TODO the todo keyword (string or nil).
+This function will be called with six arguments:
+TODO the todo keyword (string or nil)
TODO-TYPE the type of todo (symbol: `todo', `done', nil)
PRIORITY the priority of the headline (integer or nil)
-TEXT the main headline text (string).
-TAGS the tags as a list of strings (list of strings or nil).
+TEXT the main headline text (string)
+TAGS the tags (list of strings or nil)
+INFO the export options (plist)
-The function result will be used in the section format string.
-
-Use `org-latex-format-headline-default-function' by default,
-which format headlines like for Org version prior to 8.0."
+The function result will be used in the section format string."
:group 'org-export-latex
:version "24.4"
:package-version '(Org . "8.0")
@@ -489,12 +758,14 @@ When modifying this variable, it may be useful to change
:type '(choice (const :tag "Table" table)
(const :tag "Matrix" math)
(const :tag "Inline matrix" inline-math)
- (const :tag "Verbatim" verbatim)))
+ (const :tag "Verbatim" verbatim))
+ :safe (lambda (s) (memq s '(table math inline-math verbatim))))
(defcustom org-latex-tables-centered t
"When non-nil, tables are exported in a center environment."
:group 'org-export-latex
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-latex-tables-booktabs nil
"When non-nil, display tables in a formal \"booktabs\" style.
@@ -505,13 +776,8 @@ attributes."
:group 'org-export-latex
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
-
-(defcustom org-latex-table-caption-above t
- "When non-nil, place caption string at the beginning of the table.
-Otherwise, place it near the end."
- :group 'org-export-latex
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-latex-table-scientific-notation "%s\\,(%s)"
"Format string to display numbers in scientific notation.
@@ -526,11 +792,10 @@ When nil, no transformation is made."
(string :tag "Format string")
(const :tag "No formatting" nil)))
-
;;;; Text markup
(defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}")
- (code . verb)
+ (code . protectedtexttt)
(italic . "\\emph{%s}")
(strike-through . "\\sout{%s}")
(underline . "\\uline{%s}")
@@ -550,6 +815,8 @@ 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"
+ :package-version '(Org . "8.3")
:type 'alist
:options '(bold code italic strike-through underline verbatim))
@@ -575,44 +842,24 @@ The default function simply returns the value of CONTENTS."
;;;; Inlinetasks
-(defcustom org-latex-format-inlinetask-function 'ignore
+(defcustom org-latex-format-inlinetask-function
+ 'org-latex-format-inlinetask-default-function
"Function called to format an inlinetask in LaTeX code.
-The function must accept six parameters:
- TODO the todo keyword, as a string
- TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
- PRIORITY the inlinetask priority, as a string
- NAME the inlinetask name, as a string.
- TAGS the inlinetask tags, as a list of strings.
- CONTENTS the contents of the inlinetask, as a string.
-
-The function should return the string to be exported.
+The function must accept seven parameters:
+ TODO the todo keyword (string or nil)
+ TODO-TYPE the todo type (symbol: `todo', `done', nil)
+ PRIORITY the inlinetask priority (integer or nil)
+ NAME the inlinetask name (string)
+ TAGS the inlinetask tags (list of strings or nil)
+ CONTENTS the contents of the inlinetask (string or nil)
+ INFO the export options (plist)
-For example, the variable could be set to the following function
-in order to mimic default behaviour:
-
-\(defun org-latex-format-inlinetask \(todo type priority name tags contents\)
-\"Format an inline task element for LaTeX export.\"
- \(let ((full-title
- \(concat
- \(when todo
- \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo))
- \(when priority (format \"\\\\framebox{\\\\#%c} \" priority))
- title
- \(when tags
- \(format \"\\\\hfill{}\\\\textsc{:%s:}\"
- \(mapconcat 'identity tags \":\")))))
- \(format (concat \"\\\\begin{center}\\n\"
- \"\\\\fbox{\\n\"
- \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
- \"%s\\n\\n\"
- \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
- \"%s\"
- \"\\\\end{minipage}}\"
- \"\\\\end{center}\")
- full-title contents))"
+The function should return the string to be exported."
:group 'org-export-latex
- :type 'function)
+ :type 'function
+ :version "25.1"
+ :package-version '(Org . "8.3"))
;; Src blocks
@@ -640,7 +887,7 @@ the minted package to `org-latex-packages-alist', for example
using customize, or with
\(require 'ox-latex)
- \(add-to-list 'org-latex-packages-alist '(\"\" \"minted\"))
+ \(add-to-list 'org-latex-packages-alist '(\"newfloat\" \"minted\"))
In addition, it is necessary to install pygments
\(http://pygments.org), and to configure the variable
@@ -656,7 +903,8 @@ into previewing problems, please consult
:type '(choice
(const :tag "Use listings" t)
(const :tag "Use minted" minted)
- (const :tag "Export verbatim" nil)))
+ (const :tag "Export verbatim" nil))
+ :safe (lambda (s) (memq s '(t nil minted))))
(defcustom org-latex-listings-langs
'((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
@@ -668,7 +916,8 @@ into previewing problems, please consult
(shell-script "bash")
(gnuplot "Gnuplot")
(ocaml "Caml") (caml "Caml")
- (sql "SQL") (sqlite "sql"))
+ (sql "SQL") (sqlite "sql")
+ (makefile "make"))
"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
@@ -676,6 +925,8 @@ parameter for the listings package. If the mode name and the
listings name are the same, the language does not need an entry
in this list - but it does not hurt if it is present."
:group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.3")
:type '(repeat
(list
(symbol :tag "Major mode ")
@@ -697,7 +948,13 @@ will typeset the code in a small size font with underlined, bold
black keywords.
Note that the same options will be applied to blocks of all
-languages."
+languages. If you need block-specific options, you may use the
+following syntax:
+
+ #+ATTR_LATEX: :options key1=value1,key2=value2
+ #+BEGIN_SRC <LANG>
+ ...
+ #+END_SRC"
:group 'org-export-latex
:type '(repeat
(list
@@ -744,7 +1001,13 @@ will result in src blocks being exported with
\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
as the start of the minted environment. Note that the same
-options will be applied to blocks of all languages."
+options will be applied to blocks of all languages. If you need
+block-specific options, you may use the following syntax:
+
+ #+ATTR_LATEX: :options key1=value1,key2=value2
+ #+BEGIN_SRC <LANG>
+ ...
+ #+END_SRC"
:group 'org-export-latex
:type '(repeat
(list
@@ -840,11 +1103,14 @@ file name as its single argument."
(function)))
(defcustom org-latex-logfiles-extensions
- '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
+ '("aux" "bcf" "blg" "fdb_latexmk" "fls" "figlist" "idx" "log" "nav" "out"
+ "ptc" "run.xml" "snm" "toc" "vrb" "xdv")
"The list of file extensions to consider as LaTeX logfiles.
-The logfiles will be remove if `org-latex-remove-logfiles' is
+The logfiles will be removed if `org-latex-remove-logfiles' is
non-nil."
:group 'org-export-latex
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type '(repeat (string :tag "Extension")))
(defcustom org-latex-remove-logfiles t
@@ -855,19 +1121,20 @@ logfiles to remove, set `org-latex-logfiles-extensions'."
:group 'org-export-latex
:type 'boolean)
-(defcustom org-latex-known-errors
- '(("Reference.*?undefined" . "[undefined reference]")
- ("Citation.*?undefined" . "[undefined citation]")
- ("Undefined control sequence" . "[undefined control sequence]")
- ("^! LaTeX.*?Error" . "[LaTeX error]")
- ("^! Package.*?Error" . "[package error]")
- ("Runaway argument" . "Runaway argument"))
+(defcustom org-latex-known-warnings
+ '(("Reference.*?undefined" . "[undefined reference]")
+ ("Runaway argument" . "[runaway argument]")
+ ("Underfull \\hbox" . "[underfull hbox]")
+ ("Overfull \\hbox" . "[overfull hbox]")
+ ("Citation.*?undefined" . "[undefined citation]")
+ ("Undefined control sequence" . "[undefined control sequence]"))
"Alist of regular expressions and associated messages for the user.
-The regular expressions are used to find possible errors in the
-log of a latex-run."
+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 "24.4"
- :package-version '(Org . "8.0")
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type '(repeat
(cons
(string :tag "Regexp")
@@ -877,6 +1144,54 @@ log of a latex-run."
;;; Internal Functions
+(defun org-latex--caption-above-p (element info)
+ "Non nil when caption is expected to be located above ELEMENT.
+INFO is a plist holding contextual information."
+ (let ((above (plist-get info :latex-caption-above)))
+ (if (symbolp above) above
+ (let ((type (org-element-type element)))
+ (memq (if (eq type 'link) 'image type) above)))))
+
+(defun org-latex--label (datum info &optional force full)
+ "Return an appropriate label for DATUM.
+DATUM is an element or a `target' type object. INFO is the
+current export state, as a plist.
+
+Return nil if element DATUM has no NAME or VALUE affiliated
+keyword or no CUSTOM_ID property, unless FORCE is non-nil. In
+this case always return a unique label.
+
+Eventually, if FULL is non-nil, wrap label within \"\\label{}\"."
+ (let* ((type (org-element-type datum))
+ (user-label
+ (org-element-property
+ (case type
+ ((headline inlinetask) :CUSTOM_ID)
+ (target :value)
+ (otherwise :name))
+ datum))
+ (label
+ (and (or user-label force)
+ (if (and user-label (plist-get info :latex-prefer-user-labels))
+ user-label
+ (concat (case type
+ (headline "sec:")
+ (table "tab:")
+ (latex-environment
+ (and (org-string-match-p
+ org-latex-math-environments-re
+ (org-element-property :value datum))
+ "eq:"))
+ (paragraph
+ (and (org-element-property :caption datum)
+ "fig:")))
+ (org-export-get-reference datum info))))))
+ (cond ((not full) label)
+ (label (format "\\label{%s}%s"
+ label
+ (if (eq type 'target) "" "\n")))
+ (t ""))))
+
(defun org-latex--caption/label-string (element info)
"Return caption and label LaTeX string for ELEMENT.
@@ -884,25 +1199,39 @@ INFO is a plist holding contextual information. If there's no
caption nor label, return the empty string.
For non-floats, see `org-latex--wrap-label'."
- (let* ((label (org-element-property :name element))
- (label-str (if (not (org-string-nw-p label)) ""
- (format "\\label{%s}"
- (org-export-solidify-link-text label))))
+ (let* ((label (org-latex--label element info nil t))
(main (org-export-get-caption element))
+ (attr (org-export-read-attribute :attr_latex element))
+ (type (org-element-type element))
+ (nonfloat (or (and (plist-member attr :float)
+ (not (plist-get attr :float))
+ main)
+ (and (eq type 'src-block)
+ (not (plist-get attr :float))
+ (memq (plist-get info :latex-listings)
+ '(nil minted)))))
(short (org-export-get-caption element t))
- (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption)))
+ (caption-from-attr-latex (plist-get attr :caption)))
(cond
((org-string-nw-p caption-from-attr-latex)
(concat caption-from-attr-latex "\n"))
- ((and (not main) (equal label-str "")) "")
- ((not main) (concat label-str "\n"))
+ ((and (not main) (equal label "")) "")
+ ((not main) (concat label "\n"))
;; Option caption format with short name.
- (short (format "\\caption[%s]{%s%s}\n"
- (org-export-data short info)
- label-str
- (org-export-data main info)))
- ;; Standard caption format.
- (t (format "\\caption{%s%s}\n" label-str (org-export-data main info))))))
+ (t
+ (format (if nonfloat "\\captionof{%s}%s{%s%s}\n"
+ "\\caption%s%s{%s%s}\n")
+ (if nonfloat
+ (case type
+ (paragraph "figure")
+ (src-block (if (plist-get info :latex-listings)
+ "listing"
+ "figure"))
+ (t (symbol-name type)))
+ "")
+ (if short (format "[%s]" (org-export-data short info)) "")
+ label
+ (org-export-data main info))))))
(defun org-latex-guess-inputenc (header)
"Set the coding system in inputenc to what the buffer is.
@@ -958,6 +1287,59 @@ Return the new header."
", ")
t nil header 1)))))
+(defun org-latex-guess-polyglossia-language (header info)
+ "Set the Polyglossia language according to the LANGUAGE keyword.
+
+HEADER is the LaTeX header string. INFO is the plist used as
+a communication channel.
+
+Insertion of guessed language only happens when the Polyglossia
+package has been explicitly loaded.
+
+The argument to Polyglossia may be \"AUTO\" which is then
+replaced with the language of the document or
+`org-export-default-language'. Note, the language is really set
+using \setdefaultlanguage and not as an option to the package.
+
+Return the new header."
+ (let ((language (plist-get info :language)))
+ ;; If no language is set or Polyglossia is not loaded, return
+ ;; HEADER as-is.
+ (if (or (not (stringp language))
+ (not (string-match
+ "\\\\usepackage\\(?:\\[\\([^]]+?\\)\\]\\){polyglossia}\n"
+ header)))
+ header
+ (let* ((options (org-string-nw-p (match-string 1 header)))
+ (languages (and options
+ ;; Reverse as the last loaded language is
+ ;; the main language.
+ (nreverse
+ (delete-dups
+ (save-match-data
+ (org-split-string
+ (replace-regexp-in-string
+ "AUTO" language options t)
+ ",[ \t]*"))))))
+ (main-language-set
+ (string-match-p "\\\\setmainlanguage{.*?}" header)))
+ (replace-match
+ (concat "\\usepackage{polyglossia}\n"
+ (mapconcat
+ (lambda (l)
+ (let ((l (or (assoc l org-latex-polyglossia-language-alist)
+ l)))
+ (format (if main-language-set "\\setotherlanguage%s{%s}\n"
+ (setq main-language-set t)
+ "\\setmainlanguage%s{%s}\n")
+ (if (and (consp l) (= (length l) 3))
+ (format "[variant=%s]" (nth 2 l))
+ "")
+ (nth 1 l))))
+ languages
+ ""))
+ t t header 0)))))
+
(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."
@@ -978,52 +1360,50 @@ nil."
options
","))
-(defun org-latex--wrap-label (element output)
+(defun org-latex--wrap-label (element output info)
"Wrap label associated to ELEMENT around OUTPUT, if appropriate.
-This function shouldn't be used for floats. See
+INFO is the current export state, as a plist. This function
+should not be used for floats. See
`org-latex--caption/label-string'."
- (let ((label (org-element-property :name element)))
- (if (not (and (org-string-nw-p output) (org-string-nw-p label))) output
- (concat (format "\\label{%s}\n" (org-export-solidify-link-text label))
- output))))
-
-(defun org-latex--text-markup (text markup)
+ (if (not (and (org-string-nw-p output) (org-element-property :name element)))
+ output
+ (concat (format "\\phantomsection\n\\label{%s}\n"
+ (org-latex--label element info))
+ output)))
+
+(defun org-latex--protect-text (text)
+ "Protect special characters in string TEXT and return it."
+ (replace-regexp-in-string
+ "--\\|[\\{}$%&_#~^]"
+ (lambda (m)
+ (cond ((equal m "--") "-{}-")
+ ((equal m "\\") "\\textbackslash{}")
+ ((equal m "~") "\\textasciitilde{}")
+ ((equal m "^") "\\textasciicircum{}")
+ (t (concat "\\" m))))
+ text nil t))
+
+(defun org-latex--text-markup (text markup info)
"Format TEXT depending on MARKUP text markup.
-See `org-latex-text-markup-alist' for details."
- (let ((fmt (cdr (assq markup org-latex-text-markup-alist))))
- (cond
- ;; No format string: Return raw text.
- ((not fmt) text)
- ;; Handle the `verb' special case: Find and appropriate separator
- ;; and use "\\verb" command.
- ((eq 'verb fmt)
- (let ((separator (org-latex--find-verb-separator text)))
- (concat "\\verb" separator
- (replace-regexp-in-string "\n" " " text)
- separator)))
- ;; Handle the `protectedtexttt' special case: Protect some
- ;; special chars and use "\texttt{%s}" format string.
- ((eq 'protectedtexttt fmt)
- (let ((start 0)
- (trans '(("\\" . "\\textbackslash{}")
- ("~" . "\\textasciitilde{}")
- ("^" . "\\textasciicircum{}")))
- (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 (or (cdr (assoc char trans)) (concat "\\" char))
- rtn (concat rtn char)))
- (setq text (concat rtn text)
- fmt "\\texttt{%s}")
- (while (string-match "--" text)
- (setq text (replace-match "-{}-" t t text)))
- (format fmt text)))
- ;; Else use format string.
- (t (format fmt text)))))
+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
+ ;; No format string: Return raw text.
+ ((nil) text)
+ ;; Handle the `verb' special case: Find an appropriate separator
+ ;; and use "\\verb" command.
+ (verb
+ (let ((separator (org-latex--find-verb-separator text)))
+ (concat "\\verb" separator
+ (replace-regexp-in-string "\n" " " text)
+ separator)))
+ ;; Handle the `protectedtexttt' special case: Protect some
+ ;; special chars and use "\texttt{%s}" format string.
+ (protectedtexttt
+ (format "\\texttt{%s}" (org-latex--protect-text text)))
+ ;; Else use format string.
+ (t (format fmt text)))))
(defun org-latex--delayed-footnotes-definitions (element info)
"Return footnotes definitions in ELEMENT as a string.
@@ -1065,6 +1445,57 @@ just outside of it."
(funcall search-refs element))
""))
+(defun org-latex--translate (s info)
+ "Translate string S according to specified language.
+INFO is a plist used as a communication channel."
+ (org-export-translate s :latex info))
+
+(defun org-latex--format-spec (info)
+ "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))
+ lang))))
+ `((?a . ,(org-export-data (plist-get info :author) info))
+ (?t . ,(org-export-data (plist-get info :title) info))
+ (?k . ,(org-export-data (org-latex--wrap-latex-math-block
+ (plist-get info :keywords) info)
+ info))
+ (?d . ,(org-export-data (org-latex--wrap-latex-math-block
+ (plist-get info :description) info)
+ info))
+ (?c . ,(plist-get info :creator))
+ (?l . ,language)
+ (?L . ,(capitalize language))
+ (?D . ,(org-export-get-date info)))))
+
+(defun org-latex--make-header (info)
+ "Return a formatted LaTeX header.
+INFO is a plist used as a communication channel."
+ (let* ((class (plist-get info :latex-class))
+ (class-options (plist-get info :latex-class-options))
+ (header (nth 1 (assoc class (plist-get info :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-polyglossia-language
+ (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))
+ (plist-get info :latex-header-extra)))))
+ info)
+ info))))
;;; Template
@@ -1073,34 +1504,14 @@ just outside of it."
"Return complete document string after LaTeX conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- (let ((title (org-export-data (plist-get info :title) info)))
+ (let ((title (org-export-data (plist-get info :title) info))
+ (spec (org-latex--format-spec info)))
(concat
;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
;; 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))
- (plist-get info :latex-header-extra)))))
- info)))
+ (org-latex--make-header info)
;; Possibly limit depth for headline numbering.
(let ((sec-num (plist-get info :section-numbers)))
(when (integerp sec-num)
@@ -1117,40 +1528,46 @@ holding export options."
;; Date.
(let ((date (and (plist-get info :with-date) (org-export-get-date info))))
(format "\\date{%s}\n" (org-export-data date info)))
- ;; Title
- (format "\\title{%s}\n" title)
+ ;; Title and subtitle.
+ (let* ((subtitle (plist-get info :subtitle))
+ (formatted-subtitle
+ (when subtitle
+ (format (plist-get info :latex-subtitle-format)
+ (org-export-data subtitle info))))
+ (separate (plist-get info :latex-subtitle-separate)))
+ (concat
+ (format "\\title{%s%s}\n" title
+ (if separate "" (or formatted-subtitle "")))
+ (when (and separate subtitle)
+ (concat formatted-subtitle "\n"))))
;; Hyperref options.
- (when (plist-get info :latex-hyperref-p)
- (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
- (or (plist-get info :keywords) "")
- (or (plist-get info :description) "")
- (if (not (plist-get info :with-creator)) ""
- (plist-get info :creator))))
+ (let ((template (plist-get info :latex-hyperref-template)))
+ (and (stringp template)
+ (format-spec template spec)))
;; Document start.
"\\begin{document}\n\n"
;; Title command.
- (org-element-normalize-string
- (cond ((string= "" title) nil)
- ((not (stringp org-latex-title-command)) nil)
- ((string-match "\\(?:[^%]\\|^\\)%s"
- org-latex-title-command)
- (format org-latex-title-command title))
- (t org-latex-title-command)))
+ (let* ((title-command (plist-get info :latex-title-command))
+ (command (and (stringp title-command)
+ (format-spec title-command spec))))
+ (org-element-normalize-string
+ (cond ((not (plist-get info :with-title)) nil)
+ ((string= "" title) nil)
+ ((not (stringp command)) nil)
+ ((string-match "\\(?:[^%]\\|^\\)%s" command)
+ (format command title))
+ (t command))))
;; Table of contents.
(let ((depth (plist-get info :with-toc)))
(when depth
(concat (when (wholenump depth)
(format "\\setcounter{tocdepth}{%d}\n" depth))
- org-latex-toc-command)))
+ (plist-get info :latex-toc-command))))
;; Document's body.
contents
;; Creator.
- (let ((creator-info (plist-get info :with-creator)))
- (cond
- ((not creator-info) "")
- ((eq creator-info 'comment)
- (format "%% %s\n" (plist-get info :creator)))
- (t (concat (plist-get info :creator) "\n"))))
+ (and (plist-get info :with-creator)
+ (concat (plist-get info :creator) "\n"))
;; Document end.
"\\end{document}")))
@@ -1164,7 +1581,7 @@ holding export options."
"Transcode BOLD from Org to LaTeX.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
- (org-latex--text-markup contents 'bold))
+ (org-latex--text-markup contents 'bold info))
;;;; Center Block
@@ -1174,8 +1591,7 @@ contextual information."
CONTENTS holds the contents of the center block. INFO is a plist
holding contextual information."
(org-latex--wrap-label
- center-block
- (format "\\begin{center}\n%s\\end{center}" contents)))
+ center-block (format "\\begin{center}\n%s\\end{center}" contents) info))
;;;; Clock
@@ -1187,10 +1603,8 @@ information."
(concat
"\\noindent"
(format "\\textbf{%s} " org-clock-string)
- (format org-latex-inactive-timestamp-format
- (concat (org-translate-time
- (org-element-property :raw-value
- (org-element-property :value clock)))
+ (format (plist-get info :latex-inactive-timestamp-format)
+ (concat (org-timestamp-translate (org-element-property :value clock))
(let ((time (org-element-property :duration clock)))
(and time (format " (%s)" time)))))
"\\\\"))
@@ -1202,7 +1616,7 @@ information."
"Transcode a CODE object from Org to LaTeX.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (org-latex--text-markup (org-element-property :value code) 'code))
+ (org-latex--text-markup (org-element-property :value code) 'code info))
;;;; Drawer
@@ -1212,9 +1626,9 @@ channel."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((name (org-element-property :drawer-name drawer))
- (output (funcall org-latex-format-drawer-function
+ (output (funcall (plist-get info :latex-format-drawer-function)
name contents)))
- (org-latex--wrap-label drawer output)))
+ (org-latex--wrap-label drawer output info)))
;;;; Dynamic Block
@@ -1223,7 +1637,7 @@ holding contextual information."
"Transcode a DYNAMIC-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
- (org-latex--wrap-label dynamic-block contents))
+ (org-latex--wrap-label dynamic-block contents info))
;;;; Entity
@@ -1232,8 +1646,7 @@ holding contextual information. See `org-export-data'."
"Transcode an ENTITY object from Org to LaTeX.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
- (let ((ent (org-element-property :latex entity)))
- (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent)))
+ (org-element-property :latex entity))
;;;; Example Block
@@ -1243,10 +1656,16 @@ contextual information."
CONTENTS is nil. INFO is a plist holding contextual
information."
(when (org-string-nw-p (org-element-property :value example-block))
- (org-latex--wrap-label
- example-block
- (format "\\begin{verbatim}\n%s\\end{verbatim}"
- (org-export-format-code-default example-block info)))))
+ (let ((environment (or (org-export-read-attribute
+ :attr_latex example-block :environment)
+ "verbatim")))
+ (org-latex--wrap-label
+ example-block
+ (format "\\begin{%s}\n%s\\end{%s}"
+ environment
+ (org-export-format-code-default example-block info)
+ environment)
+ info))))
;;;; Export Block
@@ -1276,7 +1695,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
fixed-width
(format "\\begin{verbatim}\n%s\\end{verbatim}"
(org-remove-indentation
- (org-element-property :value fixed-width)))))
+ (org-element-property :value fixed-width)))
+ info))
;;;; Footnote Reference
@@ -1288,7 +1708,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; 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)
- org-latex-footnote-separator))
+ (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))
@@ -1296,9 +1716,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(org-export-get-footnote-number footnote-reference info)))
;; Use \footnotemark if reference is within another footnote
;; reference, footnote definition or table cell.
- ((loop for parent in (org-export-get-genealogy footnote-reference)
- thereis (memq (org-element-type parent)
- '(footnote-reference footnote-definition table-cell)))
+ ((org-element-lineage footnote-reference
+ '(footnote-reference footnote-definition table-cell))
"\\footnotemark")
;; Otherwise, define it with \footnote command.
(t
@@ -1321,7 +1740,7 @@ holding contextual information."
(let* ((class (plist-get info :latex-class))
(level (org-export-get-relative-level headline info))
(numberedp (org-export-numbered-headline-p headline info))
- (class-sectioning (assoc class org-latex-classes))
+ (class-sectioning (assoc class (plist-get info :latex-classes)))
;; Section formatting will set two placeholders: one for
;; the title and the other for the contents.
(section-fmt
@@ -1365,16 +1784,12 @@ holding contextual information."
(org-element-property :priority headline)))
;; Create the headline text along with a no-tag version.
;; The latter is required to remove tags from toc.
- (full-text (funcall org-latex-format-headline-function
- todo todo-type priority text tags))
+ (full-text (funcall (plist-get info :latex-format-headline-function)
+ todo todo-type priority text tags info))
;; Associate \label to the headline for internal links.
- (headline-label
- (format "\\label{sec-%s}\n"
- (mapconcat 'number-to-string
- (org-export-get-headline-number headline info)
- "-")))
+ (headline-label (org-latex--label headline info t t))
(pre-blanks
- (make-string (org-element-property :pre-blank headline) 10)))
+ (make-string (org-element-property :pre-blank headline) ?\n)))
(if (or (not section-fmt) (org-export-low-level-p headline info))
;; This is a deep sub-tree: export it as a list item. Also
;; export as items headlines for which no section format has
@@ -1404,15 +1819,32 @@ holding contextual information."
;; an alternative heading when possible, and when this is not
;; identical to the usual heading.
(let ((opt-title
- (funcall org-latex-format-headline-function
+ (funcall (plist-get info :latex-format-headline-function)
todo todo-type priority
(org-export-data-with-backend
(org-export-get-alt-title headline info)
section-back-end info)
- (and (eq (plist-get info :with-tags) t) tags))))
- (if (and numberedp opt-title
+ (and (eq (plist-get info :with-tags) t) tags)
+ info))
+ ;; Maybe end local TOC (see `org-latex-keyword').
+ (contents
+ (concat
+ contents
+ (let ((case-fold-search t)
+ (section
+ (let ((first (car (org-element-contents headline))))
+ (and (eq (org-element-type first) 'section) first))))
+ (org-element-map section 'keyword
+ (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)
+ (format "\\stopcontents[level-%d]" level)))))
+ info t)))))
+ (if (and opt-title
(not (equal opt-title full-text))
- (string-match "\\`\\\\\\(.*?[^*]\\){" section-fmt))
+ (string-match "\\`\\\\\\(.+?\\){" section-fmt))
(format (replace-match "\\1[%s]" nil nil section-fmt 1)
;; Replace square brackets with parenthesis
;; since square brackets are not supported in
@@ -1427,7 +1859,7 @@ holding contextual information."
(concat headline-label pre-blanks contents))))))))
(defun org-latex-format-headline-default-function
- (todo todo-type priority text tags)
+ (todo todo-type priority text tags info)
"Default format function for a headline.
See `org-latex-format-headline-function' for details."
(concat
@@ -1435,7 +1867,9 @@ See `org-latex-format-headline-function' for details."
(and priority (format "\\framebox{\\#%c} " priority))
text
(and tags
- (format "\\hfill{}\\textsc{%s}" (mapconcat 'identity tags ":")))))
+ (format "\\hfill{}\\textsc{%s}"
+ (mapconcat (lambda (tag) (org-latex-plain-text tag info))
+ tags ":")))))
;;;; Horizontal Rule
@@ -1456,7 +1890,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
horizontal-rule
(format "\\rule{%s}{%s}"
(or (plist-get attr :width) "\\linewidth")
- (or (plist-get attr :thickness) "0.5pt"))))))
+ (or (plist-get attr :thickness) "0.5pt"))
+ info))))
;;;; Inline Src Block
@@ -1467,34 +1902,33 @@ 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)))
- (cond
- ;; Do not use a special package: transcode it verbatim.
- ((not org-latex-listings)
- (concat "\\verb" separator code separator))
- ;; Use minted package.
- ((eq org-latex-listings 'minted)
- (let* ((org-lang (org-element-property :language inline-src-block))
- (mint-lang (or (cadr (assq (intern org-lang)
- org-latex-minted-langs))
- (downcase org-lang)))
- (options (org-latex--make-option-string
- org-latex-minted-options)))
- (concat (format "\\mint%s{%s}"
- (if (string= options "") "" (format "[%s]" options))
- mint-lang)
- separator code separator)))
- ;; Use listings package.
- (t
- ;; Maybe translate language's name.
- (let* ((org-lang (org-element-property :language inline-src-block))
- (lst-lang (or (cadr (assq (intern org-lang)
- org-latex-listings-langs))
- org-lang))
- (options (org-latex--make-option-string
- (append org-latex-listings-options
- `(("language" ,lst-lang))))))
- (concat (format "\\lstinline[%s]" options)
- separator code separator))))))
+ (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.
+ (minted
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (mint-lang (or (cadr (assq (intern org-lang)
+ (plist-get info :latex-minted-langs)))
+ (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)))
+ ;; Use listings package.
+ (otherwise
+ ;; Maybe translate language's name.
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (lst-lang (or (cadr (assq (intern org-lang)
+ (plist-get info :latex-listings-langs)))
+ org-lang))
+ (options (org-latex--make-option-string
+ (append (plist-get info :latex-listings-options)
+ `(("language" ,lst-lang))))))
+ (concat (format "\\lstinline[%s]" options)
+ separator code separator))))))
;;;; Inlinetask
@@ -1511,31 +1945,33 @@ holding contextual information."
(tags (and (plist-get info :with-tags)
(org-export-get-tags inlinetask info)))
(priority (and (plist-get info :with-priority)
- (org-element-property :priority inlinetask))))
- ;; If `org-latex-format-inlinetask-function' is provided, call it
- ;; with appropriate arguments.
- (if (not (eq org-latex-format-inlinetask-function 'ignore))
- (funcall org-latex-format-inlinetask-function
- todo todo-type priority title tags contents)
- ;; Otherwise, use a default template.
- (org-latex--wrap-label
- inlinetask
- (let ((full-title
- (concat
- (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
- (when priority (format "\\framebox{\\#%c} " priority))
- title
- (when tags (format "\\hfill{}\\textsc{:%s:}"
- (mapconcat #'identity tags ":"))))))
- (concat "\\begin{center}\n"
- "\\fbox{\n"
- "\\begin{minipage}[c]{.6\\textwidth}\n"
- full-title "\n\n"
- (and (org-string-nw-p contents)
- (concat "\\rule[.8em]{\\textwidth}{2pt}\n\n" contents))
- "\\end{minipage}\n"
- "}\n"
- "\\end{center}"))))))
+ (org-element-property :priority inlinetask)))
+ (contents (concat (org-latex--label inlinetask info) contents)))
+ (funcall (plist-get info :latex-format-inlinetask-function)
+ todo todo-type priority title tags contents info)))
+
+(defun org-latex-format-inlinetask-default-function
+ (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
+ (concat (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
+ (when priority (format "\\framebox{\\#%c} " priority))
+ title
+ (when tags
+ (format "\\hfill{}\\textsc{:%s:}"
+ (mapconcat
+ (lambda (tag) (org-latex-plain-text tag info))
+ tags ":"))))))
+ (concat "\\begin{center}\n"
+ "\\fbox{\n"
+ "\\begin{minipage}[c]{.6\\textwidth}\n"
+ full-title "\n\n"
+ (and (org-string-nw-p contents)
+ (concat "\\rule[.8em]{\\textwidth}{2pt}\n\n" contents))
+ "\\end{minipage}\n"
+ "}\n"
+ "\\end{center}")))
;;;; Italic
@@ -1544,7 +1980,7 @@ holding contextual information."
"Transcode ITALIC from Org to LaTeX.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
- (org-latex--text-markup contents 'italic))
+ (org-latex--text-markup contents 'italic info))
;;;; Item
@@ -1621,24 +2057,31 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string= key "LATEX") value)
((string= key "INDEX") (format "\\index{%s}" value))
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (concat
- (when (wholenump depth)
- (format "\\setcounter{tocdepth}{%s}\n" depth))
- "\\tableofcontents")))
- ((string= "tables" value) "\\listoftables")
- ((string= "listings" value)
- (cond
- ((eq org-latex-listings 'minted) "\\listoflistings")
- (org-latex-listings "\\lstlistoflistings")
- ;; At the moment, src blocks with a caption are wrapped
- ;; into a figure environment.
- (t "\\listoffigures")))))))))
+ ((org-string-match-p "\\<headlines\\>" value)
+ (let* ((localp (org-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)))
+ (depth
+ (and (string-match "\\<[0-9]+\\>" value)
+ (format
+ "\\setcounter{tocdepth}{%d}"
+ (+ (string-to-number (match-string 0 value)) level)))))
+ (if (and localp parent)
+ ;; Start local TOC, assuming package "titletoc" is
+ ;; required.
+ (format "\\startcontents[level-%d]
+\\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)
+ ((nil) "\\listoffigures")
+ (minted "\\listoflistings")
+ (otherwise "\\lstlistoflistings")))))))))
;;;; Latex Environment
@@ -1647,10 +2090,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a LATEX-ENVIRONMENT element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (plist-get info :with-latex)
- (let ((label (org-element-property :name latex-environment))
- (value (org-remove-indentation
+ (let ((value (org-remove-indentation
(org-element-property :value latex-environment))))
- (if (not (org-string-nw-p label)) value
+ (if (not (org-element-property :name latex-environment)) value
;; Environment is labeled: label must be within the environment
;; (otherwise, a reference pointing to that element will count
;; the section instead).
@@ -1658,8 +2100,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(insert value)
(goto-char (point-min))
(forward-line)
- (insert
- (format "\\label{%s}\n" (org-export-solidify-link-text label)))
+ (insert (org-latex--label latex-environment info nil t))
(buffer-string))))))
@@ -1668,8 +2109,14 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(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."
- (when (plist-get info :with-latex)
- (org-element-property :value latex-fragment)))
+ (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))
+ (t value))))
;;;; Line Break
@@ -1692,36 +2139,41 @@ used as a communication channel."
(expand-file-name raw-path))))
(filetype (file-name-extension path))
(caption (org-latex--caption/label-string parent info))
+ (caption-above-p (org-latex--caption-above-p link info))
;; Retrieve latex attributes from the element around.
(attr (org-export-read-attribute :attr_latex parent))
(float (let ((float (plist-get attr :float)))
- (cond ((and (not float) (plist-member attr :float)) nil)
- ((string= float "wrap") 'wrap)
+ (cond ((string= float "wrap") 'wrap)
+ ((string= float "sideways") 'sideways)
((string= float "multicolumn") 'multicolumn)
((or float
(org-element-property :caption parent)
(org-string-nw-p (plist-get attr :caption)))
- 'figure))))
+ (if (and (plist-member attr :float) (not float))
+ 'nonfloat
+ 'figure))
+ ((and (not float) (plist-member attr :float)) nil))))
(placement
(let ((place (plist-get attr :placement)))
- (cond (place (format "%s" place))
- ((eq float 'wrap) "{l}{0.5\\textwidth}")
- ((eq float 'figure)
- (format "[%s]" org-latex-default-figure-position))
- (t ""))))
+ (cond
+ (place (format "%s" place))
+ ((eq float 'wrap) "{l}{0.5\\textwidth}")
+ ((eq float 'figure)
+ (format "[%s]" (plist-get info :latex-default-figure-position)))
+ (t ""))))
(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.
(width (cond ((plist-get attr :width))
((plist-get attr :height) "")
((eq float 'wrap) "0.48\\textwidth")
- (t org-latex-image-default-width)))
+ (t (plist-get info :latex-image-default-width))))
(height (cond ((plist-get attr :height))
((or (plist-get attr :width)
(memq float '(figure wrap))) "")
- (t org-latex-image-default-height)))
+ (t (plist-get info :latex-image-default-height))))
(options (let ((opt (or (plist-get attr :options)
- org-latex-image-default-option)))
+ (plist-get info :latex-image-default-option))))
(if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt
(match-string 1 opt))))
image-code)
@@ -1750,6 +2202,12 @@ used as a communication channel."
(setq options (concat options ",width=" width)))
(when (org-string-nw-p height)
(setq options (concat options ",height=" height)))
+ (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)))
+ (setq options (concat options ",page=" search-option))))
(setq image-code
(format "\\includegraphics%s{%s}"
(cond ((not (org-string-nw-p options)) "")
@@ -1769,17 +2227,43 @@ used as a communication channel."
;; Return proper string, depending on FLOAT.
(case float
(wrap (format "\\begin{wrapfigure}%s
-\\centering
+%s\\centering
+%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
%s%s
-%s\\end{wrapfigure}" placement comment-include image-code caption))
+%s\\end{sidewaysfigure}"
+ (if caption-above-p caption "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
(multicolumn (format "\\begin{figure*}%s
-\\centering
+%s\\centering
%s%s
-%s\\end{figure*}" placement comment-include image-code caption))
+%s\\end{figure*}"
+ placement
+ (if caption-above-p caption "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
(figure (format "\\begin{figure}%s
-\\centering
+%s\\centering
+%s%s
+%s\\end{figure}"
+ placement
+ (if caption-above-p caption "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ (nonfloat
+ (format "\\begin{center}
%s%s
-%s\\end{figure}" placement comment-include image-code caption))
+%s\\end{center}"
+ (if caption-above-p caption "")
+ image-code
+ (if caption-above-p "" caption)))
(otherwise image-code))))
(defun org-latex-link (link desc info)
@@ -1794,15 +2278,15 @@ INFO is a plist holding contextual information. See
;; Ensure DESC really exists, or set it to nil.
(desc (and (not (string= desc "")) desc))
(imagep (org-export-inline-image-p
- link org-latex-inline-image-rules))
+ link (plist-get info :latex-inline-image-rules)))
(path (cond
- ((member type '("http" "https" "ftp" "mailto"))
+ ((member type '("http" "https" "ftp" "mailto" "doi"))
(concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file:" raw-path))
- (t raw-path)))
- protocol)
+ ((string= type "file") (org-export-file-uri raw-path))
+ (t raw-path))))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc 'latex))
;; Image file.
(imagep (org-latex--inline-image link info))
;; Radio link: Transcode target's contents and use them as link's
@@ -1811,8 +2295,7 @@ INFO is a plist holding contextual information. See
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
(format "\\hyperref[%s]{%s}"
- (org-export-solidify-link-text
- (org-element-property :value destination))
+ (org-export-get-reference destination info)
desc))))
;; Links pointing to a headline: Find destination and build
;; appropriate referencing command.
@@ -1826,8 +2309,8 @@ INFO is a plist holding contextual information. See
(if desc (format "\\href{%s}{%s}" destination desc)
(format "\\url{%s}" destination)))
;; Fuzzy link points nowhere.
- ('nil
- (format org-latex-link-with-unknown-path-format
+ ((nil)
+ (format (plist-get info :latex-link-with-unknown-path-format)
(or desc
(org-export-data
(org-element-property :raw-link link) info))))
@@ -1836,12 +2319,7 @@ INFO is a plist holding contextual information. See
;; number. Otherwise, display description or headline's
;; title.
(headline
- (let ((label
- (format "sec-%s"
- (mapconcat
- 'number-to-string
- (org-export-get-headline-number destination info)
- "-"))))
+ (let ((label (org-latex--label destination info t)))
(if (and (not desc)
(org-export-numbered-headline-p destination info))
(format "\\ref{%s}" label)
@@ -1851,23 +2329,32 @@ INFO is a plist holding contextual information. See
(org-element-property :title destination) info))))))
;; Fuzzy link points to a target. Do as above.
(otherwise
- (let ((path (org-export-solidify-link-text path)))
- (if (not desc) (format "\\ref{%s}" path)
- (format "\\hyperref[%s]{%s}" path desc)))))))
+ (let ((ref (org-latex--label destination info t)))
+ (if (not desc) (format "\\ref{%s}" ref)
+ (format "\\hyperref[%s]{%s}" ref desc)))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
(format (org-export-get-coderef-format path desc)
(org-export-resolve-coderef path info)))
- ;; Link type is handled by a special function.
- ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
- (funcall protocol (org-link-unescape path) desc 'latex))
;; External link with a description part.
((and path desc) (format "\\href{%s}{%s}" path desc))
;; External link without a description part.
(path (format "\\url{%s}" path))
;; No path, only description. Try to do something useful.
- (t (format org-latex-link-with-unknown-path-format desc)))))
+ (t (format (plist-get info :latex-link-with-unknown-path-format) desc)))))
+
+
+;;;; Node Property
+
+(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."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
;;;; Paragraph
@@ -1898,7 +2385,8 @@ contextual information."
latex-type
(or (plist-get attr :options) "")
contents
- latex-type))))
+ latex-type)
+ info)))
;;;; Plain Text
@@ -1907,47 +2395,35 @@ contextual information."
"Transcode a TEXT string from Org to LaTeX.
TEXT is the string to transcode. INFO is a plist holding
contextual information."
- (let ((specialp (plist-get info :with-special-strings))
- (output text))
- ;; Protect %, #, &, $, _, { and }.
- (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}_]\\)" output)
- (setq output
- (replace-match
- (format "\\%s" (match-string 2 output)) nil t output 2)))
- ;; Protect ^.
- (setq output
- (replace-regexp-in-string
- "\\([^\\]\\|^\\)\\(\\^\\)" "\\\\^{}" output nil nil 2))
- ;; Protect \. If special strings are used, be careful not to
- ;; protect "\" in "\-" constructs.
- (let ((symbols (if specialp "-%$#&{}^_\\" "%$#&{}^_\\")))
- (setq output
+ (let* ((specialp (plist-get info :with-special-strings))
+ (output
+ ;; Turn LaTeX into \LaTeX{} and TeX into \TeX{}.
+ (let ((case-fold-search nil))
(replace-regexp-in-string
- (format "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%s]\\|$\\)" symbols)
- "$\\backslash$" output nil t 1)))
- ;; Protect ~.
- (setq output
- (replace-regexp-in-string
- "\\([^\\]\\|^\\)\\(~\\)" "\\textasciitilde{}" output nil t 2))
+ "\\<\\(?:La\\)?TeX\\>" "\\\\\\&{}"
+ ;; Protect ^, ~, %, #, &, $, _, { and }. Also protect \.
+ ;; However, if special strings are used, be careful not
+ ;; to protect "\" in "\-" constructs.
+ (replace-regexp-in-string
+ (concat "[%$#&{}_~^]\\|\\\\" (and specialp "\\([^-]\\|$\\)"))
+ (lambda (m)
+ (case (string-to-char m)
+ (?\\ "$\\\\backslash$\\1")
+ (?~ "\\\\textasciitilde{}")
+ (?^ "\\\\^{}")
+ (t "\\\\\\&")))
+ text)))))
;; Activate smart quotes. Be sure to provide original TEXT string
;; since OUTPUT may have been modified.
(when (plist-get info :with-smart-quotes)
(setq output (org-export-activate-smart-quotes output :latex info text)))
- ;; LaTeX into \LaTeX{} and TeX into \TeX{}.
- (let ((case-fold-search nil)
- (start 0))
- (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" output start)
- (setq output (replace-match
- (format "\\%s{}" (match-string 1 output)) nil t output)
- start (match-end 0))))
;; Convert special strings.
(when specialp
- (setq output
- (replace-regexp-in-string "\\.\\.\\." "\\ldots{}" output nil t)))
+ (setq output (replace-regexp-in-string "\\.\\.\\." "\\\\ldots{}" output)))
;; Handle break preservation if required.
(when (plist-get info :preserve-breaks)
(setq output (replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" output)))
+ "\\(?:[ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n" output nil t)))
;; Return value.
output))
@@ -1968,27 +2444,169 @@ information."
(when closed
(concat
(format "\\textbf{%s} " org-closed-string)
- (format org-latex-inactive-timestamp-format
- (org-translate-time
- (org-element-property :raw-value closed))))))
+ (format (plist-get info :latex-inactive-timestamp-format)
+ (org-timestamp-translate closed)))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline
(concat
(format "\\textbf{%s} " org-deadline-string)
- (format org-latex-active-timestamp-format
- (org-translate-time
- (org-element-property :raw-value deadline))))))
+ (format (plist-get info :latex-active-timestamp-format)
+ (org-timestamp-translate deadline)))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
(concat
(format "\\textbf{%s} " org-scheduled-string)
- (format org-latex-active-timestamp-format
- (org-translate-time
- (org-element-property :raw-value scheduled))))))))
+ (format (plist-get info :latex-active-timestamp-format)
+ (org-timestamp-translate scheduled)))))))
" ")
"\\\\"))
+;;;; Property Drawer
+
+(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."
+ (and (org-string-nw-p contents)
+ (format "\\begin{verbatim}\n%s\\end{verbatim}" contents)))
+
+
+;;;; Pseudo Element: LaTeX Matrices
+
+;; `latex-matrices' elements have the following properties:
+;; `:caption', `:post-blank' and `:markup' (`inline', `equation' or
+;; `math').
+
+(defun org-latex--wrap-latex-matrices (data info)
+ "Merge contiguous tables with the same mode within a pseudo-element.
+DATA is a parse tree or a secondary string. INFO is a plist
+containing export options. Modify DATA by side-effect and return
+it."
+ (org-element-map data 'table
+ (lambda (table)
+ (when (eq (org-element-property :type table) 'org)
+ (let ((mode (or (org-export-read-attribute :attr_latex table :mode)
+ (plist-get info :latex-default-table-mode))))
+ (when (and (member mode '("inline-math" "math"))
+ ;; Do not wrap twice the same table.
+ (not (eq (org-element-type
+ (org-element-property :parent table))
+ 'latex-matrices)))
+ (let* ((caption (and (not (string= mode "inline-math"))
+ (org-element-property :caption table)))
+ (matrices
+ (list 'latex-matrices
+ (list :caption caption
+ :markup
+ (cond ((string= mode "inline-math") 'inline)
+ (caption 'equation)
+ (t 'math)))))
+ (previous table)
+ (next (org-export-get-next-element table info)))
+ (org-element-insert-before matrices table)
+ ;; Swallow all contiguous tables sharing the same mode.
+ (while (and
+ (zerop (or (org-element-property :post-blank previous) 0))
+ (setq next (org-export-get-next-element previous info))
+ (eq (org-element-type next) 'table)
+ (eq (org-element-property :type next) 'org)
+ (string= (or (org-export-read-attribute
+ :attr_latex next :mode)
+ (plist-get info :latex-default-table-mode))
+ mode))
+ (org-element-extract-element previous)
+ (org-element-adopt-elements matrices previous)
+ (setq previous next))
+ (org-element-put-property
+ matrices :post-blank (org-element-property :post-blank previous))
+ (org-element-extract-element previous)
+ (org-element-adopt-elements matrices previous))))))
+ info)
+ data)
+
+(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)
+ (inline "\\(%s\\)")
+ (equation "\\begin{equation}\n%s\\end{equation}")
+ (t "\\[\n%s\\]"))
+ contents))
+
+(defun org-latex-matrices-tree-filter (tree backend info)
+ (org-latex--wrap-latex-matrices tree info))
+
+;;;; Pseudo Object: LaTeX Math Block
+
+;; `latex-math-block' objects have the following property:
+;; `:post-blank'.
+
+(defun org-latex--wrap-latex-math-block (data info)
+ "Merge contiguous math objects in a pseudo-object container.
+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))))))
+ (org-element-map data '(entity latex-fragment subscript superscript)
+ (lambda (object)
+ ;; Skip objects already wrapped.
+ (when (and (not (eq (org-element-type
+ (org-element-property :parent object))
+ 'latex-math-block))
+ (funcall valid-object-p object))
+ (let ((math-block (list 'latex-math-block nil))
+ (next-elements (org-export-get-next-element object info t))
+ (last object))
+ ;; Wrap MATH-BLOCK around OBJECT in DATA.
+ (org-element-insert-before math-block object)
+ (org-element-extract-element object)
+ (org-element-adopt-elements math-block object)
+ (when (zerop (or (org-element-property :post-blank object) 0))
+ ;; MATH-BLOCK swallows consecutive math objects.
+ (catch 'exit
+ (dolist (next next-elements)
+ (if (not (funcall valid-object-p next)) (throw 'exit nil)
+ (org-element-extract-element next)
+ (org-element-adopt-elements math-block next)
+ ;; Eschew the case: \beta$x$ -> \(\betax\).
+ (unless (memq (org-element-type next)
+ '(subscript superscript))
+ (org-element-put-property last :post-blank 1))
+ (setq last next)
+ (when (> (or (org-element-property :post-blank next) 0) 0)
+ (throw 'exit nil))))))
+ (org-element-put-property
+ math-block :post-blank (org-element-property :post-blank last)))))
+ info nil '(subscript superscript latex-math-block) t)
+ ;; Return updated DATA.
+ data))
+
+(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)
+ (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)
+ "Transcode a MATH-BLOCK object from Org to LaTeX.
+CONTENTS is a string. INFO is a plist used as a communication
+channel."
+ (when (org-string-nw-p contents)
+ (format "\\(%s\\)" (org-trim contents))))
+
;;;; Quote Block
(defun org-latex-quote-block (quote-block contents info)
@@ -1996,18 +2614,7 @@ information."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(org-latex--wrap-label
- quote-block
- (format "\\begin{quote}\n%s\\end{quote}" contents)))
-
-
-;;;; Quote Section
-
-(defun org-latex-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to LaTeX.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value))))
+ quote-block (format "\\begin{quote}\n%s\\end{quote}" contents) info))
;;;; Radio Target
@@ -2016,10 +2623,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a RADIO-TARGET object from Org to LaTeX.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- (format "\\label{%s}%s"
- (org-export-solidify-link-text
- (org-element-property :value radio-target))
- text))
+ (format "\\label{%s}%s" (org-export-get-reference radio-target info) text))
;;;; Section
@@ -2037,14 +2641,14 @@ holding contextual information."
"Transcode a SPECIAL-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let ((type (downcase (org-element-property :type special-block)))
- (opt (org-export-read-attribute :attr_latex special-block :options)))
+ (let ((type (org-element-property :type special-block))
+ (opt (org-export-read-attribute :attr_latex special-block :options))
+ (caption (org-latex--caption/label-string special-block info))
+ (caption-above-p (org-latex--caption-above-p special-block info)))
(concat (format "\\begin{%s}%s\n" type (or opt ""))
- ;; Insert any label or caption within the block
- ;; (otherwise, a reference pointing to that element will
- ;; count the section instead).
- (org-latex--caption/label-string special-block info)
+ (and caption-above-p caption)
contents
+ (and (not caption-above-p) caption)
(format "\\end{%s}" type))))
@@ -2057,6 +2661,7 @@ contextual information."
(when (org-string-nw-p (org-element-property :value src-block))
(let* ((lang (org-element-property :language src-block))
(caption (org-element-property :caption src-block))
+ (caption-above-p (org-latex--caption-above-p src-block info))
(label (org-element-property :name src-block))
(custom-env (and lang
(cadr (assq (intern lang)
@@ -2066,56 +2671,68 @@ contextual information."
(new 0)))
(retain-labels (org-element-property :retain-labels src-block))
(attributes (org-export-read-attribute :attr_latex src-block))
- (float (plist-get attributes :float)))
+ (float (plist-get attributes :float))
+ (listings (plist-get info :latex-listings)))
(cond
;; Case 1. No source fontification.
- ((not org-latex-listings)
+ ((not listings)
(let* ((caption-str (org-latex--caption/label-string src-block info))
(float-env
- (cond ((and (not float) (plist-member attributes :float)) "%s")
- ((string= "multicolumn" float)
- (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}"
- org-latex-default-figure-position
- caption-str))
- ((or caption float)
- (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}"
- caption-str))
+ (cond ((string= "multicolumn" float)
+ (format "\\begin{figure*}[%s]\n%s%%s\n%s\\end{figure*}"
+ (plist-get info :latex-default-figure-position)
+ (if caption-above-p caption-str "")
+ (if caption-above-p "" caption-str)))
+ (caption (concat
+ (if caption-above-p caption-str "")
+ "%s"
+ (if caption-above-p "" (concat "\n" caption-str))))
(t "%s"))))
(format
float-env
(concat (format "\\begin{verbatim}\n%s\\end{verbatim}"
(org-export-format-code-default src-block info))))))
;; Case 2. Custom environment.
- (custom-env (format "\\begin{%s}\n%s\\end{%s}\n"
- custom-env
- (org-export-format-code-default src-block info)
- custom-env))
+ (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)))
;; Case 3. Use minted package.
- ((eq org-latex-listings 'minted)
+ ((eq listings 'minted)
(let* ((caption-str (org-latex--caption/label-string src-block info))
(float-env
- (cond ((and (not float) (plist-member attributes :float)) "%s")
- ((string= "multicolumn" float)
- (format "\\begin{listing*}\n%%s\n%s\\end{listing*}"
- caption-str))
- ((or caption float)
- (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
- caption-str))
- (t "%s")))
+ (cond
+ ((string= "multicolumn" float)
+ (format "\\begin{listing*}\n%s%%s\n%s\\end{listing*}"
+ (if caption-above-p caption-str "")
+ (if caption-above-p "" caption-str)))
+ (caption
+ (concat (if caption-above-p caption-str "")
+ "%s"
+ (if caption-above-p "" (concat "\n" caption-str))))
+ (t "%s")))
+ (options (plist-get info :latex-minted-options))
(body
(format
"\\begin{minted}[%s]{%s}\n%s\\end{minted}"
;; Options.
- (org-latex--make-option-string
- (if (or (not num-start)
- (assoc "linenos" org-latex-minted-options))
- org-latex-minted-options
- (append
- `(("linenos")
- ("firstnumber" ,(number-to-string (1+ num-start))))
- org-latex-minted-options)))
+ (concat
+ (org-latex--make-option-string
+ (if (or (not num-start) (assoc "linenos" options))
+ options
+ (append
+ `(("linenos")
+ ("firstnumber" ,(number-to-string (1+ num-start))))
+ options)))
+ (let ((local-options (plist-get attributes :options)))
+ (and local-options (concat "," local-options))))
;; Language.
- (or (cadr (assq (intern lang) org-latex-minted-langs))
+ (or (cadr (assq (intern lang)
+ (plist-get info :latex-minted-langs)))
(downcase lang))
;; Source code.
(let* ((code-info (org-export-unravel-code src-block))
@@ -2142,7 +2759,9 @@ contextual information."
;; Case 4. Use listings package.
(t
(let ((lst-lang
- (or (cadr (assq (intern lang) org-latex-listings-langs)) lang))
+ (or (cadr (assq (intern lang)
+ (plist-get info :latex-listings-langs)))
+ lang))
(caption-str
(when caption
(let ((main (org-export-get-caption src-block))
@@ -2151,28 +2770,32 @@ contextual information."
(format "{%s}" (org-export-data main info))
(format "{[%s]%s}"
(org-export-data secondary info)
- (org-export-data main info)))))))
+ (org-export-data main info))))))
+ (lst-opt (plist-get info :latex-listings-options)))
(concat
;; Options.
(format
"\\lstset{%s}\n"
- (org-latex--make-option-string
- (append
- org-latex-listings-options
- (cond
- ((and (not float) (plist-member attributes :float)) nil)
- ((string= "multicolumn" float) '(("float" "*")))
- ((and float (not (assoc "float" org-latex-listings-options)))
- `(("float" ,org-latex-default-figure-position))))
- `(("language" ,lst-lang))
- (if label `(("label" ,label)) '(("label" " ")))
- (if caption-str `(("caption" ,caption-str)) '(("caption" " ")))
- (cond ((assoc "numbers" org-latex-listings-options) nil)
- ((not num-start) '(("numbers" "none")))
- ((zerop num-start) '(("numbers" "left")))
- (t `(("numbers" "left")
- ("firstnumber"
- ,(number-to-string (1+ num-start)))))))))
+ (concat
+ (org-latex--make-option-string
+ (append
+ lst-opt
+ (cond
+ ((and (not float) (plist-member attributes :float)) nil)
+ ((string= "multicolumn" float) '(("float" "*")))
+ ((and float (not (assoc "float" lst-opt)))
+ `(("float" ,(plist-get info :latex-default-figure-position)))))
+ `(("language" ,lst-lang))
+ (if label `(("label" ,label)) '(("label" " ")))
+ (if caption-str `(("caption" ,caption-str)) '(("caption" " ")))
+ `(("captionpos" ,(if caption-above-p "t" "b")))
+ (cond ((assoc "numbers" lst-opt) nil)
+ ((not num-start) '(("numbers" "none")))
+ ((zerop num-start) '(("numbers" "left")))
+ (t `(("firstnumber" ,(number-to-string (1+ num-start)))
+ ("numbers" "left"))))))
+ (let ((local-options (plist-get attributes :options)))
+ (and local-options (concat "," local-options)))))
;; Source code.
(format
"\\begin{lstlisting}\n%s\\end{lstlisting}"
@@ -2210,7 +2833,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode STRIKE-THROUGH from Org to LaTeX.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
- (org-latex--text-markup contents 'strike-through))
+ (org-latex--text-markup contents 'strike-through info))
;;;; Subscript
@@ -2219,17 +2842,7 @@ holding contextual information."
"Transcode a subscript or superscript object.
OBJECT is an Org object. INFO is a plist used as a communication
channel."
- (let ((in-script-p
- ;; Non-nil if object is already in a sub/superscript.
- (let ((parent object))
- (catch 'exit
- (while (setq parent (org-export-get-parent parent))
- (let ((type (org-element-type parent)))
- (cond ((memq type '(subscript superscript))
- (throw 'exit t))
- ((memq type org-element-all-elements)
- (throw 'exit nil))))))))
- (type (org-element-type object))
+ (let ((type (org-element-type object))
(output ""))
(org-element-map (org-element-contents object)
(cons 'plain-text org-element-all-objects)
@@ -2255,31 +2868,12 @@ channel."
(let ((blank (org-element-property :post-blank obj)))
(and blank (> blank 0) "\\ ")))))))
info nil org-element-recursive-objects)
- ;; Result. Do not wrap into math mode if already in a subscript
- ;; or superscript. Do not wrap into curly brackets if OUTPUT is
- ;; a single character. Also merge consecutive subscript and
- ;; superscript into the same math snippet.
- (concat (and (not in-script-p)
- (let ((prev (org-export-get-previous-element object info)))
- (or (not prev)
- (not (eq (org-element-type prev)
- (if (eq type 'subscript) 'superscript
- 'subscript)))
- (let ((blank (org-element-property :post-blank prev)))
- (and blank (> blank 0)))))
- "$")
- (if (eq (org-element-type object) 'subscript) "_" "^")
+ ;; Result. Do not wrap into curly brackets if OUTPUT is a single
+ ;; character.
+ (concat (if (eq (org-element-type object) 'subscript) "_" "^")
(and (> (length output) 1) "{")
output
- (and (> (length output) 1) "}")
- (and (not in-script-p)
- (or (let ((blank (org-element-property :post-blank object)))
- (and blank (> blank 0)))
- (not (eq (org-element-type
- (org-export-get-next-element object info))
- (if (eq type 'subscript) 'superscript
- 'subscript))))
- "$"))))
+ (and (> (length output) 1) "}"))))
(defun org-latex-subscript (subscript contents info)
"Transcode a SUBSCRIPT object from Org to LaTeX.
@@ -2316,7 +2910,7 @@ contextual information."
;; "table.el" table. Convert it using appropriate tools.
(org-latex--table.el-table table info)
(let ((type (or (org-export-read-attribute :attr_latex table :mode)
- org-latex-default-table-mode)))
+ (plist-get info :latex-default-table-mode))))
(cond
;; Case 1: Verbatim table.
((string= type "verbatim")
@@ -2376,14 +2970,15 @@ This function assumes TABLE has `org' as its `:type' property and
(alignment (org-latex--align-string table info))
;; Determine environment for the table: longtable, tabular...
(table-env (or (plist-get attr :environment)
- org-latex-default-table-environment))
+ (plist-get info :latex-default-table-environment)))
;; If table is a float, determine environment: table, table*
;; or sidewaystable.
(float-env (unless (member table-env '("longtable" "longtabu"))
(let ((float (plist-get attr :float)))
(cond
((and (not float) (plist-member attr :float)) nil)
- ((string= float "sidewaystable") "sidewaystable")
+ ((or (string= float "sidewaystable")
+ (string= float "sideways")) "sidewaystable")
((string= float "multicolumn") "table*")
((or float
(org-element-property :caption table)
@@ -2392,23 +2987,26 @@ This function assumes TABLE has `org' as its `:type' property and
;; Extract others display options.
(fontsize (let ((font (plist-get attr :font)))
(and font (concat font "\n"))))
- (width (plist-get attr :width))
+ ;; "tabular" environment doesn't allow to define a width.
+ (width (and (not (equal table-env "tabular")) (plist-get attr :width)))
(spreadp (plist-get attr :spread))
- (placement (or (plist-get attr :placement)
- (format "[%s]" org-latex-default-figure-position)))
+ (placement
+ (or (plist-get attr :placement)
+ (format "[%s]" (plist-get info :latex-default-figure-position))))
(centerp (if (plist-member attr :center) (plist-get attr :center)
- org-latex-tables-centered)))
+ (plist-get info :latex-tables-centered)))
+ (caption-above-p (org-latex--caption-above-p table info)))
;; Prepare the final format string for the table.
(cond
;; Longtable.
((equal "longtable" table-env)
(concat (and fontsize (concat "{" fontsize))
(format "\\begin{longtable}{%s}\n" alignment)
- (and org-latex-table-caption-above
+ (and caption-above-p
(org-string-nw-p caption)
(concat caption "\\\\\n"))
contents
- (and (not org-latex-table-caption-above)
+ (and (not caption-above-p)
(org-string-nw-p caption)
(concat caption "\\\\\n"))
"\\end{longtable}\n"
@@ -2421,11 +3019,11 @@ This function assumes TABLE has `org' as its `:type' property and
(format " %s %s "
(if spreadp "spread" "to") width) "")
alignment)
- (and org-latex-table-caption-above
+ (and caption-above-p
(org-string-nw-p caption)
(concat caption "\\\\\n"))
contents
- (and (not org-latex-table-caption-above)
+ (and (not caption-above-p)
(org-string-nw-p caption)
(concat caption "\\\\\n"))
"\\end{longtabu}\n"
@@ -2434,9 +3032,15 @@ This function assumes TABLE has `org' as its `:type' property and
(t (concat (cond
(float-env
(concat (format "\\begin{%s}%s\n" float-env placement)
- (if org-latex-table-caption-above caption "")
+ (if caption-above-p caption "")
(when centerp "\\centering\n")
fontsize))
+ ((and (not float-env) caption)
+ (concat
+ (and centerp "\\begin{center}\n" )
+ (if caption-above-p caption "")
+ (cond ((and fontsize centerp) fontsize)
+ (fontsize (concat "{" fontsize)))))
(centerp (concat "\\begin{center}\n" fontsize))
(fontsize (concat "{" fontsize)))
(cond ((equal "tabu" table-env)
@@ -2454,8 +3058,13 @@ This function assumes TABLE has `org' as its `:type' property and
table-env)))
(cond
(float-env
- (concat (if org-latex-table-caption-above "" caption)
+ (concat (if caption-above-p "" (concat "\n" caption))
(format "\n\\end{%s}" float-env)))
+ ((and (not float-env) caption)
+ (concat
+ (if caption-above-p "" (concat "\n" caption))
+ (and centerp "\n\\end{center}")
+ (and fontsize (not centerp) "}")))
(centerp "\n\\end{center}")
(fontsize "}")))))))
@@ -2492,7 +3101,7 @@ property."
(incf n)
(unless (= n 2) (setq output (replace-match "" nil nil output))))))
(let ((centerp (if (plist-member attr :center) (plist-get attr :center)
- org-latex-tables-centered)))
+ (plist-get info :latex-tables-centered))))
(if (not centerp) output
(format "\\begin{center}\n%s\n\\end{center}" output))))))
@@ -2503,12 +3112,10 @@ TABLE is the table type element to transcode. INFO is a plist
used as a communication channel.
This function assumes TABLE has `org' as its `:type' property and
-`inline-math' or `math' as its `:mode' attribute.."
- (let* ((caption (org-latex--caption/label-string table info))
- (attr (org-export-read-attribute :attr_latex table))
- (inlinep (equal (plist-get attr :mode) "inline-math"))
+`inline-math' or `math' as its `:mode' attribute."
+ (let* ((attr (org-export-read-attribute :attr_latex table))
(env (or (plist-get attr :environment)
- org-latex-default-table-environment))
+ (plist-get info :latex-default-table-environment)))
(contents
(mapconcat
(lambda (row)
@@ -2519,38 +3126,18 @@ This function assumes TABLE has `org' as its `:type' property and
(mapconcat
(lambda (cell)
(substring (org-element-interpret-data cell) 0 -1))
- (org-element-map row 'table-cell 'identity info) "&")
+ (org-element-map row 'table-cell #'identity info) "&")
(or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\")
"\n")))
- (org-element-map table 'table-row 'identity info) ""))
- ;; Variables related to math clusters (contiguous math tables
- ;; of the same type).
- (mode (org-export-read-attribute :attr_latex table :mode))
- (prev (org-export-get-previous-element table info))
- (next (org-export-get-next-element table info))
- (same-mode-p
- (lambda (table)
- ;; Non-nil when TABLE has the same mode as current table.
- (string= (or (org-export-read-attribute :attr_latex table :mode)
- org-latex-default-table-mode)
- mode))))
+ (org-element-map table 'table-row #'identity info) "")))
(concat
- ;; Opening string. If TABLE is in the middle of a table cluster,
- ;; do not insert any.
- (cond ((and prev
- (eq (org-element-type prev) 'table)
- (memq (org-element-property :post-blank prev) '(0 nil))
- (funcall same-mode-p prev))
- nil)
- (inlinep "\\(")
- ((org-string-nw-p caption) (concat "\\begin{equation}\n" caption))
- (t "\\["))
;; Prefix.
- (or (plist-get attr :math-prefix) "")
+ (plist-get attr :math-prefix)
;; Environment. Also treat special cases.
- (cond ((equal env "array")
- (let ((align (org-latex--align-string table info)))
- (format "\\begin{array}{%s}\n%s\\end{array}" align contents)))
+ (cond ((member env '("array" "tabular"))
+ (let ((align (make-string
+ (cdr (org-export-table-dimensions table info)) ?c)))
+ (format "\\begin{%s}{%s}\n%s\\end{%s}" env align contents env)))
((assoc env org-latex-table-matrix-macros)
(format "\\%s%s{\n%s}"
env
@@ -2558,28 +3145,7 @@ This function assumes TABLE has `org' as its `:type' property and
contents))
(t (format "\\begin{%s}\n%s\\end{%s}" env contents env)))
;; Suffix.
- (or (plist-get attr :math-suffix) "")
- ;; Closing string. If TABLE is in the middle of a table cluster,
- ;; do not insert any. If it closes such a cluster, be sure to
- ;; close the cluster with a string matching the opening string.
- (cond ((and next
- (eq (org-element-type next) 'table)
- (memq (org-element-property :post-blank table) '(0 nil))
- (funcall same-mode-p next))
- nil)
- (inlinep "\\)")
- ;; Find cluster beginning to know which environment to use.
- ((let ((cluster-beg table) prev)
- (while (and (setq prev (org-export-get-previous-element
- cluster-beg info))
- (memq (org-element-property :post-blank prev)
- '(0 nil))
- (funcall same-mode-p prev))
- (setq cluster-beg prev))
- (and (or (org-element-property :caption cluster-beg)
- (org-element-property :name cluster-beg))
- "\n\\end{equation}")))
- (t "\\]")))))
+ (plist-get attr :math-suffix))))
;;;; Table Cell
@@ -2588,16 +3154,18 @@ This function assumes TABLE has `org' as its `:type' property and
"Transcode a TABLE-CELL element from Org to LaTeX.
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
- (concat (if (and contents
- org-latex-table-scientific-notation
- (string-match orgtbl-exp-regexp contents))
- ;; Use appropriate format string for scientific
- ;; notation.
- (format org-latex-table-scientific-notation
- (match-string 1 contents)
- (match-string 2 contents))
- contents)
- (when (org-export-get-next-element table-cell info) " & ")))
+ (concat
+ (let ((scientific-format (plist-get info :latex-table-scientific-notation)))
+ (if (and contents
+ scientific-format
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format scientific-format
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents))
+ (when (org-export-get-next-element table-cell info) " & ")))
;;;; Table Row
@@ -2606,44 +3174,62 @@ a communication channel."
"Transcode a TABLE-ROW element from Org to LaTeX.
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.
- (when (eq (org-element-property :type table-row) 'standard)
- (let* ((attr (org-export-read-attribute :attr_latex
- (org-export-get-parent table-row)))
- (longtablep (member (or (plist-get attr :environment)
- org-latex-default-table-environment)
- '("longtable" "longtabu")))
- (booktabsp (if (plist-member attr :booktabs)
- (plist-get attr :booktabs)
- org-latex-tables-booktabs))
- ;; TABLE-ROW's borders are extracted from its first cell.
- (borders (org-export-table-cell-borders
- (car (org-element-contents table-row)) info)))
+ (let* ((attr (org-export-read-attribute :attr_latex
+ (org-export-get-parent table-row)))
+ (booktabsp (if (plist-member attr :booktabs) (plist-get attr :booktabs)
+ (plist-get info :latex-tables-booktabs)))
+ (longtablep
+ (member (or (plist-get attr :environment)
+ (plist-get info :latex-default-table-environment))
+ '("longtable" "longtabu"))))
+ (if (eq (org-element-property :type table-row) 'rule)
+ (cond
+ ((not booktabsp) "\\hline")
+ ((not (org-export-get-previous-element table-row info)) "\\toprule")
+ ((not (org-export-get-next-element table-row info)) "\\bottomrule")
+ ((and longtablep
+ (org-export-table-row-ends-header-p
+ (org-export-get-previous-element table-row info) info))
+ "")
+ (t "\\midrule"))
(concat
;; When BOOKTABS are activated enforce top-rule even when no
;; hline was specifically marked.
- (cond ((and booktabsp (memq 'top borders)) "\\toprule\n")
- ((and (memq 'top borders) (memq 'above borders)) "\\hline\n"))
+ (and booktabsp (not (org-export-get-previous-element table-row info))
+ "\\toprule\n")
contents "\\\\\n"
(cond
- ;; Special case for long tables. Define header and footers.
+ ;; Special case for long tables. Define header and footers.
((and longtablep (org-export-table-row-ends-header-p table-row info))
- (format "%s
+ (let ((columns (cdr (org-export-table-dimensions
+ (org-export-get-parent-table table-row) info))))
+ (format "%s
+\\endfirsthead
+\\multicolumn{%d}{l}{%s} \\\\
+%s
+%s \\\\\n
+%s
\\endhead
-%s\\multicolumn{%d}{r}{Continued on next page} \\\\
+%s\\multicolumn{%d}{r}{%s} \\\\
\\endfoot
\\endlastfoot"
- (if booktabsp "\\midrule" "\\hline")
- (if booktabsp "\\midrule" "\\hline")
- ;; Number of columns.
- (cdr (org-export-table-dimensions
- (org-export-get-parent-table table-row) info))))
+ (if booktabsp "\\midrule" "\\hline")
+ columns
+ (org-latex--translate "Continued from previous page" info)
+ (cond
+ ((not (org-export-table-row-starts-header-p table-row info))
+ "")
+ (booktabsp "\\toprule\n")
+ (t "\\hline\n"))
+ contents
+ (if booktabsp "\\midrule" "\\hline")
+ (if booktabsp "\\midrule" "\\hline")
+ columns
+ (org-latex--translate "Continued on next page" info))))
;; When BOOKTABS are activated enforce bottom rule even when
;; no hline was specifically marked.
- ((and booktabsp (memq 'bottom borders)) "\\bottomrule")
- ((and (memq 'bottom borders) (memq 'below borders)) "\\hline")
- ((memq 'below borders) (if booktabsp "\\midrule" "\\hline")))))))
+ ((and booktabsp (not (org-export-get-next-element table-row info)))
+ "\\bottomrule"))))))
;;;; Target
@@ -2652,8 +3238,7 @@ a communication channel."
"Transcode a TARGET object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "\\label{%s}"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "\\label{%s}" (org-latex--label target info)))
;;;; Timestamp
@@ -2662,13 +3247,14 @@ information."
"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)))
- (case (org-element-property :type timestamp)
- ((active active-range) (format org-latex-active-timestamp-format value))
- ((inactive inactive-range)
- (format org-latex-inactive-timestamp-format value))
- (otherwise (format org-latex-diary-timestamp-format value)))))
+ (let ((value (org-latex-plain-text (org-timestamp-translate timestamp) info)))
+ (format
+ (plist-get info
+ (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)))
+ value)))
;;;; Underline
@@ -2677,7 +3263,7 @@ information."
"Transcode UNDERLINE from Org to LaTeX.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
- (org-latex--text-markup contents 'underline))
+ (org-latex--text-markup contents 'underline info))
;;;; Verbatim
@@ -2686,7 +3272,8 @@ holding contextual information."
"Transcode a VERBATIM object from Org to LaTeX.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (org-latex--text-markup (org-element-property :value verbatim) 'verbatim))
+ (org-latex--text-markup
+ (org-element-property :value verbatim) 'verbatim info))
;;;; Verse Block
@@ -2701,16 +3288,15 @@ contextual information."
;; character and change each white space at beginning of a line
;; into a space of 1 em. Also change each blank line with
;; a vertical space of 1 em.
- (progn
- (setq contents (replace-regexp-in-string
- "^ *\\\\\\\\$" "\\\\vspace*{1em}"
- (replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents)))
- (while (string-match "^[ \t]+" contents)
- (let ((new-str (format "\\hspace*{%dem}"
- (length (match-string 0 contents)))))
- (setq contents (replace-match new-str nil t contents))))
- (format "\\begin{verse}\n%s\\end{verse}" contents))))
+ (format "\\begin{verse}\n%s\\end{verse}"
+ (replace-regexp-in-string
+ "^[ \t]+" (lambda (m) (format "\\hspace*{%dem}" (length m)))
+ (replace-regexp-in-string
+ "^[ \t]*\\\\\\\\$" "\\vspace*{1em}"
+ (replace-regexp-in-string
+ "\\([ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n"
+ contents nil t) nil t) nil t))
+ info))
@@ -2845,7 +3431,8 @@ Return PDF file name or an error if it couldn't be produced."
(default-directory (if (file-name-absolute-p texfile)
(file-name-directory full-name)
default-directory))
- errors)
+ (time (current-time))
+ warnings)
(unless snippet (message (format "Processing LaTeX file %s..." texfile)))
(save-window-excursion
(cond
@@ -2858,59 +3445,60 @@ Return PDF file name or an error if it couldn't be produced."
((consp org-latex-pdf-process)
(let ((outbuf (and (not snippet)
(get-buffer-create "*Org PDF LaTeX Output*"))))
- (mapc
- (lambda (command)
- (shell-command
+ (dolist (command org-latex-pdf-process)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base-name)
(replace-regexp-in-string
- "%b" (shell-quote-argument base-name)
+ "%f" (shell-quote-argument full-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-latex-pdf-process)
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
;; Collect standard errors from output buffer.
- (setq errors (and (not snippet) (org-latex--collect-errors outbuf)))))
+ (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 (not (file-exists-p pdffile))
- (error (concat (format "PDF file %s wasn't produced" pdffile)
- (when errors (concat ": " errors))))
+ (if (or (not (file-exists-p pdffile))
+ (time-less-p (nth 5 (file-attributes pdffile)) time))
+ (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.
- (when (and (not snippet) 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 "Process completed"
- (if (not errors) "."
- (concat " with errors: " errors)))))
+ (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))))
-(defun org-latex--collect-errors (buffer)
- "Collect some kind of errors from \"pdflatex\" command output.
-
-BUFFER is the buffer containing output.
-
-Return collected error types as a string, or nil if there was
-none."
+(defun org-latex--collect-warnings (buffer)
+ "Collect some warnings from \"pdflatex\" command output.
+BUFFER is the buffer containing output. Return collected
+warnings types as a string, `error' if a LaTeX error was
+encountered or nil if there was none."
(with-current-buffer buffer
(save-excursion
(goto-char (point-max))
(when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t)
- (let ((case-fold-search t)
- (errors ""))
- (dolist (latex-error org-latex-known-errors)
- (when (save-excursion (re-search-forward (car latex-error) nil t))
- (setq errors (concat errors " " (cdr latex-error)))))
- (and (org-string-nw-p errors) (org-trim errors)))))))
+ (if (re-search-forward "^!" nil t) 'error
+ (let ((case-fold-search t)
+ (warnings ""))
+ (dolist (warning org-latex-known-warnings)
+ (when (save-excursion (re-search-forward (car warning) nil t))
+ (setq warnings (concat warnings " " (cdr warning)))))
+ (org-string-nw-p (org-trim warnings))))))))
;;;###autoload
(defun org-latex-publish-to-latex (plist filename pub-dir)
diff --git a/lisp/ox-man.el b/lisp/ox-man.el
index d58c119..6388a55 100644
--- a/lisp/ox-man.el
+++ b/lisp/ox-man.el
@@ -1,6 +1,6 @@
;; ox-man.el --- Man Back-End for Org Export Engine
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Luis R Anaya <papoanaya aroba hot mail punto com>
@@ -55,8 +55,6 @@
(center-block . org-man-center-block)
(clock . org-man-clock)
(code . org-man-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-man-drawer)
(dynamic-block . org-man-dynamic-block)
(entity . org-man-entity)
@@ -76,13 +74,13 @@
(keyword . org-man-keyword)
(line-break . org-man-line-break)
(link . org-man-link)
+ (node-property . org-man-node-property)
(paragraph . org-man-paragraph)
(plain-list . org-man-plain-list)
(plain-text . org-man-plain-text)
(planning . org-man-planning)
- (property-drawer . (lambda (&rest args) ""))
+ (property-drawer . org-man-property-drawer)
(quote-block . org-man-quote-block)
- (quote-section . org-man-quote-section)
(radio-target . org-man-radio-target)
(section . org-man-section)
(special-block . org-man-special-block)
@@ -102,7 +100,7 @@
(verse-block . org-man-verse-block))
:export-block "MAN"
:menu-entry
- '(?m "Export to MAN"
+ '(?M "Export to MAN"
((?m "As MAN file" org-man-export-to-man)
(?p "As PDF file" org-man-export-to-pdf)
(?o "As PDF file and open"
@@ -112,7 +110,13 @@
:options-alist
'((:man-class "MAN_CLASS" nil nil t)
(:man-class-options "MAN_CLASS_OPTIONS" nil nil t)
- (:man-header-extra "MAN_HEADER" nil nil newline)))
+ (:man-header-extra "MAN_HEADER" nil nil newline)
+ ;; Other variables.
+ (:man-tables-centered nil nil org-man-tables-centered)
+ (:man-tables-verbatim nil nil org-man-tables-verbatim)
+ (:man-table-scientific-notation nil nil org-man-table-scientific-notation)
+ (:man-source-highlight nil nil org-man-source-highlight)
+ (:man-source-highlight-langs nil nil org-man-source-highlight-langs)))
@@ -305,7 +309,8 @@ This function shouldn't be used for floats. See
"Return complete document string after Man conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- (let* ((title (org-export-data (plist-get info :title) info))
+ (let* ((title (when (plist-get info :with-title)
+ (org-export-data (plist-get info :title) info)))
(attr (read (format "(%s)"
(mapconcat
#'identity
@@ -526,7 +531,7 @@ CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((code (org-element-property :value inline-src-block)))
(cond
- (org-man-source-highlight
+ ((plist-get info :man-source-highlight)
(let* ((tmpdir (if (featurep 'xemacs)
temp-directory
temporary-file-directory ))
@@ -535,8 +540,9 @@ contextual information."
(out-file (make-temp-name
(expand-file-name "reshilite" tmpdir)))
(org-lang (org-element-property :language inline-src-block))
- (lst-lang (cadr (assq (intern org-lang)
- org-man-source-highlight-langs)))
+ (lst-lang
+ (cadr (assq (intern org-lang)
+ (plist-get info :man-source-highlight-langs))))
(cmd (concat (expand-file-name "source-highlight")
" -s " lst-lang
@@ -645,11 +651,12 @@ INFO is a plist holding contextual information. See
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file:" raw-path))
+ ((string= type "file") (org-export-file-uri raw-path))
(t raw-path)))
protocol)
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc 'man))
;; External link with a description part.
((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
;; External link without a description part.
@@ -657,6 +664,16 @@ INFO is a plist holding contextual information. See
;; No path, only description. Try to do something useful.
(t (format "\\fI%s\\fP" desc)))))
+;;;; Node Property
+
+(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."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
;;; Paragraph
@@ -716,6 +733,12 @@ contextual information."
;;; Property Drawer
+(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."
+ (and (org-string-nw-p contents)
+ (format ".RS\n.nf\n%s\n.fi\n.RE" contents)))
;;; Quote Block
@@ -727,15 +750,6 @@ holding contextual information."
quote-block
(format ".RS\n%s\n.RE" contents)))
-;;; Quote Section
-
-(defun org-man-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to Man.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format ".RS\\fI%s\\fP\n.RE\n" value))))
-
;;; Radio Target
@@ -761,7 +775,7 @@ holding contextual information."
"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 (downcase (org-element-property :type special-block))))
+ (let ((type (org-element-property :type special-block)))
(org-man--wrap-label
special-block
(format "%s\n" contents))))
@@ -782,31 +796,22 @@ contextual information."
(continued (org-export-get-loc src-block info))
(new 0)))
(retain-labels (org-element-property :retain-labels src-block)))
- (cond
- ;; Case 1. No source fontification.
- ((not org-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)))
- (org-man-source-highlight
- (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)))
-
+ (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)
- org-man-source-highlight-langs)))
-
+ (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))
@@ -815,7 +820,7 @@ contextual information."
(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)))))))
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code))))))
;;; Statistics Cookie
@@ -868,7 +873,7 @@ CONTENTS is the contents of the table. INFO is a plist holding
contextual information."
(cond
;; Case 1: verbatim table.
- ((or org-man-tables-verbatim
+ ((or (plist-get info :man-tables-verbatim)
(let ((attr (read (format "(%s)"
(mapconcat
#'identity
@@ -943,7 +948,8 @@ This function assumes TABLE has `org' as its `:type' attribute."
(let ((placement (plist-get attr :placement)))
(cond ((string= placement 'center) "center")
((string= placement 'left) nil)
- (t (if org-man-tables-centered "center" ""))))
+ ((plist-get info :man-tables-centered) "center")
+ (t "")))
(or (plist-get attr :boxtype) "box"))))
(title-line (plist-get attr :title-line))
@@ -1018,16 +1024,17 @@ This function assumes TABLE has `org' as its `:type' attribute."
"Transcode a TABLE-CELL element from Org to Man
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
- (concat (if (and contents
- org-man-table-scientific-notation
- (string-match orgtbl-exp-regexp contents))
- ;; Use appropriate format string for scientific
- ;; notation.
- (format org-man-table-scientific-notation
- (match-string 1 contents)
- (match-string 2 contents))
- contents )
- (when (org-export-get-next-element table-cell info) "\t")))
+ (concat
+ (let ((scientific-format (plist-get info :man-table-scientific-notation)))
+ (if (and contents
+ scientific-format
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific notation.
+ (format scientific-format
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents))
+ (when (org-export-get-next-element table-cell info) "\t")))
;;; Table Row
@@ -1065,8 +1072,7 @@ a communication channel."
"Transcode a TARGET object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "\\fI%s\\fP"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "\\fI%s\\fP" (org-export-get-reference target info)))
;;; Timestamp
diff --git a/lisp/ox-md.el b/lisp/ox-md.el
index 99a4ae0..e4291e5 100644
--- a/lisp/ox-md.el
+++ b/lisp/ox-md.el
@@ -1,6 +1,6 @@
;;; ox-md.el --- Markdown Back-End for Org Export Engine
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
;; Keywords: org, wp, markdown
@@ -30,7 +30,7 @@
(eval-when-compile (require 'cl))
(require 'ox-html)
-
+(require 'ox-publish)
;;; User-Configurable Variables
@@ -68,30 +68,29 @@ This variable can be set to either `atx' or `setext'."
(org-open-file (org-md-export-to-markdown nil s v)))))))
:translate-alist '((bold . org-md-bold)
(code . org-md-verbatim)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(example-block . org-md-example-block)
+ (export-block . org-md-export-block)
(fixed-width . org-md-example-block)
- (footnote-definition . ignore)
- (footnote-reference . ignore)
(headline . org-md-headline)
(horizontal-rule . org-md-horizontal-rule)
(inline-src-block . org-md-verbatim)
(inner-template . org-md-inner-template)
(italic . org-md-italic)
(item . org-md-item)
+ (keyword . org-md-keyword)
(line-break . org-md-line-break)
(link . org-md-link)
+ (node-property . org-md-node-property)
(paragraph . org-md-paragraph)
(plain-list . org-md-plain-list)
(plain-text . org-md-plain-text)
+ (property-drawer . org-md-property-drawer)
(quote-block . org-md-quote-block)
- (quote-section . org-md-example-block)
(section . org-md-section)
(src-block . org-md-example-block)
(template . org-md-template)
- (verbatim . org-md-verbatim)))
-
+ (verbatim . org-md-verbatim))
+ :options-alist '((:md-headline-style nil nil org-md-headline-style)))
;;; Filters
@@ -102,28 +101,26 @@ This variable can be set to either `atx' or `setext'."
TREE is the parse tree being exported. BACKEND is the export
back-end used. INFO is a plist used as a communication channel.
-Enforce a blank line between elements. There are three
-exceptions to this rule:
+Enforce a blank line between elements. There are two exceptions
+to this rule:
1. Preserve blank lines between sibling items in a plain list,
- 2. Outside of plain lists, preserve blank lines between
- a paragraph and a plain list,
-
- 3. In an item, remove any blank line before the very first
+ 2. In an item, remove any blank line before the very first
paragraph and the next sub-list.
Assume BACKEND is `md'."
(org-element-map tree (remq 'item org-element-all-elements)
(lambda (e)
- (cond
- ((not (and (eq (org-element-type e) 'paragraph)
- (eq (org-element-type (org-export-get-next-element e info))
- 'plain-list)))
- (org-element-put-property e :post-blank 1))
- ((not (eq (org-element-type (org-element-property :parent e)) 'item)))
- (t (org-element-put-property
- e :post-blank (if (org-export-get-previous-element e info) 1 0))))))
+ (org-element-put-property
+ e :post-blank
+ (if (and (eq (org-element-type e) 'paragraph)
+ (eq (org-element-type (org-element-property :parent e)) 'item)
+ (eq (org-element-type (org-export-get-next-element e info))
+ 'plain-list)
+ (not (org-export-get-previous-element e info)))
+ 0
+ 1))))
;; Return updated tree.
tree)
@@ -155,7 +152,7 @@ channel."
value)))
-;;;; Example Block and Src Block
+;;;; Example Block, Src Block and export Block
(defun org-md-example-block (example-block contents info)
"Transcode EXAMPLE-BLOCK element into Markdown format.
@@ -166,6 +163,14 @@ channel."
(org-remove-indentation
(org-export-format-code-default example-block info))))
+(defun org-md-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to Markdown.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (if (member (org-element-property :type export-block) '("MARKDOWN" "MD"))
+ (org-remove-indentation (org-element-property :value export-block))
+ ;; Also include HTML export blocks.
+ (org-export-with-backend 'html export-block contents info)))
+
;;;; Headline
@@ -190,21 +195,18 @@ a communication channel."
(let ((char (org-element-property :priority headline)))
(and char (format "[#%c] " char)))))
(anchor
- (when (plist-get info :with-toc)
- (org-html--anchor
- (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-"
- (mapconcat 'number-to-string
- (org-export-get-headline-number
- headline info) "-"))))))
+ (and (plist-get info :with-toc)
+ (org-html--anchor
+ (org-export-get-reference headline info) nil nil info)))
;; Headline text without tags.
- (heading (concat todo priority title)))
+ (heading (concat todo priority title))
+ (style (plist-get info :md-headline-style)))
(cond
;; Cannot create a headline. Fall-back to a list.
((or (org-export-low-level-p headline info)
- (not (memq org-md-headline-style '(atx setext)))
- (and (eq org-md-headline-style 'atx) (> level 6))
- (and (eq org-md-headline-style 'setext) (> level 2)))
+ (not (memq style '(atx setext)))
+ (and (eq style 'atx) (> level 6))
+ (and (eq style 'setext) (> level 2)))
(let ((bullet
(if (not (org-export-numbered-headline-p headline info)) "-"
(concat (number-to-string
@@ -216,7 +218,7 @@ a communication channel."
(and contents
(replace-regexp-in-string "^" " " contents)))))
;; Use "Setext" style.
- ((eq org-md-headline-style 'setext)
+ ((eq style 'setext)
(concat heading tags anchor "\n"
(make-string (length heading) (if (= level 1) ?= ?-))
"\n\n"
@@ -271,6 +273,18 @@ a communication channel."
(org-trim (replace-regexp-in-string "^" " " contents))))))
+
+;;;; Keyword
+
+(defun org-md-keyword (keyword contents info)
+ "Transcode a KEYWORD element into Markdown format.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (if (member (org-element-property :key keyword) '("MARKDOWN" "MD"))
+ (org-element-property :value keyword)
+ (org-export-with-backend 'html keyword contents info)))
+
+
;;;; Line Break
(defun org-md-line-break (line-break contents info)
@@ -295,6 +309,8 @@ a communication channel."
raw-path))))
(type (org-element-property :type link)))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link contents 'md))
((member type '("custom-id" "id"))
(let ((destination (org-export-resolve-id-link link info)))
(if (stringp destination) ; External file.
@@ -305,10 +321,13 @@ a communication channel."
(and contents (concat contents " "))
(format "(%s)"
(format (org-export-translate "See section %s" :html info)
- (mapconcat 'number-to-string
- (org-export-get-headline-number
- destination info)
- ".")))))))
+ (if (org-export-numbered-headline-p destination info)
+ (mapconcat #'number-to-string
+ (org-export-get-headline-number
+ destination info)
+ ".")
+ (org-export-data
+ (org-element-property :title destination) info))))))))
((org-export-inline-image-p link org-html-inline-image-rules)
(let ((path (let ((raw-path (org-element-property :path link)))
(if (not (file-name-absolute-p raw-path)) raw-path
@@ -329,32 +348,38 @@ a communication channel."
(if (org-string-nw-p contents) contents
(when destination
(let ((number (org-export-get-ordinal destination info)))
- (when number
- (if (atom number) (number-to-string number)
- (mapconcat 'number-to-string number "."))))))))
- ;; Link type is handled by a special function.
- ((let ((protocol (nth 2 (assoc type org-link-protocols))))
- (and (functionp protocol)
- (funcall protocol
- (org-link-unescape (org-element-property :path link))
- contents
- 'md))))
+ (if number
+ (if (atom number) (number-to-string number)
+ (mapconcat #'number-to-string number "."))
+ ;; Unnumbered headline.
+ (and (eq 'headline (org-element-type destination))
+ ;; BUG: shouldn't headlines have a form like [ref](name) in md?
+ (org-export-data
+ (org-element-property :title destination) info))))))))
(t (let* ((raw-path (org-element-property :path link))
(path
(cond
((member type '("http" "https" "ftp"))
(concat type ":" raw-path))
((string= type "file")
- (let ((path (funcall link-org-files-as-md raw-path)))
- (if (not (file-name-absolute-p path)) path
- ;; If file path is absolute, prepend it
- ;; with "file:" component.
- (concat "file:" path))))
+ (org-export-file-uri (funcall link-org-files-as-md raw-path)))
(t raw-path))))
(if (not contents) (format "<%s>" path)
(format "[%s](%s)" contents path)))))))
+;;;; Node Property
+
+(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."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
+
+
;;;; Paragraph
(defun org-md-paragraph (paragraph contents info)
@@ -403,6 +428,16 @@ contextual information."
text)
+;;;; Property Drawer
+
+(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."
+ (and (org-string-nw-p contents)
+ (replace-regexp-in-string "^" " " contents)))
+
+
;;;; Quote Block
(defun org-md-quote-block (quote-block contents info)
@@ -505,6 +540,16 @@ Return output file's name."
(let ((outfile (org-export-output-file-name ".md" subtreep)))
(org-export-to-file 'md outfile async subtreep visible-only)))
+;;;###autoload
+(defun org-md-publish-to-md (plist filename pub-dir)
+ "Publish an org file to Markdown.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to 'md filename ".md" plist pub-dir))
(provide 'ox-md)
diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el
index 03b3214..e578a17 100644
--- a/lisp/ox-odt.el
+++ b/lisp/ox-odt.el
@@ -1,6 +1,6 @@
;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode
-;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Jambunathan K <kjambunathan at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -59,13 +59,13 @@
(latex-fragment . org-odt-latex-fragment)
(line-break . org-odt-line-break)
(link . org-odt-link)
+ (node-property . org-odt-node-property)
(paragraph . org-odt-paragraph)
(plain-list . org-odt-plain-list)
(plain-text . org-odt-plain-text)
(planning . org-odt-planning)
(property-drawer . org-odt-property-drawer)
(quote-block . org-odt-quote-block)
- (quote-section . org-odt-quote-section)
(radio-target . org-odt-radio-target)
(section . org-odt-section)
(special-block . org-odt-special-block)
@@ -97,6 +97,22 @@
(org-open-file (org-odt-export-to-odt nil s v) 'system))))))
:options-alist
'((:odt-styles-file "ODT_STYLES_FILE" nil nil t)
+ (:description "DESCRIPTION" nil nil newline)
+ (:keywords "KEYWORDS" nil nil space)
+ (:subtitle "SUBTITLE" nil nil parse)
+ ;; Other variables.
+ (:odt-content-template-file nil nil org-odt-content-template-file)
+ (:odt-display-outline-level nil nil org-odt-display-outline-level)
+ (:odt-fontify-srcblocks nil nil org-odt-fontify-srcblocks)
+ (:odt-format-drawer-function nil nil org-odt-format-drawer-function)
+ (:odt-format-headline-function nil nil org-odt-format-headline-function)
+ (:odt-format-inlinetask-function nil nil org-odt-format-inlinetask-function)
+ (:odt-inline-formula-rules nil nil org-odt-inline-formula-rules)
+ (:odt-inline-image-rules nil nil org-odt-inline-image-rules)
+ (:odt-pixels-per-inch nil nil org-odt-pixels-per-inch)
+ (:odt-styles-file nil nil org-odt-styles-file)
+ (:odt-table-styles nil nil org-odt-table-styles)
+ (:odt-use-date-fields nil nil org-odt-use-date-fields)
;; Redefine regular option.
(:with-latex nil "tex" org-odt-with-latex)))
@@ -107,7 +123,6 @@
;;; Function Declarations
-(declare-function org-id-find-id-file "org-id" (id))
(declare-function hfy-face-to-style "htmlfontify" (fn))
(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
(declare-function archive-zip-extract "arc-mode" (archive name))
@@ -119,7 +134,7 @@
;;; Internal Variables
(defconst org-odt-lib-dir
- (file-name-directory load-file-name)
+ (file-name-directory (or load-file-name (buffer-file-name)))
"Location of ODT exporter.
Use this to infer values of `org-odt-styles-dir' and
`org-odt-schema-dir'.")
@@ -192,8 +207,7 @@ heuristically based on the values of `org-odt-lib-dir' and
This directory contains the following XML files -
\"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
XML files are used as the default values of
- `org-odt-styles-file' and
- `org-odt-content-template-file'.
+ `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
@@ -262,7 +276,8 @@ This style is much the same as that of \"OrgFixedWidthBlock\"
except that the foreground and background colors are set
according to the default face identified by the `htmlfontify'.")
-(defvar hfy-optimisations)
+(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
@@ -665,7 +680,8 @@ The default value simply returns the value of CONTENTS."
;;;; Headline
-(defcustom org-odt-format-headline-function 'ignore
+(defcustom org-odt-format-headline-function
+ 'org-odt-format-headline-default-function
"Function to format headline text.
This function will be called with 5 arguments:
@@ -677,14 +693,15 @@ TAGS the tags string, separated with colons \(string or nil\).
The function result will be used as headline text."
:group 'org-export-odt
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type 'function)
;;;; Inlinetasks
-(defcustom org-odt-format-inlinetask-function 'ignore
+(defcustom org-odt-format-inlinetask-function
+ 'org-odt-format-inlinetask-default-function
"Function called to format an inlinetask in ODT code.
The function must accept six parameters:
@@ -697,8 +714,8 @@ The function must accept six parameters:
The function should return the string to be exported."
:group 'org-export-odt
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type 'function)
@@ -749,15 +766,15 @@ link's path."
:value-type (regexp :tag "Path")))
(defcustom org-odt-inline-image-rules
- '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'"))
+ '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'"))
"Rules characterizing image files that can be inlined into ODT.
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 "24.4"
- :package-version '(Org . "8.0")
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type '(alist :key-type (string :tag "Type")
:value-type (regexp :tag "Path")))
@@ -786,8 +803,8 @@ Use the latter option if you do not want the custom styles to be
based on your current display settings. It is necessary that the
styles.xml already contains needed styles for colorizing to work.
-This variable is effective only if
-`org-odt-fontify-srcblocks' is turned on."
+This variable is effective only if `org-odt-fontify-srcblocks' is
+turned on."
:group 'org-export-odt
:version "24.1"
:type 'boolean)
@@ -824,8 +841,7 @@ TABLE-STYLE-NAME is the style associated with the table through
TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
-below) that is included in
-`org-odt-content-template-file'.
+below) that is included in `org-odt-content-template-file'.
TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
\"TableCell\"
@@ -846,7 +862,7 @@ TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' |
`use-banding-rows-styles' |
`use-banding-columns-styles' |
`use-first-row-styles'
-ON-OR-OFF := `t' | `nil'
+ON-OR-OFF := t | nil
For example, with the following configuration
@@ -1068,13 +1084,20 @@ See `org-odt--build-date-styles' for implementation details."
;;;; Table of Contents
-(defun org-odt-begin-toc (index-title depth)
+(defun org-odt--format-toc (title entries depth)
+ "Return a table of contents.
+TITLE is the title of the table, as a string, or nil. ENTRIES is
+the contents of the table, as a string. DEPTH is an integer
+specifying the depth of the table."
(concat
- (format "
- <text:table-of-content text:style-name=\"OrgIndexSection\" text:protected=\"true\" text:name=\"Table of Contents\">
- <text:table-of-content-source text:outline-level=\"%d\">
- <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
-" depth index-title)
+ "
+<text:table-of-content text:style-name=\"OrgIndexSection\" text:protected=\"true\" text:name=\"Table of Contents\">\n"
+ (format " <text:table-of-content-source text:outline-level=\"%d\">" depth)
+ (and title
+ (format "
+ <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
+"
+ title))
(let ((levels (number-sequence 1 10)))
(mapconcat
@@ -1086,23 +1109,21 @@ See `org-odt--build-date-styles' for implementation details."
<text:index-entry-chapter/>
<text:index-entry-text/>
<text:index-entry-link-end/>
- </text:table-of-content-entry-template>
-" level level)) levels ""))
-
- (format "
- </text:table-of-content-source>
-
- <text:index-body>
- <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
- <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
- </text:index-title>
- " index-title)))
-
-(defun org-odt-end-toc ()
- (format "
- </text:index-body>
- </text:table-of-content>
-"))
+ </text:table-of-content-entry-template>\n"
+ level level)) levels ""))
+ "
+ </text:table-of-content-source>
+ <text:index-body>"
+ (and title
+ (format "
+ <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
+ <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
+ </text:index-title>\n"
+ title))
+ entries
+ "
+ </text:index-body>
+</text:table-of-content>"))
(defun* org-odt-format-toc-headline
(todo todo-type priority text tags
@@ -1110,7 +1131,7 @@ See `org-odt--build-date-styles' for implementation details."
(setq text
(concat
;; Section number.
- (when section-number (concat section-number ". "))
+ (and section-number (concat section-number ". "))
;; Todo.
(when todo
(let ((style (if (member todo org-done-keywords)
@@ -1137,7 +1158,12 @@ See `org-odt--build-date-styles' for implementation details."
(format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
headline-label text))
-(defun org-odt-toc (depth info)
+(defun org-odt-toc (depth info &optional scope)
+ "Build a table of contents.
+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))
;; When a headline is marked as a radio target, as in the example below:
;;
@@ -1149,24 +1175,17 @@ See `org-odt--build-date-styles' for implementation details."
;; /TOC/, as otherwise there will be duplicated anchors one in TOC
;; and one in the document body.
;;
- ;; FIXME-1: Currently exported headings are memoized. `org-export.el'
- ;; doesn't provide a way to disable memoization. So this doesn't
- ;; work.
- ;;
- ;; FIXME-2: Are there any other objects that need to be suppressed
+ ;; FIXME: Are there any other objects that need to be suppressed
;; within TOC?
- (let* ((title (org-export-translate "Table of Contents" :utf-8 info))
- (headlines (org-export-collect-headlines
- info (and (wholenump depth) depth)))
+ (let* ((headlines (org-export-collect-headlines info depth scope))
(backend (org-export-create-backend
- :parent (org-export-backend-name
- (plist-get info :back-end))
+ :parent (org-export-backend-name (plist-get info :back-end))
:transcoders (mapcar
(lambda (type) (cons type (lambda (d c i) c)))
(list 'radio-target)))))
(when headlines
- (concat
- (org-odt-begin-toc title depth)
+ (org-odt--format-toc
+ (and (not scope) (org-export-translate "Table of Contents" :utf-8 info))
(mapconcat
(lambda (headline)
(let* ((entry (org-odt-format-headline--wrap
@@ -1176,7 +1195,7 @@ See `org-odt--build-date-styles' for implementation details."
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
style entry)))
headlines "\n")
- (org-odt-end-toc)))))
+ depth))))
;;;; Document styles
@@ -1311,11 +1330,12 @@ CONTENTS is the transcoded contents string. RAW-DATA is the
original parsed data. INFO is a plist holding export options."
;; Write meta file.
(let ((title (org-export-data (plist-get info :title) info))
+ (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 (plist-get info :keywords))
- (description (plist-get info :description)))
+ (keywords (or (plist-get info :keywords) ""))
+ (description (or (plist-get info :description) "")))
(write-region
(concat
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>
@@ -1344,12 +1364,14 @@ original parsed data. INFO is a plist holding export options."
(format "<meta:creation-date>%s</meta:creation-date>\n"
iso-date)))))
(format "<meta:generator>%s</meta:generator>\n"
- (let ((creator-info (plist-get info :with-creator)))
- (if (or (not creator-info) (eq creator-info 'comment)) ""
- (plist-get info :creator))))
+ (plist-get info :creator))
(format "<meta:keyword>%s</meta:keyword>\n" keywords)
(format "<dc:subject>%s</dc:subject>\n" description)
(format "<dc:title>%s</dc:title>\n" title)
+ (when (org-string-nw-p subtitle)
+ (format
+ "<meta:user-defined meta:name=\"subtitle\">%s</meta:user-defined>\n"
+ subtitle))
"\n"
" </office:meta>\n" "</office:document-meta>")
nil (concat org-odt-zip-dir "meta.xml"))
@@ -1364,7 +1386,7 @@ original parsed data. INFO is a plist holding export options."
;; Non-availability of styles.xml is not a critical
;; error. For now, throw an error.
(styles-file (or styles-file
- org-odt-styles-file
+ (plist-get info :odt-styles-file)
(expand-file-name "OrgOdtStyles.xml"
org-odt-styles-dir)
(error "org-odt: Missing styles file?"))))
@@ -1389,7 +1411,7 @@ original parsed data. INFO is a plist holding export options."
(org-odt--zip-extract styles-file "styles.xml" org-odt-zip-dir)))))
(t
(error (format "Invalid specification of styles.xml file: %S"
- org-odt-styles-file))))
+ (plist-get info :odt-styles-file)))))
;; create a manifest entry for styles.xml
(org-odt-create-manifest-file-entry "text/xml" "styles.xml")
@@ -1450,7 +1472,7 @@ original parsed data. INFO is a plist holding export options."
'("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M"))))
(with-temp-buffer
(insert-file-contents
- (or org-odt-content-template-file
+ (or (plist-get info :odt-content-template-file)
(expand-file-name "OrgOdtContentTemplate.xml"
org-odt-styles-dir)))
;; Write automatic styles.
@@ -1464,7 +1486,7 @@ original parsed data. INFO is a plist holding export options."
(when (setq props (or (plist-get props :rel-width) "96"))
(insert (format org-odt-table-style-format style-name props))))
;; - Dump date-styles.
- (when org-odt-use-date-fields
+ (when (plist-get info :odt-use-date-fields)
(insert (org-odt--build-date-styles (car custom-time-fmts)
"OrgDate1")
(org-odt--build-date-styles (cdr custom-time-fmts)
@@ -1483,7 +1505,8 @@ original parsed data. INFO is a plist holding export options."
(lambda (x)
(format
"<text:sequence-decl text:display-outline-level=\"%d\" text:name=\"%s\"/>"
- org-odt-display-outline-level (nth 1 x)))
+ (plist-get info :odt-display-outline-level)
+ (nth 1 x)))
org-odt-category-map-alist "\n")))
;; Position the cursor to document body.
(goto-char (point-min))
@@ -1492,7 +1515,10 @@ original parsed data. INFO is a plist holding export options."
;; Preamble - Title, Author, Date etc.
(insert
- (let* ((title (org-export-data (plist-get info :title) info))
+ (let* ((title (and (plist-get info :with-title)
+ (org-export-data (plist-get info :title) info)))
+ (subtitle (when title
+ (org-export-data (plist-get info :subtitle) info)))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
@@ -1504,10 +1530,20 @@ original parsed data. INFO is a plist holding export options."
;; Title.
(when (org-string-nw-p title)
(concat
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>\n"
"OrgTitle" (format "\n<text:title>%s</text:title>" title))
;; Separator.
- "\n<text:p text:style-name=\"OrgTitle\"/>"))
+ "\n<text:p text:style-name=\"OrgTitle\"/>\n"
+ ;; Subtitle.
+ (when (org-string-nw-p subtitle)
+ (concat
+ (format "<text:p text:style-name=\"OrgSubtitle\">\n%s\n</text:p>\n"
+ (concat
+ "<text:user-defined style:data-style-name=\"N0\" text:name=\"subtitle\">\n"
+ subtitle
+ "</text:user-defined>\n"))
+ ;; Separator.
+ "<text:p text:style-name=\"OrgSubtitle\"/>\n"))))
(cond
((and author (not email))
;; Author only.
@@ -1536,14 +1572,15 @@ original parsed data. INFO is a plist holding export options."
(timestamp (and (not (cdr date))
(eq (org-element-type (car date)) 'timestamp)
(car date))))
- (concat
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "OrgSubtitle"
- (if (and org-odt-use-date-fields timestamp)
- (org-odt--format-timestamp (car date))
- (org-export-data (plist-get info :date) info)))
- ;; Separator
- "<text:p text:style-name=\"OrgSubtitle\"/>"))))))
+ (when date
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (if (and (plist-get info :odt-use-date-fields) timestamp)
+ (org-odt--format-timestamp (car date))
+ (org-export-data date info)))
+ ;; Separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>")))))))
;; Table of Contents
(let* ((with-toc (plist-get info :with-toc))
(depth (and with-toc (if (wholenump with-toc)
@@ -1624,7 +1661,7 @@ channel."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((name (org-element-property :drawer-name drawer))
- (output (funcall org-odt-format-drawer-function
+ (output (funcall (plist-get info :odt-format-drawer-function)
name contents)))
output))
@@ -1678,7 +1715,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(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)))
+ (org-odt-do-format-code (org-element-property :value fixed-width) info))
;;;; Footnote Definition
@@ -1723,9 +1760,10 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgSuperscript" ",")))
;; Transcode footnote reference.
- (let ((n (org-export-get-footnote-number footnote-reference info)))
+ (let ((n (org-export-get-footnote-number footnote-reference info nil t)))
(cond
- ((not (org-export-footnote-first-reference-p footnote-reference info))
+ ((not
+ (org-export-footnote-first-reference-p footnote-reference info nil t))
(funcall --format-footnote-reference n))
;; Inline definitions are secondary strings.
;; Non-inline footnotes definitions are full Org data.
@@ -1754,33 +1792,6 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Headline
-(defun* org-odt-format-headline
- (todo todo-type priority text tags
- &key level section-number headline-label &allow-other-keys)
- (concat
- ;; 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
- "<text:tab/>"
- (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-format-headline--wrap (headline backend info
&optional format-function
&rest extra-keys)
@@ -1803,19 +1814,17 @@ INFO is a plist holding contextual information."
(org-element-property :title headline) backend info))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
- (headline-label (concat "sec-" (mapconcat 'number-to-string
- headline-number "-")))
- (format-function (cond
- ((functionp format-function) format-function)
- ((not (eq org-odt-format-headline-function 'ignore))
- (function*
- (lambda (todo todo-type priority text tags
- &allow-other-keys)
- (funcall org-odt-format-headline-function
- todo todo-type priority text tags))))
- (t 'org-odt-format-headline))))
+ (headline-label (org-export-get-reference headline info))
+ (format-function
+ (if (functionp format-function) format-function
+ (function*
+ (lambda (todo todo-type priority text tags
+ &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
+ todo todo-type priority text tags
:headline-label headline-label :level level
:section-number section-number extra-keys)))
@@ -1830,21 +1839,13 @@ holding contextual information."
(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))
;; Get canonical label for the headline.
- (id (concat "sec-" (mapconcat 'number-to-string
- (org-export-get-headline-number
- headline info) "-")))
- ;; Get user-specified labels for the headline.
- (extra-ids (list (org-element-property :CUSTOM_ID headline)
- (org-element-property :ID headline)))
+ (id (org-export-get-reference headline info))
;; Extra targets.
(extra-targets
- (mapconcat (lambda (x)
- (when x
- (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x)))
- (org-odt--target
- "" (org-export-solidify-link-text x)))))
- extra-ids ""))
+ (let ((id (org-element-property :ID headline)))
+ (if id (org-odt--target "" (concat "ID-" id)) "")))
;; Title.
(anchored-title (org-odt--target full-text id)))
(cond
@@ -1857,8 +1858,7 @@ holding contextual information."
(and (org-export-first-sibling-p headline info)
(format "\n<text:list text:style-name=\"%s\" %s>"
;; Choose style based on list type.
- (if (org-export-numbered-headline-p headline info)
- "OrgNumberedList" "OrgBulletedList")
+ (if numbered "OrgNumberedList" "OrgBulletedList")
;; If top-level list, re-start numbering. Otherwise,
;; continue numbering.
(format "text:continue-numbering=\"%s\""
@@ -1885,12 +1885,41 @@ holding contextual information."
(t
(concat
(format
- "\n<text:h text:style-name=\"%s\" text:outline-level=\"%s\">%s</text:h>"
- (format "Heading_20_%s" level)
+ "\n<text:h text:style-name=\"%s\" text:outline-level=\"%s\" text:is-list-header=\"%s\">%s</text:h>"
+ (format "Heading_20_%s%s"
+ level (if numbered "" "_unnumbered"))
level
+ (if numbered "false" "true")
(concat extra-targets anchored-title))
contents))))))
+(defun org-odt-format-headline-default-function
+ (todo todo-type priority text tags)
+ "Default format function for a headline.
+See `org-odt-format-headline-function' for details."
+ (concat
+ ;; Todo.
+ (when todo
+ (let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> " style todo)))
+ (when priority
+ (let* ((style (format "OrgPriority-%s" priority))
+ (priority (format "[#%c]" priority)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style priority)))
+ ;; Title.
+ text
+ ;; Tags.
+ (when tags
+ (concat
+ "<text:tab/>"
+ (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 " : "))))))
+
;;;; Horizontal Rule
@@ -1932,29 +1961,33 @@ contextual information."
"Transcode an INLINETASK element from Org to ODT.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (cond
- ;; If `org-odt-format-inlinetask-function' is not 'ignore, call it
- ;; with appropriate arguments.
- ((not (eq org-odt-format-inlinetask-function 'ignore))
- (let ((format-function
- (function*
- (lambda (todo todo-type priority text tags
- &key contents &allow-other-keys)
- (funcall org-odt-format-inlinetask-function
- todo todo-type priority text tags contents)))))
- (org-odt-format-headline--wrap
- inlinetask nil info format-function :contents contents)))
- ;; Otherwise, use a default template.
- (t
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "Text_20_body"
- (org-odt--textbox
- (concat
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "OrgInlineTaskHeading"
- (org-odt-format-headline--wrap inlinetask nil info))
- contents)
- nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))))
+ (let* ((todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type inlinetask)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask)))
+ (text (org-export-data (org-element-property :title inlinetask) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info))))
+ (funcall (plist-get info :odt-format-inlinetask-function)
+ todo todo-type priority text tags contents)))
+
+(defun org-odt-format-inlinetask-default-function
+ (todo todo-type priority name tags contents)
+ "Default format function for a inlinetasks.
+See `org-odt-format-inlinetask-function' for details."
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (org-odt--textbox
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgInlineTaskHeading"
+ (org-odt-format-headline-default-function
+ todo todo-type priority name tags))
+ contents)
+ nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))
;;;; Italic
@@ -1998,7 +2031,8 @@ contextual information."
(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."
+CONTENTS is nil. INFO is a plist holding contextual
+information."
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
(cond
@@ -2007,14 +2041,15 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; FIXME
(ignore))
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
+ ((org-string-match-p "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (when (wholenump depth) (org-odt-toc depth info))))
- ((member value '("tables" "figures" "listings"))
+ (plist-get info :headline-levels)))
+ (localp (org-string-match-p "\\<local\\>" value)))
+ (org-odt-toc depth info (and localp keyword))))
+ ((org-string-match-p "tables\\|figures\\|listings" value)
;; FIXME
(ignore))))))))
@@ -2035,7 +2070,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
CONTENTS is nil. INFO is a plist holding contextual information."
(let* ((latex-frag (org-remove-indentation
(org-element-property :value latex-environment))))
- (org-odt-do-format-code latex-frag)))
+ (org-odt-do-format-code latex-frag info)))
;;;; Latex Fragment
@@ -2072,7 +2107,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(let* ((--numbered-parent-headline-at-<=-n
(function
(lambda (element n info)
- (loop for x in (org-export-get-genealogy element)
+ (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)
@@ -2090,7 +2125,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
counter))
info 'first-match)))))
(scope (funcall --numbered-parent-headline-at-<=-n
- element (or n org-odt-display-outline-level) info))
+ element
+ (or n (plist-get info :odt-display-outline-level))
+ info))
(ordinal (funcall --enumerate element scope info predicate))
(tag
(concat
@@ -2116,14 +2153,16 @@ 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)))
- (let* ((caption-from
+ (let* ((element-or-parent
(case (org-element-type element)
(link (org-export-get-parent-element element))
(t element)))
;; Get label and caption.
- (label (org-element-property :name caption-from))
- (caption (org-export-get-caption caption-from))
- (caption (and caption (org-export-data caption info)))
+ (label (and (or (org-element-property :name element)
+ (org-element-property :name element-or-parent))
+ (org-export-get-reference element-or-parent info)))
+ (caption (let ((c (org-export-get-caption element-or-parent)))
+ (and c (org-export-data c info))))
;; FIXME: We don't use short-caption for now
(short-caption nil))
(when (or label caption)
@@ -2154,9 +2193,6 @@ SHORT-CAPTION are strings."
(case op
;; Case 1: Handle Label definition.
(definition
- ;; Assign an internal label, if user has not provided one
- (setq label (org-export-solidify-link-text
- (or label (format "%s-%s" default-category seqno))))
(cons
(concat
;; Sneak in a bookmark. The bookmark is used when the
@@ -2178,14 +2214,13 @@ SHORT-CAPTION are strings."
short-caption))
;; Case 2: Handle Label reference.
(reference
- (assert label)
- (setq label (org-export-solidify-link-text label))
(let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t)))
(fmt1 (car fmt))
(fmt2 (cadr fmt)))
(format "<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:sequence-ref>"
- fmt1 label (format-spec fmt2 `((?e . ,category)
- (?n . ,seqno))))))
+ fmt1
+ label
+ (format-spec fmt2 `((?e . ,category) (?n . ,seqno))))))
(t (error "Unknown %S on label" op))))))))
@@ -2210,8 +2245,8 @@ SHORT-CAPTION are strings."
(org-odt-create-manifest-file-entry media-type target-file)
target-file))
-(defun org-odt--image-size (file &optional user-width
- user-height scale dpi embed-as)
+(defun org-odt--image-size
+ (file info &optional user-width user-height scale dpi embed-as)
(let* ((--pixels-to-cms
(function (lambda (pixels dpi)
(let ((cms-per-inch 2.54)
@@ -2223,7 +2258,7 @@ SHORT-CAPTION are strings."
(and size-in-pixels
(cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
(funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))
- (dpi (or dpi org-odt-pixels-per-inch))
+ (dpi (or dpi (plist-get info :odt-pixels-per-inch)))
(anchor-type (or embed-as "paragraph"))
(user-width (and (not scale) user-width))
(user-height (and (not scale) user-height))
@@ -2312,7 +2347,7 @@ used as a communication channel."
;; Handle `:width', `:height' and `:scale' properties. Read
;; them as numbers since we need them for computations.
(size (org-odt--image-size
- src-expanded
+ src-expanded info
(let ((width (plist-get attr-plist :width)))
(and width (read width)))
(let ((length (plist-get attr-plist :length)))
@@ -2341,7 +2376,7 @@ used as a communication channel."
;; description. This quite useful for debugging.
(desc (and replaces (org-element-property :value replaces))))
(org-odt--render-image/formula entity href width height
- captions user-frame-params title desc)))
+ captions user-frame-params title desc)))
;;;; Links :: Math formula
@@ -2543,7 +2578,7 @@ used as a communication channel."
;; Link should point to an image file.
(lambda (l)
(assert (eq (org-element-type l) 'link))
- (org-export-inline-image-p l org-odt-inline-image-rules))))
+ (org-export-inline-image-p l (plist-get info :odt-inline-image-rules)))))
(defun org-odt--enumerable-latex-image-p (element info)
(org-odt--standalone-link-p
@@ -2558,7 +2593,7 @@ used as a communication channel."
;; Link should point to an image file.
(lambda (l)
(assert (eq (org-element-type l) 'link))
- (org-export-inline-image-p l org-odt-inline-image-rules))))
+ (org-export-inline-image-p l (plist-get info :odt-inline-image-rules)))))
(defun org-odt--enumerable-formula-p (element info)
(org-odt--standalone-link-p
@@ -2570,7 +2605,7 @@ used as a communication channel."
;; Link should point to a MathML or ODF file.
(lambda (l)
(assert (eq (org-element-type l) 'link))
- (org-export-inline-image-p l org-odt-inline-formula-rules))))
+ (org-export-inline-image-p l (plist-get info :odt-inline-formula-rules)))))
(defun org-odt--standalone-link-p (element info &optional
paragraph-predicate
@@ -2610,11 +2645,12 @@ Return nil, otherwise."
(t nil))))))))
(defun org-odt-link--infer-description (destination info)
- ;; DESTINATION is a HEADLINE, a "<<target>>" or an element (like
- ;; paragraph, verse-block etc) to which a "#+NAME: label" can be
- ;; attached. Note that labels that are attached to captioned
- ;; entities - inline images, math formulae and tables - get resolved
- ;; as part of `org-odt-format-label' and `org-odt--enumerate'.
+ ;; DESTINATION is a headline or an element (like paragraph,
+ ;; verse-block etc) to which a "#+NAME: label" can be attached.
+
+ ;; Note that labels that are attached to captioned entities - inline
+ ;; images, math formulae and tables - get resolved as part of
+ ;; `org-odt-format-label' and `org-odt--enumerate'.
;; Create a cross-reference to DESTINATION but make best-efforts to
;; create a *meaningful* description. Check item numbers, section
@@ -2622,16 +2658,12 @@ Return nil, otherwise."
;; NOTE: Counterpart of `org-export-get-ordinal'.
;; FIXME: Handle footnote-definition footnote-reference?
- (let* ((genealogy (org-export-get-genealogy destination))
+ (let* ((genealogy (org-element-lineage destination))
(data (reverse genealogy))
- (label (case (org-element-type destination)
- (headline
- (format "sec-%s" (mapconcat 'number-to-string
- (org-export-get-headline-number
- destination info) "-")))
- (target
- (org-element-property :value destination))
- (t (error "FIXME: Resolve %S" destination)))))
+ (label (let ((type (org-element-type destination)))
+ (if (memq type '(headline target))
+ (org-export-get-reference destination info)
+ (error "FIXME: Unable to resolve %S" destination)))))
(or
(let* ( ;; Locate top-level list.
(top-level-list
@@ -2668,21 +2700,25 @@ Return nil, otherwise."
(let ((item-numbers (append listified-headline-nos item-numbers)))
(when (and item-numbers (not (memq nil item-numbers)))
(format "<text:bookmark-ref text:reference-format=\"number-all-superior\" text:ref-name=\"%s\">%s</text:bookmark-ref>"
- (org-export-solidify-link-text label)
+ label
(mapconcat (lambda (n) (if (not n) " "
- (concat (number-to-string n) ".")))
+ (concat (number-to-string n) ".")))
item-numbers "")))))
;; Case 2: Locate a regular and numbered headline in the
;; hierarchy. Display its section number.
- (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))
- (org-export-numbered-headline-p el info))
- return el)))
+ (let ((headline
+ (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))))
;; We found one.
(when headline
(format "<text:bookmark-ref text:reference-format=\"chapter\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
- (org-export-solidify-link-text label)
+ label
(mapconcat 'number-to-string (org-export-get-headline-number
headline info) "."))))
;; Case 4: Locate a regular headline in the hierarchy. Display
@@ -2694,7 +2730,7 @@ Return nil, otherwise."
;; We found one.
(when headline
(format "<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
- (org-export-solidify-link-text label)
+ label
(let ((title (org-element-property :title headline)))
(org-export-data title info)))))
(error "FIXME?"))))
@@ -2710,24 +2746,24 @@ INFO is a plist holding contextual information. See
;; Ensure DESC really exists, or set it to nil.
(desc (and (not (string= desc "")) desc))
(imagep (org-export-inline-image-p
- link org-odt-inline-image-rules))
+ link (plist-get info :odt-inline-image-rules)))
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file:" raw-path))
+ ((string= type "file") (org-export-file-uri raw-path))
(t raw-path)))
;; Convert & to &amp; for correct XML representation
- (path (replace-regexp-in-string "&" "&amp;" path))
- protocol)
+ (path (replace-regexp-in-string "&" "&amp;" path)))
(cond
+ ;; 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 org-odt-inline-image-rules))
+ link (plist-get info :odt-inline-image-rules)))
(org-odt-link--inline-image link info))
;; Formula file.
((and (not desc) (org-export-inline-image-p
- link org-odt-inline-formula-rules))
+ 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.
@@ -2736,8 +2772,7 @@ INFO is a plist holding contextual information. See
(if (not destination) desc
(format
"<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
- (org-export-solidify-link-text
- (org-element-property :value destination))
+ (org-export-get-reference destination info)
desc))))
;; Links pointing to a headline: Find destination and build
;; appropriate referencing command.
@@ -2758,11 +2793,10 @@ INFO is a plist holding contextual information. See
;; If there's a description, create a hyperlink.
;; Otherwise, try to provide a meaningful description.
(if (not desc) (org-odt-link--infer-description destination info)
- (let* ((headline-no
- (org-export-get-headline-number destination info))
- (label
- (format "sec-%s"
- (mapconcat 'number-to-string headline-no "-"))))
+ (let ((label
+ (or (and (string= type "custom-id")
+ (org-element-property :CUSTOM_ID destination))
+ (org-export-get-reference destination info))))
(format
"<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
label desc))))
@@ -2770,30 +2804,29 @@ INFO is a plist holding contextual information. See
(target
;; If there's a description, create a hyperlink.
;; Otherwise, try to provide a meaningful description.
- (if (not desc) (org-odt-link--infer-description destination info)
- (let ((label (org-element-property :value destination)))
- (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
- (org-export-solidify-link-text label)
- desc))))
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ (org-export-get-reference destination info)
+ (or desc (org-export-get-ordinal destination info))))
;; Case 4: Fuzzy link points to some element (e.g., an
;; inline image, a math formula or a table).
(otherwise
(let ((label-reference
- (ignore-errors (org-odt-format-label
- destination info 'reference))))
- (cond ((not label-reference)
- (org-odt-link--infer-description destination info))
- ;; LINK has no description. Create
- ;; a cross-reference showing entity's sequence
- ;; number.
- ((not desc) label-reference)
- ;; LINK has description. Insert a hyperlink with
- ;; user-provided description.
- (t
- (let ((label (org-element-property :name destination)))
- (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
- (org-export-solidify-link-text label)
- desc)))))))))
+ (ignore-errors
+ (org-odt-format-label destination info 'reference))))
+ (cond
+ ((not label-reference)
+ (org-odt-link--infer-description destination info))
+ ;; LINK has no description. Create
+ ;; a cross-reference showing entity's sequence
+ ;; number.
+ ((not desc) label-reference)
+ ;; LINK has description. Insert a hyperlink with
+ ;; user-provided description.
+ (t
+ (format
+ "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ (org-export-get-reference destination info)
+ desc))))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
@@ -2804,9 +2837,6 @@ INFO is a plist holding contextual information. See
(format
"<text:bookmark-ref text:reference-format=\"number\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
href line-no))))
- ;; Link type is handled by a special function.
- ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
- (funcall protocol (org-link-unescape path) desc 'odt))
;; External link with a description part.
((and path desc)
(let ((link-contents (org-element-contents link)))
@@ -2815,7 +2845,8 @@ INFO is a plist holding contextual information. See
(let ((desc-element (car link-contents)))
(and (eq (org-element-type desc-element) 'link)
(org-export-inline-image-p
- desc-element org-odt-inline-image-rules))))
+ desc-element
+ (plist-get info :odt-inline-image-rules)))))
;; Format link as a clickable image.
(format "\n<draw:a xlink:type=\"simple\" xlink:href=\"%s\">\n%s\n</draw:a>"
path desc)
@@ -2831,6 +2862,18 @@ INFO is a plist holding contextual information. See
"Emphasis" desc)))))
+;;;; Node Property
+
+(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."
+ (org-odt--encode-plain-text
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) "")))))
+
;;;; Paragraph
(defun org-odt--paragraph-style (paragraph)
@@ -2979,11 +3022,11 @@ channel."
(defun org-odt-property-drawer (property-drawer contents info)
"Transcode a PROPERTY-DRAWER element from Org to ODT.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- ;; The property drawer isn't exported but we want separating blank
- ;; lines nonetheless.
- "")
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format "<text:p text:style-name=\"OrgFixedWidthBlock\">%s</text:p>"
+ contents)))
;;;; Quote Block
@@ -2995,16 +3038,6 @@ holding contextual information."
contents)
-;;;; Quote Section
-
-(defun org-odt-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to ODT.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (org-odt-do-format-code value))))
-
-
;;;; Section
(defun org-odt-format-section (text style &optional name)
@@ -3027,9 +3060,7 @@ holding contextual information."
"Transcode a RADIO-TARGET object from Org to ODT.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- (org-odt--target
- text (org-export-solidify-link-text
- (org-element-property :value radio-target))))
+ (org-odt--target text (org-export-get-reference radio-target info)))
;;;; Special Block
@@ -3038,7 +3069,7 @@ contextual information."
"Transcode a SPECIAL-BLOCK element from Org to ODT.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let ((type (downcase (org-element-property :type special-block)))
+ (let ((type (org-element-property :type special-block))
(attributes (org-export-read-attribute :attr_odt special-block)))
(cond
;; Annotation.
@@ -3116,8 +3147,8 @@ and prefix with \"OrgSrc\". For example,
(" " "<text:s/>")
(" " "<text:tab/>")))
(hfy-face-to-css 'org-odt-hfy-face-to-css)
- (hfy-optimisations-1 (copy-sequence hfy-optimisations))
- (hfy-optimisations (add-to-list 'hfy-optimisations-1
+ (hfy-optimizations-1 (copy-sequence hfy-optimizations))
+ (hfy-optimizations (add-to-list 'hfy-optimizations-1
'body-text-only))
(hfy-begin-span-handler
(lambda (style text-block text-id text-begins-block-p)
@@ -3126,20 +3157,20 @@ and prefix with \"OrgSrc\". For example,
(org-no-warnings (htmlfontify-string line))))
(defun org-odt-do-format-code
- (code &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"))
(code-length (length code-lines))
(use-htmlfontify-p (and (functionp lang-mode)
- org-odt-fontify-srcblocks
+ (plist-get info :odt-fontify-srcblocks)
(require 'htmlfontify nil t)
(fboundp 'htmlfontify-string)))
(code (if (not use-htmlfontify-p) code
(with-temp-buffer
(insert code)
(funcall lang-mode)
- (font-lock-fontify-buffer)
+ (font-lock-ensure)
(buffer-string))))
(fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string
'org-odt--encode-plain-text))
@@ -3187,7 +3218,7 @@ and prefix with \"OrgSrc\". For example,
(num-start (case (org-element-property :number-lines element)
(continued (org-export-get-loc element info))
(new 0))))
- (org-odt-do-format-code code lang refs retain-labels num-start)))
+ (org-odt-do-format-code code info lang refs retain-labels num-start)))
(defun org-odt-src-block (src-block contents info)
"Transcode a SRC-BLOCK element from Org to ODT.
@@ -3254,13 +3285,13 @@ contextual information."
(let* ((table (org-export-get-parent-table element))
(table-attributes (org-export-read-attribute :attr_odt table))
(table-style (plist-get table-attributes :style)))
- (assoc table-style org-odt-table-styles)))
+ (assoc table-style (plist-get info :odt-table-styles))))
(defun org-odt-get-table-cell-styles (table-cell info)
"Retrieve styles applicable to a table cell.
R and C are (zero-based) row and column numbers of the table
cell. STYLE-SPEC is an entry in `org-odt-table-styles'
-applicable to the current table. It is `nil' if the table is not
+applicable to the current table. It is nil if the table is not
associated with any style attributes.
Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
@@ -3496,7 +3527,7 @@ pertaining to indentation here."
(--walk-list-genealogy-and-collect-tags
(function
(lambda (table info)
- (let* ((genealogy (org-export-get-genealogy table))
+ (let* ((genealogy (org-element-lineage table))
(list-genealogy
(when (eq (org-element-type (car genealogy)) 'item)
(loop for el in genealogy
@@ -3638,8 +3669,7 @@ pertaining to indentation here."
"Transcode a TARGET object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((value (org-element-property :value target)))
- (org-odt--target "" (org-export-solidify-link-text value))))
+ (org-odt--target "" (org-export-get-reference target info)))
;;;; Timestamp
@@ -3649,8 +3679,8 @@ information."
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)))
- (if (not org-odt-use-date-fields)
+ (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)
@@ -3686,7 +3716,7 @@ channel."
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgDiaryTimestamp"
(org-odt-plain-text (org-timestamp-translate timestamp)
- info)))))))
+ info)))))))
;;;; Underline
@@ -3776,7 +3806,8 @@ contextual information."
(file-name-nondirectory input-file))))
(display-msg
(case processing-type
- ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count))
+ ((dvipng imagemagick)
+ (format "Creating LaTeX Image %d..." count))
(mathml (format "Creating MathML snippet %d..." count))))
;; Get an Org-style link to PNG image or the MathML
;; file.
@@ -3785,49 +3816,48 @@ contextual information."
(insert latex-frag)
(org-format-latex cache-subdir cache-dir
nil display-msg
- nil nil processing-type)
+ nil processing-type)
(buffer-substring-no-properties
(point-min) (point-max)))))
- (if (not (string-match "file:\\([^]]*\\)" link))
- (prog1 nil (message "LaTeX Conversion failed."))
- link))))
+ (if (org-string-match-p "file:\\([^]]*\\)" link) link
+ (message "LaTeX Conversion failed.")
+ nil))))
(when org-link
- ;; Conversion succeeded. Parse above Org-style link to a
- ;; `link' object.
- (let* ((link (car (org-element-map (with-temp-buffer
- (org-mode)
- (insert org-link)
- (org-element-parse-buffer))
- 'link 'identity))))
- ;; Orphan the link.
- (org-element-put-property link :parent nil)
- (let* (
- (replacement
- (case (org-element-type latex-*)
- ;; Case 1: LaTeX environment.
- ;; Mimic a "standalone image or formula" by
- ;; enclosing the `link' in a `paragraph'.
- ;; Copy over original attributes, captions to
- ;; the enclosing paragraph.
- (latex-environment
- (org-element-adopt-elements
- (list 'paragraph
- (list :style "OrgFormula"
- :name (org-element-property :name
- latex-*)
- :caption (org-element-property :caption
- latex-*)))
- link))
- ;; Case 2: LaTeX fragment.
- ;; No special action.
- (latex-fragment link))))
- ;; Note down the object that link replaces.
- (org-element-put-property replacement :replaces
- (list (org-element-type latex-*)
- (list :value latex-frag)))
- ;; Replace now.
- (org-element-set-element latex-* replacement))))))
- info)))
+ ;; Conversion succeeded. Parse above Org-style link to
+ ;; a `link' object.
+ (let* ((link
+ (org-element-map
+ (org-element-parse-secondary-string org-link '(link))
+ 'link #'identity info t))
+ (replacement
+ (case (org-element-type latex-*)
+ ;; Case 1: LaTeX environment. Mimic
+ ;; a "standalone image or formula" by
+ ;; enclosing the `link' in a `paragraph'.
+ ;; Copy over original attributes, captions to
+ ;; the enclosing paragraph.
+ (latex-environment
+ (org-element-adopt-elements
+ (list 'paragraph
+ (list :style "OrgFormula"
+ :name
+ (org-element-property :name latex-*)
+ :caption
+ (org-element-property :caption latex-*)))
+ link))
+ ;; Case 2: LaTeX fragment. No special action.
+ (latex-fragment link))))
+ ;; Note down the object that link replaces.
+ (org-element-put-property replacement :replaces
+ (list (org-element-type latex-*)
+ (list :value latex-frag)))
+ ;; Restore blank after initial element or object.
+ (org-element-put-property
+ replacement :post-blank
+ (org-element-property :post-blank latex-*))
+ ;; Replace now.
+ (org-element-set-element latex-* replacement)))))
+ info nil nil t)))
tree)
diff --git a/lisp/ox-org.el b/lisp/ox-org.el
index 195b9d7..82262e0 100644
--- a/lisp/ox-org.el
+++ b/lisp/ox-org.el
@@ -1,6 +1,6 @@
;;; ox-org.el --- Org Back-End for Org Export Engine
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
;; Keywords: org, wp
@@ -57,8 +57,6 @@ setting of `org-html-htmlize-output-type' is 'css."
(center-block . org-org-identity)
(clock . org-org-identity)
(code . org-org-identity)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(diary-sexp . org-org-identity)
(drawer . org-org-identity)
(dynamic-block . org-org-identity)
@@ -78,14 +76,14 @@ setting of `org-html-htmlize-output-type' is 'css."
(latex-environment . org-org-identity)
(latex-fragment . org-org-identity)
(line-break . org-org-identity)
- (link . org-org-identity)
+ (link . org-org-link)
(node-property . org-org-identity)
+ (template . org-org-template)
(paragraph . org-org-identity)
(plain-list . org-org-identity)
(planning . org-org-identity)
(property-drawer . org-org-identity)
(quote-block . org-org-identity)
- (quote-section . org-org-identity)
(radio-target . org-org-identity)
(section . org-org-section)
(special-block . org-org-identity)
@@ -135,15 +133,52 @@ CONTENTS is its contents, as a string or nil. INFO is ignored."
(defun org-org-keyword (keyword contents info)
"Transcode KEYWORD element back into Org syntax.
-CONTENTS is nil. INFO is ignored. This function ignores
-keywords targeted at other export back-ends."
- (unless (member (org-element-property :key keyword)
- (mapcar
- (lambda (block-cons)
- (and (eq (cdr block-cons) 'org-element-export-block-parser)
- (car block-cons)))
- org-element-block-name-alist))
- (org-element-keyword-interpreter keyword nil)))
+CONTENTS is nil. INFO is ignored."
+ (let ((key (org-element-property :key keyword)))
+ (unless (member key
+ '("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE"))
+ (org-element-keyword-interpreter keyword nil))))
+
+(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."
+ (or (org-export-custom-protocol-maybe link contents 'org)
+ (org-element-link-interpreter link contents)))
+
+(defun org-org-template (contents info)
+ "Return Org document template with document keywords.
+CONTENTS is the transcoded contents string. INFO is a plist used
+as a communication channel."
+ (concat
+ (and (plist-get info :time-stamp-file)
+ (format-time-string "# Created %Y-%m-%d %a %H:%M\n"))
+ (org-element-normalize-string
+ (mapconcat #'identity
+ (org-element-map (plist-get info :parse-tree) 'keyword
+ (lambda (k)
+ (and (string-equal (org-element-property :key k) "OPTIONS")
+ (concat "#+OPTIONS: "
+ (org-element-property :value k)))))
+ "\n"))
+ (and (plist-get info :with-title)
+ (format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info)))
+ (and (plist-get info :with-date)
+ (let ((date (org-export-data (org-export-get-date info) info)))
+ (and (org-string-nw-p date)
+ (format "#+DATE: %s\n" date))))
+ (and (plist-get info :with-author)
+ (let ((author (org-export-data (plist-get info :author) info)))
+ (and (org-string-nw-p author)
+ (format "#+AUTHOR: %s\n" author))))
+ (and (plist-get info :with-email)
+ (let ((email (org-export-data (plist-get info :email) info)))
+ (and (org-string-nw-p email)
+ (format "#+EMAIL: %s\n" email))))
+ (and (plist-get info :with-creator)
+ (org-string-nw-p (plist-get info :creator))
+ (format "#+CREATOR: %s\n" (plist-get info :creator)))
+ contents))
(defun org-org-section (section contents info)
"Transcode SECTION element back into Org syntax.
@@ -173,7 +208,8 @@ a communication channel."
(make-string (or (org-element-property :post-blank section) 0) ?\n)))
;;;###autoload
-(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist)
+(defun org-org-export-as-org
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an Org buffer.
If narrowing is active in the current buffer, only export its
@@ -192,6 +228,9 @@ first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
+When optional argument BODY-ONLY is non-nil, strip document
+keywords from output.
+
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
@@ -201,10 +240,11 @@ be displayed when `org-export-show-temporary-export-buffer' is
non-nil."
(interactive)
(org-export-to-buffer 'org "*Org ORG Export*"
- async subtreep visible-only nil ext-plist (lambda () (org-mode))))
+ async subtreep visible-only body-only ext-plist (lambda () (org-mode))))
;;;###autoload
-(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist)
+(defun org-org-export-to-org
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an org file.
If narrowing is active in the current buffer, only export its
@@ -223,6 +263,9 @@ first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
+When optional argument BODY-ONLY is non-nil, strip document
+keywords from output.
+
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
@@ -231,7 +274,7 @@ Return output file name."
(interactive)
(let ((outfile (org-export-output-file-name ".org" subtreep)))
(org-export-to-file 'org outfile
- async subtreep visible-only nil ext-plist)))
+ async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-org-publish-to-org (plist filename pub-dir)
@@ -251,12 +294,13 @@ Return output file name."
(html-ext (concat "." (or (plist-get plist :html-extension)
org-html-extension "html")))
(visitingp (find-buffer-visiting filename))
- (work-buffer (or visitingp (find-file filename)))
+ (work-buffer (or visitingp (find-file-noselect filename)))
newbuf)
- (font-lock-fontify-buffer)
- (show-all)
- (org-show-block-all)
- (setq newbuf (htmlize-buffer))
+ (with-current-buffer work-buffer
+ (font-lock-ensure)
+ (show-all)
+ (org-show-block-all)
+ (setq newbuf (htmlize-buffer)))
(with-current-buffer newbuf
(when org-org-htmlized-css-url
(goto-char (point-min))
@@ -265,10 +309,12 @@ Return output file name."
(replace-match
(format
"<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
- org-org-htmlized-css-url) t t)))
+ org-org-htmlized-css-url)
+ t t)))
(write-file (concat pub-dir (file-name-nondirectory filename) html-ext)))
(kill-buffer newbuf)
(unless visitingp (kill-buffer work-buffer)))
+ ;; FIXME: Why? Which buffer is this supposed to apply to?
(set-buffer-modified-p nil)))
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index efc70d2..9f49f24 100644
--- a/lisp/ox-publish.el
+++ b/lisp/ox-publish.el
@@ -1,5 +1,5 @@
;;; ox-publish.el --- Publish Related Org Mode Files as a Website
-;; Copyright (C) 2006-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
@@ -54,6 +54,12 @@
"This will cache timestamps and titles for files in publishing projects.
Blocks could hash sha1 values here.")
+(defvar org-publish-after-publishing-hook nil
+ "Hook run each time a file is published.
+Every function in this hook will be called with two arguments:
+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."
:tag "Org Publishing"
@@ -169,7 +175,9 @@ included. See the back-end documentation for more information.
:with-footnotes `org-export-with-footnotes'
:with-inlinetasks `org-export-with-inlinetasks'
:with-latex `org-export-with-latex'
+ :with-planning `org-export-with-planning'
:with-priority `org-export-with-priority'
+ :with-properties `org-export-with-properties'
:with-smart-quotes `org-export-with-smart-quotes'
:with-special-strings `org-export-with-special-strings'
:with-statistics-cookies' `org-export-with-statistics-cookies'
@@ -179,7 +187,7 @@ included. See the back-end documentation for more information.
:with-tags `org-export-with-tags'
:with-tasks `org-export-with-tasks'
:with-timestamps `org-export-with-timestamps'
- :with-planning `org-export-with-planning'
+ :with-title `org-export-with-title'
:with-todo-keywords `org-export-with-todo-keywords'
The following properties may be used to control publishing of
@@ -228,7 +236,7 @@ If you create a site-map file, adjust the sorting like this:
`:sitemap-sort-files'
The site map is normally sorted alphabetically. You can
- change this behaviour setting this to `anti-chronologically',
+ change this behavior setting this to `anti-chronologically',
`chronologically', or nil.
`:sitemap-ignore-case'
@@ -575,7 +583,7 @@ Return output file name."
(body-p (plist-get plist :body-only)))
(org-export-to-file backend output-file
nil nil nil body-p
- ;; Add `org-publish-collect-numbering' and
+ ;; 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
@@ -583,7 +591,7 @@ Return output file name."
(org-combine-plists
plist
`(:filter-final-output
- ,(cons 'org-publish-collect-numbering
+ ,(cons 'org-publish--collect-references
(cons 'org-publish-collect-index
(plist-get plist :filter-final-output))))))))
;; Remove opened buffer in the process.
@@ -599,11 +607,12 @@ publishing directory.
Return output file name."
(unless (file-directory-p pub-dir)
(make-directory pub-dir t))
- (or (equal (expand-file-name (file-name-directory filename))
- (file-name-as-directory (expand-file-name pub-dir)))
- (copy-file filename
- (expand-file-name (file-name-nondirectory filename) pub-dir)
- t)))
+ (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir)))
+ (or (equal (expand-file-name (file-name-directory filename))
+ (file-name-as-directory (expand-file-name pub-dir)))
+ (copy-file filename output t))
+ ;; Return file name.
+ output))
@@ -624,8 +633,10 @@ See `org-publish-projects'."
(project-plist (cdr project))
(ftname (expand-file-name filename))
(publishing-function
- (or (plist-get project-plist :publishing-function)
- (error "No publishing function chosen")))
+ (let ((fun (plist-get project-plist :publishing-function)))
+ (cond ((null fun) (error "No publishing function chosen"))
+ ((listp fun) fun)
+ (t (list fun)))))
(base-dir
(file-name-as-directory
(expand-file-name
@@ -647,19 +658,14 @@ See `org-publish-projects'."
(concat pub-dir
(and (string-match (regexp-quote base-dir) ftname)
(substring ftname (match-end 0))))))
- (if (listp publishing-function)
- ;; allow chain of publishing functions
- (mapc (lambda (f)
- (when (org-publish-needed-p
- filename pub-dir f tmp-pub-dir base-dir)
- (funcall f project-plist filename tmp-pub-dir)
- (org-publish-update-timestamp filename pub-dir f base-dir)))
- publishing-function)
- (when (org-publish-needed-p
- filename pub-dir publishing-function tmp-pub-dir base-dir)
- (funcall publishing-function project-plist filename tmp-pub-dir)
- (org-publish-update-timestamp
- filename pub-dir publishing-function base-dir)))
+ ;; Allow chain of publishing functions.
+ (dolist (f publishing-function)
+ (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
+ (let ((output (funcall f project-plist filename tmp-pub-dir)))
+ (org-publish-update-timestamp filename pub-dir f base-dir)
+ (run-hook-with-args 'org-publish-after-publishing-hook
+ filename
+ output))))
(unless no-cache (org-publish-write-cache-file))))
(defun org-publish-projects (projects)
@@ -833,17 +839,15 @@ time in `current-time' format."
(date (plist-get
(with-current-buffer file-buf
(if visiting
- (org-export-with-buffer-copy (org-export-get-environment))
+ (org-export-with-buffer-copy
+ (org-export-get-environment))
(org-export-get-environment)))
:date)))
(unless visiting (kill-buffer file-buf))
- ;; DATE is either a timestamp object or a secondary string. If it
- ;; is a timestamp or if the secondary string contains a timestamp,
+ ;; DATE is a secondary string. If it contains a timestamp,
;; convert it to internal format. Otherwise, use FILE
;; modification time.
- (cond ((eq (org-element-type date) 'timestamp)
- (org-time-string-to-time (org-element-interpret-data date)))
- ((let ((ts (and (consp date) (assq 'timestamp date))))
+ (cond ((let ((ts (and (consp date) (assq 'timestamp date))))
(and ts
(let ((value (org-element-interpret-data ts)))
(and (org-string-nw-p value)
@@ -870,25 +874,28 @@ 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)
- org-publish-project-alist)
- current-prefix-arg))
- (let ((project-alist (if (not (stringp project)) (list project)
- ;; If this function is called in batch mode,
- ;; project is still a string here.
- (list (assoc project org-publish-project-alist)))))
- (if async
- (org-export-async-start (lambda (results) nil)
- `(let ((org-publish-use-timestamps-flag
- (if ',force nil ,org-publish-use-timestamps-flag)))
- (org-publish-projects ',project-alist)))
- (save-window-excursion
- (let* ((org-publish-use-timestamps-flag
- (if force nil org-publish-use-timestamps-flag)))
- (org-publish-projects project-alist))))))
+ (list (assoc (org-icompleting-read "Publish project: "
+ org-publish-project-alist nil t)
+ org-publish-project-alist)
+ current-prefix-arg))
+ (let ((project (if (not (stringp project)) project
+ ;; If this function is called in batch mode,
+ ;; PROJECT is still a string here.
+ (assoc project org-publish-project-alist))))
+ (cond
+ ((not project))
+ (async
+ (org-export-async-start (lambda (results) nil)
+ `(let ((org-publish-use-timestamps-flag
+ ,(and (not force) org-publish-use-timestamps-flag)))
+ ;; Expand components right now as external process may not
+ ;; be aware of complete `org-publish-project-alist'.
+ (org-publish-projects
+ ',(org-publish-expand-projects (list project))))))
+ (t (save-window-excursion
+ (let ((org-publish-use-timestamps-flag
+ (and (not force) org-publish-use-timestamps-flag)))
+ (org-publish-projects (list project))))))))
;;;###autoload
(defun org-publish-all (&optional force async)
@@ -1061,31 +1068,103 @@ 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-numbering (output backend info)
+(defun org-publish--collect-references (output backend info)
+ "Store headlines 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
+`org-publish-org-to'."
(org-publish-cache-set-file-property
- (plist-get info :input-file) :numbering
- (mapcar (lambda (entry)
- (cons (org-split-string
- (replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (org-element-property :raw-value (car entry))))
- (cdr entry)))
- (plist-get info :headline-numbering)))
+ (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))
;; Return output unchanged.
output)
-(defun org-publish-resolve-external-fuzzy-link (file fuzzy)
- "Return numbering for headline matching FUZZY search in FILE.
-
-Return value is a list of numbers, or nil. This function allows
-to resolve external fuzzy links like:
-
- [[file.org::*fuzzy][description]]"
- (when org-publish-cache
- (cdr (assoc (org-split-string
- (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy))
- (org-publish-cache-get-file-property
- (expand-file-name file) :numbering nil t)))))
+(defun org-publish-resolve-external-link (search file)
+ "Return reference for elements or objects matching SEARCH in FILE.
+
+Return value is an internal reference, as a string.
+
+This function allows to resolve external links like:
+
+ [[file.org::*fuzzy][description]]
+ [[file.org::#custom-id][description]]
+ [[file.org::fuzzy][description]]"
+ (if (not org-publish-cache)
+ (progn
+ (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")))))
@@ -1164,22 +1243,30 @@ the file including them will be republished as well."
(org-inhibit-startup t)
(visiting (find-buffer-visiting filename))
included-files-ctime buf)
-
(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
- "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
- (let* ((included-file (expand-file-name (match-string 1))))
- (add-to-list 'included-files-ctime
- (org-publish-cache-ctime-of-src included-file) t))))
+ (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-+\\)" value)
+ (org-remove-double-quotes
+ (match-string 1 value)))))))
+ (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))
+ (not (null (delq nil (mapcar (lambda (ct) (< ctime ct))
included-files-ctime))))))))))
(defun org-publish-cache-set-file-property
diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el
index 37841d7..df56b67 100644
--- a/lisp/ox-texinfo.el
+++ b/lisp/ox-texinfo.el
@@ -1,6 +1,6 @@
;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -39,8 +39,6 @@
(center-block . org-texinfo-center-block)
(clock . org-texinfo-clock)
(code . org-texinfo-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-texinfo-drawer)
(dynamic-block . org-texinfo-dynamic-block)
(entity . org-texinfo-entity)
@@ -58,13 +56,13 @@
(keyword . org-texinfo-keyword)
(line-break . org-texinfo-line-break)
(link . org-texinfo-link)
+ (node-property . org-texinfo-node-property)
(paragraph . org-texinfo-paragraph)
(plain-list . org-texinfo-plain-list)
(plain-text . org-texinfo-plain-text)
(planning . org-texinfo-planning)
(property-drawer . org-texinfo-property-drawer)
(quote-block . org-texinfo-quote-block)
- (quote-section . org-texinfo-quote-section)
(radio-target . org-texinfo-radio-target)
(section . org-texinfo-section)
(special-block . org-texinfo-special-block)
@@ -82,24 +80,42 @@
(verse-block . org-texinfo-verse-block))
:export-block "TEXINFO"
:filters-alist
- '((:filter-headline . org-texinfo-filter-section-blank-lines)
+ '((:filter-headline . org-texinfo--filter-section-blank-lines)
(:filter-parse-tree . org-texinfo--normalize-headlines)
- (:filter-section . org-texinfo-filter-section-blank-lines))
+ (:filter-section . org-texinfo--filter-section-blank-lines))
:menu-entry
'(?i "Export to Texinfo"
((?t "As TEXI file" org-texinfo-export-to-texinfo)
- (?i "As INFO file" org-texinfo-export-to-info)))
+ (?i "As INFO file" org-texinfo-export-to-info)
+ (?o "As INFO file and open"
+ (lambda (a s v b)
+ (if a (org-texinfo-export-to-info t s v b)
+ (org-open-file (org-texinfo-export-to-info nil s v b)))))))
:options-alist
'((:texinfo-filename "TEXINFO_FILENAME" nil nil t)
(:texinfo-class "TEXINFO_CLASS" nil org-texinfo-default-class t)
(:texinfo-header "TEXINFO_HEADER" nil nil newline)
(:texinfo-post-header "TEXINFO_POST_HEADER" nil nil newline)
- (:subtitle "SUBTITLE" nil nil newline)
+ (:subtitle "SUBTITLE" nil nil parse)
(:subauthor "SUBAUTHOR" nil nil newline)
(:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t)
(:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t)
(:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t)
- (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t)))
+ (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t)
+ ;; Other variables.
+ (:texinfo-classes nil nil org-texinfo-classes)
+ (:texinfo-format-headline-function nil nil org-texinfo-format-headline-function)
+ (:texinfo-node-description-column nil nil org-texinfo-node-description-column)
+ (:texinfo-active-timestamp-format nil nil org-texinfo-active-timestamp-format)
+ (:texinfo-inactive-timestamp-format nil nil org-texinfo-inactive-timestamp-format)
+ (:texinfo-diary-timestamp-format nil nil org-texinfo-diary-timestamp-format)
+ (:texinfo-link-with-unknown-path-format nil nil org-texinfo-link-with-unknown-path-format)
+ (:texinfo-tables-verbatim nil nil org-texinfo-tables-verbatim)
+ (:texinfo-table-scientific-notation nil nil org-texinfo-table-scientific-notation)
+ (:texinfo-def-table-markup nil nil org-texinfo-def-table-markup)
+ (:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist)
+ (:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function)
+ (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function)))
@@ -117,7 +133,7 @@
(defcustom org-texinfo-coding-system nil
"Default document encoding for Texinfo output.
-If `nil' it will default to `buffer-file-coding-system'."
+If nil it will default to `buffer-file-coding-system'."
:group 'org-export-texinfo
:type 'coding-system)
@@ -193,7 +209,8 @@ a format string in which the section title will be added."
;;;; Headline
-(defcustom org-texinfo-format-headline-function 'ignore
+(defcustom org-texinfo-format-headline-function
+ 'org-texinfo-format-headline-default-function
"Function to format headline text.
This function will be called with 5 arguments:
@@ -203,23 +220,11 @@ PRIORITY the priority of the headline (integer or nil)
TEXT the main headline text (string).
TAGS the tags as a list of strings (list of strings or nil).
-The function result will be used in the section format string.
-
-As an example, one could set the variable to the following, in
-order to reproduce the default set-up:
-
-\(defun org-texinfo-format-headline (todo todo-type priority text tags)
- \"Default format function for a headline.\"
- \(concat (when todo
- \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo))
- \(when priority
- \(format \"\\\\framebox{\\\\#%c} \" priority))
- text
- \(when tags
- \(format \"\\\\hfill{}\\\\textsc{%s}\"
- \(mapconcat 'identity tags \":\"))))"
+The function result will be used in the section format string."
:group 'org-export-texinfo
- :type 'function)
+ :type 'function
+ :version "25.1"
+ :package-version '(Org . "8.3"))
;;;; Node listing (menu)
@@ -321,7 +326,8 @@ The default function simply returns the value of CONTENTS."
;;;; Inlinetasks
-(defcustom org-texinfo-format-inlinetask-function 'ignore
+(defcustom org-texinfo-format-inlinetask-function
+ 'org-texinfo-format-inlinetask-default-function
"Function called to format an inlinetask in Texinfo code.
The function must accept six parameters:
@@ -332,26 +338,7 @@ The function must accept six parameters:
TAGS the inlinetask tags, as a list of strings.
CONTENTS the contents of the inlinetask, as a string.
-The function should return the string to be exported.
-
-For example, the variable could be set to the following function
-in order to mimic default behavior:
-
-\(defun org-texinfo-format-inlinetask \(todo type priority name tags contents\)
-\"Format an inline task element for Texinfo export.\"
- \(let ((full-title
- \(concat
- \(when todo
- \(format \"@strong{%s} \" todo))
- \(when priority (format \"#%c \" priority))
- title
- \(when tags
- \(format \":%s:\"
- \(mapconcat 'identity tags \":\")))))
- \(format (concat \"@center %s\n\n\"
- \"%s\"
- \"\n\"))
- full-title contents))"
+The function should return the string to be exported."
:group 'org-export-texinfo
:type 'function)
@@ -398,10 +385,15 @@ Specified coding system will be matched against these strings.
If two strings share the same prefix (e.g. \"ISO-8859-1\" and
\"ISO-8859-15\"), the most specific one has to be listed first.")
+(defconst org-texinfo-inline-image-rules
+ (list (cons "file"
+ (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg"))))
+ "Rules characterizing image files that can be inlined.")
+
;;; Internal Functions
-(defun org-texinfo-filter-section-blank-lines (headline back-end info)
+(defun org-texinfo--filter-section-blank-lines (headline back-end 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)))
@@ -439,9 +431,10 @@ This is used to choose a separator for constructs like \\verb."
when (not (string-match (regexp-quote (char-to-string c)) s))
return (char-to-string c))))
-(defun org-texinfo--text-markup (text markup)
+(defun org-texinfo--text-markup (text markup info)
"Format TEXT depending on MARKUP text markup.
-See `org-texinfo-text-markup-alist' for details."
+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.
@@ -475,18 +468,14 @@ anchor name is unique."
(or (cdr (assq blob cache))
(let ((name
(org-texinfo--sanitize-node
- (case (org-element-type blob)
- (headline
- (org-export-data (org-export-get-alt-title blob info) info))
- ((radio-target target) (org-element-property :value blob))
- (otherwise (or (org-element-property :name blob) ""))))))
+ (if (eq (org-element-type blob) 'headline)
+ (org-export-data (org-export-get-alt-title blob info) info)
+ (org-export-get-reference blob info)))))
;; Ensure NAME is unique.
(while (rassoc name cache) (setq name (concat name "x")))
(plist-put info :texinfo-node-cache (cons (cons blob name) cache))
name))))
-;;;; Menu sanitizing
-
(defun org-texinfo--sanitize-node (title)
"Bend string TITLE to node line requirements.
Trim string and collapse multiple whitespace characters as they
@@ -498,13 +487,49 @@ are not significant. Also remove the following characters: @
"\\`(\\(.*)\\)" "[\\1"
(org-trim (replace-regexp-in-string "[ \t]\\{2,\\}" " " title)))))
-;;;; Content sanitizing
-
(defun org-texinfo--sanitize-content (text)
"Escape special characters in string TEXT.
Special characters are: @ { }"
(replace-regexp-in-string "[@{}]" "@\\&" text))
+(defun org-texinfo--wrap-float (value info &optional type label caption short)
+ "Wrap string VALUE within a @float command.
+INFO is the current export state, as a plist. TYPE is float
+type, as a string. LABEL is the cross reference label for the
+float, as a string. CAPTION and SHORT are, respectively, the
+caption and shortcaption used for the float, as secondary
+strings (e.g., returned by `org-export-get-caption')."
+ (let* ((backend
+ (org-export-create-backend
+ :parent 'texinfo
+ :transcoders '((link . (lambda (object c i) c))
+ (radio-target . (lambda (object c i) c))
+ (target . ignore))))
+ (short-backend
+ (org-export-create-backend
+ :parent 'texinfo
+ :transcoders '((footnote-reference . ignore)
+ (inline-src-block . ignore)
+ (link . (lambda (object c i) c))
+ (radio-target . (lambda (object c i) c))
+ (target . ignore)
+ (verbatim . ignore))))
+ (short-str
+ (if (and short caption)
+ (format "@shortcaption{%s}\n"
+ (org-export-data-with-backend short short-backend info))
+ ""))
+ (caption-str
+ (if (or short caption)
+ (format "@caption{%s}\n"
+ (org-export-data-with-backend
+ (or caption short)
+ (if (equal short-str "") short-backend backend)
+ info))
+ "")))
+ (format "@float %s%s\n%s\n%s%s@end float"
+ type (if label (concat "," label) "") value caption-str short-str)))
+
;;; Template
(defun org-texinfo-template (contents info)
@@ -582,11 +607,13 @@ holding export options."
;; Title
"@finalout\n"
"@titlepage\n"
- (format "@title %s\n" (or (plist-get info :texinfo-printed-title) title))
- (let ((subtitle (plist-get info :subtitle)))
- (and subtitle
- (org-element-normalize-string
- (replace-regexp-in-string "^" "@subtitle " subtitle))))
+ (when (plist-get info :with-title)
+ (concat
+ (format "@title %s\n" (or (plist-get info :texinfo-printed-title) title ""))
+ (let ((subtitle (plist-get info :subtitle)))
+ (when subtitle
+ (format "@subtitle %s\n"
+ (org-export-data subtitle info))))))
(when (plist-get info :with-author)
(concat
;; Primary author.
@@ -620,10 +647,8 @@ holding export options."
;; Document's body.
contents "\n"
;; Creator.
- (case (plist-get info :with-creator)
- ((nil) nil)
- (comment (format "@c %s\n" (plist-get info :creator)))
- (otherwise (concat (plist-get info :creator) "\n")))
+ (and (plist-get info :with-creator)
+ (concat (plist-get info :creator) "\n"))
;; Document end.
"@bye")))
@@ -637,7 +662,7 @@ holding export options."
"Transcode BOLD from Org to Texinfo.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
- (org-texinfo--text-markup contents 'bold))
+ (org-texinfo--text-markup contents 'bold info))
;;;; Center Block
@@ -656,10 +681,8 @@ information."
(concat
"@noindent"
(format "@strong{%s} " org-clock-string)
- (format org-texinfo-inactive-timestamp-format
- (concat (org-translate-time
- (org-element-property :raw-value
- (org-element-property :value clock)))
+ (format (plist-get info :texinfo-inactive-timestamp-format)
+ (concat (org-timestamp-translate (org-element-property :value clock))
(let ((time (org-element-property :duration clock)))
(and time (format " (%s)" time)))))
"@*"))
@@ -670,7 +693,7 @@ information."
"Transcode a CODE object from Org to Texinfo.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (org-texinfo--text-markup (org-element-property :value code) 'code))
+ (org-texinfo--text-markup (org-element-property :value code) 'code info))
;;;; Drawer
@@ -679,7 +702,7 @@ channel."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((name (org-element-property :drawer-name drawer))
- (output (funcall org-texinfo-format-drawer-function
+ (output (funcall (plist-get info :texinfo-format-drawer-function)
name contents)))
output))
@@ -709,7 +732,7 @@ information."
(format "@verbatim\n%s@end verbatim"
(org-export-format-code-default example-block info)))
-;;;; Export Block
+;;; Export Block
(defun org-texinfo-export-block (export-block contents info)
"Transcode a EXPORT-BLOCK element from Org to Texinfo.
@@ -717,7 +740,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "TEXINFO")
(org-remove-indentation (org-element-property :value export-block))))
-;;;; Export Snippet
+;;; Export Snippet
(defun org-texinfo-export-snippet (export-snippet contents info)
"Transcode a EXPORT-SNIPPET object from Org to Texinfo.
@@ -755,7 +778,7 @@ holding contextual information."
(let* ((class (plist-get info :texinfo-class))
(level (org-export-get-relative-level headline info))
(numberedp (org-export-numbered-headline-p headline info))
- (class-sectioning (assoc class org-texinfo-classes))
+ (class-sectioning (assoc class (plist-get info :texinfo-classes)))
;; Find the index type, if any.
(index (org-element-property :INDEX headline))
;; Create node info, to insert it before section formatting.
@@ -789,19 +812,8 @@ holding contextual information."
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
(text (org-export-data (org-element-property :title headline) info))
- (full-text (if (not (eq org-texinfo-format-headline-function 'ignore))
- ;; User-defined formatting function.
- (funcall org-texinfo-format-headline-function
- todo todo-type priority text tags)
- ;; Default formatting.
- (concat
- (when todo
- (format "@strong{%s} " todo))
- (when priority (format "@emph{#%s} " priority))
- text
- (when tags
- (format " :%s:"
- (mapconcat 'identity tags ":"))))))
+ (full-text (funcall (plist-get info :texinfo-format-headline-function)
+ todo todo-type priority text tags))
(contents (if (org-string-nw-p contents) (concat "\n" contents) "")))
(cond
;; Case 1: This is a footnote section: ignore it.
@@ -835,6 +847,15 @@ holding contextual information."
;; Case 5: Standard headline. Export it as a section.
(t (concat node (format section-fmt full-text contents))))))
+(defun org-texinfo-format-headline-default-function
+ (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))
+ (when priority (format "@emph{#%s} " priority))
+ text
+ (when tags (format " :%s:" (mapconcat 'identity tags ":")))))
+
;;;; Inline Src Block
(defun org-texinfo-inline-src-block (inline-src-block contents info)
@@ -860,23 +881,19 @@ holding contextual information."
(org-export-get-tags inlinetask info)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority inlinetask))))
- ;; If `org-texinfo-format-inlinetask-function' is provided, call it
- ;; with appropriate arguments.
- (if (not (eq org-texinfo-format-inlinetask-function 'ignore))
- (funcall org-texinfo-format-inlinetask-function
- todo todo-type priority title tags contents)
- ;; Otherwise, use a default template.
- (let ((full-title
- (concat
- (when todo (format "@strong{%s} " todo))
- (when priority (format "#%c " priority))
- title
- (when tags (format ":%s:"
- (mapconcat 'identity tags ":"))))))
- (format (concat "@center %s\n\n"
- "%s"
- "\n")
- full-title contents)))))
+ (funcall (plist-get info :texinfo-format-inlinetask-function)
+ todo todo-type priority title tags contents)))
+
+(defun org-texinfo-format-inlinetask-default-function
+ (todo todo-type priority title tags contents)
+ "Default format function for a inlinetasks.
+See `org-texinfo-format-inlinetask-function' for details."
+ (let ((full-title
+ (concat (when todo (format "@strong{%s} " todo))
+ (when priority (format "#%c " priority))
+ title
+ (when tags (format ":%s:" (mapconcat #'identity tags ":"))))))
+ (format "@center %s\n\n%s\n" full-title contents)))
;;;; Italic
@@ -884,7 +901,7 @@ holding contextual information."
"Transcode ITALIC from Org to Texinfo.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
- (org-texinfo--text-markup contents 'italic))
+ (org-texinfo--text-markup contents 'italic info))
;;;; Item
@@ -911,7 +928,14 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string= key "KINDEX") (format "@kindex %s" value))
((string= key "PINDEX") (format "@pindex %s" value))
((string= key "TINDEX") (format "@tindex %s" value))
- ((string= key "VINDEX") (format "@vindex %s" value)))))
+ ((string= key "VINDEX") (format "@vindex %s" value))
+ ((string= key "TOC")
+ (cond ((org-string-match-p "\\<tables\\>" value)
+ (concat "@listoffloats "
+ (org-export-translate "Table" :utf-8 info)))
+ ((org-string-match-p "\\<listings\\>" value)
+ (concat "@listoffloats "
+ (org-export-translate "Listing" :utf-8 info))))))))
;;;; Line Break
@@ -935,11 +959,12 @@ INFO is a plist holding contextual information. See
(path (cond
((member type '("http" "https" "ftp"))
(concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file:" raw-path))
- (t raw-path)))
- protocol)
+ ((string= type "file") (org-export-file-uri raw-path))
+ (t raw-path))))
(cond
+ ((org-export-custom-protocol-maybe link desc 'texinfo))
+ ((org-export-inline-image-p link org-texinfo-inline-image-rules)
+ (org-texinfo--inline-image link info))
((equal type "radio")
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
@@ -965,48 +990,78 @@ INFO is a plist holding contextual information. See
(cond
(desc)
((org-export-numbered-headline-p destination info)
- (org-export-data
- (org-element-property :title destination) info))
- (t
(mapconcat
#'number-to-string
- (org-export-get-headline-number destination info) ".")))))
+ (org-export-get-headline-number destination info) "."))
+ (t (org-export-data
+ (org-element-property :title destination) info)))))
(otherwise
- (let ((topic
- (or desc
- (if (and (eq (org-element-type destination) 'headline)
- (not (org-export-numbered-headline-p
- destination info)))
- (org-export-data
- (org-element-property :title destination) info))
- (let ((n (org-export-get-ordinal destination info)))
- (cond
- ((not n) nil)
- ((integerp n) n)
- (t (mapconcat #'number-to-string n ".")))))))
- (when topic
- (format "@ref{%s,,%s}"
- (org-texinfo--get-node destination info)
- topic)))))))
+ (format "@ref{%s,,%s}"
+ (org-texinfo--get-node destination info)
+ (cond
+ (desc)
+ ;; No description is provided: first try to
+ ;; associate destination to a number.
+ ((let ((n (org-export-get-ordinal destination info)))
+ (cond ((not n) nil)
+ ((integerp n) n)
+ (t (mapconcat #'number-to-string n ".")))))
+ ;; Then grab title of headline containing
+ ;; DESTINATION.
+ ((let ((h (org-element-lineage destination '(headline) t)))
+ (and h
+ (org-export-data
+ (org-element-property :title destination) info))))
+ ;; Eventually, just return "Top" to refer to the
+ ;; beginning of the info file.
+ (t "Top")))))))
((equal type "info")
(let* ((info-path (split-string path "[:#]"))
(info-manual (car info-path))
- (info-node (or (cadr info-path) "top"))
+ (info-node (or (cadr info-path) "Top"))
(title (or desc "")))
(format "@ref{%s,%s,,%s,}" info-node title info-manual)))
((string= type "mailto")
(format "@email{%s}"
(concat (org-texinfo--sanitize-content path)
(and desc (concat "," desc)))))
- ((let ((protocol (nth 2 (assoc type org-link-protocols))))
- (and (functionp protocol)
- (funcall protocol (org-link-unescape path) desc 'texinfo))))
;; External link with a description part.
((and path desc) (format "@uref{%s,%s}" path desc))
;; External link without a description part.
(path (format "@uref{%s}" path))
;; No path, only description. Try to do something useful.
- (t (format org-texinfo-link-with-unknown-path-format desc)))))
+ (t
+ (format (plist-get info :texinfo-link-with-unknown-path-format) desc)))))
+
+(defun org-texinfo--inline-image (link info)
+ "Return Texinfo code for an inline image.
+LINK is the link pointing to the inline image. INFO is the
+current state of the export, as a plist."
+ (let* ((parent (org-export-get-parent-element link))
+ (label (and (org-element-property :name parent)
+ (org-texinfo--get-node parent info)))
+ (caption (org-export-get-caption parent))
+ (shortcaption (org-export-get-caption parent t))
+ (path (org-element-property :path link))
+ (filename
+ (file-name-sans-extension
+ (if (file-name-absolute-p path) (expand-file-name path) path)))
+ (extension (file-name-extension path))
+ (attributes (org-export-read-attribute :attr_texinfo parent))
+ (height (or (plist-get attributes :height) ""))
+ (width (or (plist-get attributes :width) ""))
+ (alt (or (plist-get attributes :alt) ""))
+ (image (format "@image{%s,%s,%s,%s,%s}"
+ filename width height alt extension)))
+ (cond ((or caption shortcaption)
+ (org-texinfo--wrap-float image
+ info
+ (org-export-translate "Figure" :utf-8 info)
+ label
+ caption
+ shortcaption))
+ (label (concat "@anchor{" label "}\n" image))
+ (t image))))
;;;; Menu
@@ -1099,6 +1154,17 @@ holding contextual information."
info nil 'headline)
cache))))
+;;;; Node Property
+
+(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."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
+
;;;; Paragraph
(defun org-texinfo-paragraph (paragraph contents info)
@@ -1114,7 +1180,8 @@ the plist used as a communication channel."
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
(let* ((attr (org-export-read-attribute :attr_texinfo plain-list))
- (indic (or (plist-get attr :indic) org-texinfo-def-table-markup))
+ (indic (or (plist-get attr :indic)
+ (plist-get info :texinfo-def-table-markup)))
(table-type (plist-get attr :table-type))
(type (org-element-property :type plain-list))
(list-type (cond
@@ -1174,23 +1241,20 @@ information."
(when closed
(concat
(format "@strong{%s} " org-closed-string)
- (format org-texinfo-inactive-timestamp-format
- (org-translate-time
- (org-element-property :raw-value closed))))))
+ (format (plist-get info :texinfo-inactive-timestamp-format)
+ (org-timestamp-translate closed)))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline
(concat
(format "@strong{%s} " org-deadline-string)
- (format org-texinfo-active-timestamp-format
- (org-translate-time
- (org-element-property :raw-value deadline))))))
+ (format (plist-get info :texinfo-active-timestamp-format)
+ (org-timestamp-translate deadline)))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
(concat
(format "@strong{%s} " org-scheduled-string)
- (format org-texinfo-active-timestamp-format
- (org-translate-time
- (org-element-property :raw-value scheduled))))))))
+ (format (plist-get info :texinfo-active-timestamp-format)
+ (org-timestamp-translate scheduled)))))))
" ")
"@*"))
@@ -1198,11 +1262,10 @@ information."
(defun org-texinfo-property-drawer (property-drawer contents info)
"Transcode a PROPERTY-DRAWER element from Org to Texinfo.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- ;; The property drawer isn't exported but we want separating blank
- ;; lines nonetheless.
- "")
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format "@verbatim\n%s@end verbatim" contents)))
;;;; Quote Block
@@ -1216,15 +1279,6 @@ holding contextual information."
(format " %s" title)))))
(format "%s\n%s@end quotation" start-quote contents)))
-;;;; Quote Section
-
-(defun org-texinfo-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to Texinfo.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format "@verbatim\n%s@end verbatim" value))))
-
;;;; Radio Target
(defun org-texinfo-radio-target (radio-target text info)
@@ -1232,8 +1286,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
TEXT is the text of the target. INFO is a plist holding
contextual information."
(format "@anchor{%s}%s"
- (org-export-solidify-link-text
- (org-element-property :value radio-target))
+ (org-export-get-reference radio-target info)
text))
;;;; Section
@@ -1252,7 +1305,8 @@ holding contextual information."
"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."
- contents)
+ (let ((type (org-element-property :type special-block)))
+ (format "@%s\n%s@end %s" type contents type)))
;;;; Src Block
@@ -1260,11 +1314,22 @@ as a communication channel."
"Transcode a SRC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let ((lispp (org-string-match-p "lisp"
+ (let* ((lisp (org-string-match-p "lisp"
(org-element-property :language src-block)))
- (code (org-texinfo--sanitize-content
- (org-export-format-code-default src-block info))))
- (format (if lispp "@lisp\n%s@end lisp" "@example\n%s@end example") code)))
+ (code (org-texinfo--sanitize-content
+ (org-export-format-code-default src-block info)))
+ (value (format
+ (if lisp "@lisp\n%s@end lisp" "@example\n%s@end example")
+ code))
+ (caption (org-export-get-caption src-block))
+ (shortcaption (org-export-get-caption src-block t)))
+ (if (not (or caption shortcaption)) value
+ (org-texinfo--wrap-float value
+ info
+ (org-export-translate "Listing" :utf-8 info)
+ (org-export-get-reference src-block info)
+ caption
+ shortcaption))))
;;;; Statistics Cookie
@@ -1302,10 +1367,19 @@ contextual information."
(let* ((col-width (org-export-read-attribute :attr_texinfo table :columns))
(columns
(if col-width (format "@columnfractions %s" col-width)
- (org-texinfo-table-column-widths table info))))
- (format "@multitable %s\n%s@end multitable"
- columns
- contents))))
+ (org-texinfo-table-column-widths table info)))
+ (caption (org-export-get-caption table))
+ (shortcaption (org-export-get-caption table t))
+ (table-str (format "@multitable %s\n%s@end multitable"
+ columns
+ contents)))
+ (if (not (or caption shortcaption)) table-str
+ (org-texinfo--wrap-float table-str
+ info
+ (org-export-translate "Table" :utf-8 info)
+ (org-export-get-reference table info)
+ caption
+ shortcaption)))))
(defun org-texinfo-table-column-widths (table info)
"Determine the largest table cell in each column to process alignment.
@@ -1335,16 +1409,18 @@ a communication channel."
"Transcode a TABLE-CELL element from Org to Texinfo.
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
- (concat (if (and contents
- org-texinfo-table-scientific-notation
- (string-match orgtbl-exp-regexp contents))
- ;; Use appropriate format string for scientific
- ;; notation.
- (format org-texinfo-table-scientific-notation
- (match-string 1 contents)
- (match-string 2 contents))
- contents)
- (when (org-export-get-next-element table-cell info) "\n@tab ")))
+ (concat
+ (let ((scientific-notation
+ (plist-get info :texinfo-table-scientific-notation)))
+ (if (and contents
+ scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific notation.
+ (format scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents))
+ (when (org-export-get-next-element table-cell info) "\n@tab ")))
;;;; Table Row
@@ -1369,8 +1445,7 @@ a communication channel."
"Transcode a TARGET object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "@anchor{%s}"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "@anchor{%s}" (org-export-get-reference target info)))
;;;; Timestamp
@@ -1382,10 +1457,10 @@ information."
(org-timestamp-translate timestamp) info)))
(case (org-element-property :type timestamp)
((active active-range)
- (format org-texinfo-active-timestamp-format value))
+ (format (plist-get info :texinfo-active-timestamp-format) value))
((inactive inactive-range)
- (format org-texinfo-inactive-timestamp-format value))
- (t (format org-texinfo-diary-timestamp-format value)))))
+ (format (plist-get info :texinfo-inactive-timestamp-format) value))
+ (t (format (plist-get info :texinfo-diary-timestamp-format) value)))))
;;;; Verbatim
@@ -1393,7 +1468,8 @@ information."
"Transcode a VERBATIM object from Org to Texinfo.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (org-texinfo--text-markup (org-element-property :value verbatim) 'verbatim))
+ (org-texinfo--text-markup
+ (org-element-property :value verbatim) 'verbatim info))
;;;; Verse Block
@@ -1436,7 +1512,7 @@ file-local settings.
Return output file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".texi" subtreep))
- (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-coding-system org-texinfo-coding-system))
(org-export-to-file 'texinfo outfile
async subtreep visible-only body-only ext-plist)))
@@ -1473,7 +1549,7 @@ directory.
Return INFO file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".texi" subtreep))
- (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-coding-system org-texinfo-coding-system))
(org-export-to-file 'texinfo outfile
async subtreep visible-only body-only ext-plist
(lambda (file) (org-texinfo-compile file)))))
@@ -1519,6 +1595,7 @@ Return INFO file name or an error if it couldn't be produced."
;; 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
diff --git a/lisp/ox.el b/lisp/ox.el
index 1327ae4..a0b7d45 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -28,12 +28,10 @@
;; Besides that parser, the generic exporter is made of three distinct
;; parts:
;;
-;; - The communication channel consists in a property list, which is
+;; - The communication channel consists of a property list, which is
;; created and updated during the process. Its use is to offer
;; every piece of information, would it be about initial environment
-;; or contextual data, all in a single place. The exhaustive list
-;; of properties is given in "The Communication Channel" section of
-;; this file.
+;; or contextual data, all in a single place.
;;
;; - The transcoder walks the parse tree, ignores or treat as plain
;; text elements and objects according to export options, and
@@ -46,8 +44,9 @@
;; output from back-end transcoders. See "The Filter System"
;; section for more information.
;;
-;; The core function is `org-export-as'. It returns the transcoded
-;; buffer as a string.
+;; The core functions is `org-export-as'. It returns the transcoded
+;; buffer as a string. Its derivatives are `org-export-to-buffer' and
+;; `org-export-to-file'.
;;
;; An export back-end is defined with `org-export-define-backend'.
;; This function can also support specific buffer keywords, OPTION
@@ -64,12 +63,11 @@
;; Tools for common tasks across back-ends are implemented in the
;; following part of the file.
;;
-;; Then, a wrapper macro for asynchronous export,
-;; `org-export-async-start', along with tools to display results. are
-;; given in the penultimate part.
+;; Eventually, a dispatcher (`org-export-dispatch') is provided in the
+;; last one.
;;
-;; Eventually, a dispatcher (`org-export-dispatch') for standard
-;; back-ends is provided in the last one.
+;; See <http://orgmode.org/worg/dev/org-export-reference.html> for
+;; more information.
;;; Code:
@@ -89,7 +87,6 @@
(defvar org-table-number-fraction)
(defvar org-table-number-regexp)
-
;;; Internal Variables
;;
@@ -101,20 +98,18 @@
"Maximum nesting depth for headlines, counting from 0.")
(defconst org-export-options-alist
- '((:author "AUTHOR" nil user-full-name t)
- (:creator "CREATOR" nil org-export-creator-string)
- (:date "DATE" nil nil t)
- (:description "DESCRIPTION" nil nil newline)
+ '((:title "TITLE" nil nil parse)
+ (:date "DATE" nil nil parse)
+ (:author "AUTHOR" nil user-full-name parse)
(:email "EMAIL" nil user-mail-address t)
+ (:language "LANGUAGE" nil org-export-default-language t)
+ (:select-tags "SELECT_TAGS" nil org-export-select-tags split)
(:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split)
+ (:creator "CREATOR" nil org-export-creator-string)
(:headline-levels nil "H" org-export-headline-levels)
- (:keywords "KEYWORDS" nil nil space)
- (:language "LANGUAGE" nil org-export-default-language t)
(:preserve-breaks nil "\\n" org-export-preserve-breaks)
(:section-numbers nil "num" org-export-with-section-numbers)
- (:select-tags "SELECT_TAGS" nil org-export-select-tags split)
(:time-stamp-file nil "timestamp" org-export-time-stamp-file)
- (:title "TITLE" nil nil space)
(:with-archived-trees nil "arch" org-export-with-archived-trees)
(:with-author nil "author" org-export-with-author)
(:with-clocks nil "c" org-export-with-clocks)
@@ -130,6 +125,7 @@
(:with-latex nil "tex" org-export-with-latex)
(:with-planning nil "p" org-export-with-planning)
(:with-priority nil "pri" org-export-with-priority)
+ (:with-properties nil "prop" org-export-with-properties)
(:with-smart-quotes nil "'" org-export-with-smart-quotes)
(:with-special-strings nil "-" org-export-with-special-strings)
(:with-statistics-cookies nil "stat" org-export-with-statistics-cookies)
@@ -139,10 +135,11 @@
(:with-tags nil "tags" org-export-with-tags)
(:with-tasks nil "tasks" org-export-with-tasks)
(:with-timestamps nil "<" org-export-with-timestamps)
+ (:with-title nil "title" org-export-with-title)
(:with-todo-keywords nil "todo" org-export-with-todo-keywords))
"Alist between export properties and ways to set them.
-The CAR of the alist is the property name, and the CDR is a list
+The key of the alist is the property name, and the value is a list
like (KEYWORD OPTION DEFAULT BEHAVIOR) where:
KEYWORD is a string representing a buffer keyword, or nil. Each
@@ -161,6 +158,9 @@ BEHAVIOR determines how Org should handle multiple keywords for
a newline.
`split' Split values at white spaces, and cons them to the
previous list.
+ `parse' Parse value as a list of strings and Org objects,
+ which can then be transcoded with, e.g.,
+ `org-export-data'. It implies `space' behavior.
Values set through KEYWORD and OPTION have precedence over
DEFAULT.
@@ -176,13 +176,12 @@ way they are handled must be hard-coded into
`org-export--get-inbuffer-options' function.")
(defconst org-export-filters-alist
- '((:filter-bold . org-export-filter-bold-functions)
+ '((:filter-body . org-export-filter-body-functions)
+ (:filter-bold . org-export-filter-bold-functions)
(:filter-babel-call . org-export-filter-babel-call-functions)
(:filter-center-block . org-export-filter-center-block-functions)
(:filter-clock . org-export-filter-clock-functions)
(:filter-code . org-export-filter-code-functions)
- (:filter-comment . org-export-filter-comment-functions)
- (:filter-comment-block . org-export-filter-comment-block-functions)
(:filter-diary-sexp . org-export-filter-diary-sexp-functions)
(:filter-drawer . org-export-filter-drawer-functions)
(:filter-dynamic-block . org-export-filter-dynamic-block-functions)
@@ -215,7 +214,6 @@ way they are handled must be hard-coded into
(:filter-planning . org-export-filter-planning-functions)
(:filter-property-drawer . org-export-filter-property-drawer-functions)
(:filter-quote-block . org-export-filter-quote-block-functions)
- (:filter-quote-section . org-export-filter-quote-section-functions)
(:filter-radio-target . org-export-filter-radio-target-functions)
(:filter-section . org-export-filter-section-functions)
(:filter-special-block . org-export-filter-special-block-functions)
@@ -258,6 +256,16 @@ whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\",
See `org-export-inline-image-p' for more information about
rules.")
+(defconst org-export-ignored-local-variables
+ '(org-font-lock-keywords
+ org-element--cache org-element--cache-objects org-element--cache-sync-keys
+ org-element--cache-sync-requests org-element--cache-sync-timer)
+ "List of variables not copied through upon buffer duplication.
+Export process takes place on a copy of the original buffer.
+When this copy is created, all Org related local variables not in
+this list are copied to the new buffer. Variables with an
+unreadable value are also ignored.")
+
(defvar org-export-async-debug nil
"Non-nil means asynchronous export process should leave data behind.
@@ -277,7 +285,7 @@ containing the back-end used, as a symbol, and either a process
or the time at which it finished. It is used to build the menu
from `org-export-stack'.")
-(defvar org-export--registered-backends nil
+(defvar org-export-registered-backends nil
"List of backends currently available in the exporter.
This variable is set with `org-export-define-backend' and
`org-export-define-derived-backend' functions.")
@@ -303,6 +311,7 @@ there is no export process in progress.
It can be used to teach Babel blocks how to act differently
according to the back-end used.")
+
;;; User-configurable Variables
;;
@@ -352,18 +361,18 @@ e.g. \"c:t\"."
:group 'org-export-general
:type 'boolean)
-(defcustom org-export-with-creator 'comment
+(defcustom org-export-with-creator nil
"Non-nil means the postamble should contain a creator sentence.
-The sentence can be set in `org-export-creator-string' and
-defaults to \"Generated by Org mode XX in Emacs XXX.\".
+The sentence can be set in `org-export-creator-string', which
+see.
-If the value is `comment' insert it as a comment."
+This option can also be set with the OPTIONS keyword, e.g.,
+\"creator:t\"."
:group 'org-export-general
- :type '(choice
- (const :tag "No creator sentence" nil)
- (const :tag "Sentence as a comment" comment)
- (const :tag "Insert the sentence" t)))
+ :version "25.1"
+ :package-version '(Org . "8.3")
+ :type 'boolean)
(defcustom org-export-with-date t
"Non-nil means insert date in the exported document.
@@ -398,10 +407,11 @@ This option can also be set on with the CREATOR keyword."
"Non-nil means export contents of standard drawers.
When t, all drawers are exported. This may also be a list of
-drawer names to export. If that list starts with `not', only
-drawers with such names will be ignored.
+drawer names to export, as strings. If that list starts with
+`not', only drawers with such names will be ignored.
-This variable doesn't apply to properties drawers.
+This variable doesn't apply to properties drawers. See
+`org-export-with-properties' instead.
This option can also be set with the OPTIONS keyword,
e.g. \"d:nil\"."
@@ -450,19 +460,12 @@ This option can also be set with the EXCLUDE_TAGS keyword."
:type '(repeat (string :tag "Tag")))
(defcustom org-export-with-fixed-width t
- "Non-nil means lines starting with \":\" will be in fixed width font.
-
-This can be used to have pre-formatted text, fragments of code
-etc. For example:
- : ;; Some Lisp examples
- : (while (defc cnt)
- : (ding))
-will be looking just like this in also HTML. See also the QUOTE
-keyword. Not all export backends support this.
-
+ "Non-nil means export lines starting with \":\".
This option can also be set with the OPTIONS keyword,
e.g. \"::nil\"."
:group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type 'boolean)
(defcustom org-export-with-footnotes t
@@ -493,7 +496,7 @@ t Allow export of math snippets."
"The last level which is still exported as a headline.
Inferior levels will usually produce itemize or enumerate lists
-when exported, but back-end behaviour may differ.
+when exported, but back-end behavior may differ.
This option can also be set with the OPTIONS keyword,
e.g. \"H:2\"."
@@ -559,6 +562,23 @@ e.g. \"pri:t\"."
:group 'org-export-general
:type 'boolean)
+(defcustom org-export-with-properties nil
+ "Non-nil means export contents of properties drawers.
+
+When t, all properties are exported. This may also be a list of
+properties to export, as strings.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"prop:t\"."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "All properties" t)
+ (const :tag "None" nil)
+ (repeat :tag "Selected properties"
+ (string :tag "Property name"))))
+
(defcustom org-export-with-section-numbers t
"Non-nil means add section numbers to headlines when exporting.
@@ -679,16 +699,12 @@ e.g. \"toc:nil\" or \"toc:3\"."
(integer :tag "TOC to level")))
(defcustom org-export-with-tables t
- "If non-nil, lines starting with \"|\" define a table.
-For example:
-
- | Name | Address | Birthday |
- |-------------+----------+-----------|
- | Arthur Dent | England | 29.2.2100 |
-
+ "Non-nil means export tables.
This option can also be set with the OPTIONS keyword,
e.g. \"|:nil\"."
:group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type 'boolean)
(defcustom org-export-with-tags t
@@ -727,9 +743,18 @@ e.g. \"tasks:nil\"."
(repeat :tag "Specific TODO keywords"
(string :tag "Keyword"))))
+(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"
+ :package-version '(Org . "8.3")
+ :type 'boolean)
+
(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
+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)
@@ -794,11 +819,12 @@ HTML code while every other back-end will ignore it."
:package-version '(Org . "8.0")
:type 'coding-system)
-(defcustom org-export-copy-to-kill-ring 'if-interactive
+(defcustom org-export-copy-to-kill-ring nil
"Non-nil means pushing export output to the kill ring.
This variable is ignored during asynchronous export."
:group 'org-export-general
- :version "24.3"
+ :version "25.1"
+ :package-version '(Org . "8.3")
:type '(choice
(const :tag "Always" t)
(const :tag "When export is done interactively" if-interactive)
@@ -831,15 +857,23 @@ automatically. But you can retrieve them with \\[org-export-stack]."
:package-version '(Org . "8.0")
:type 'boolean)
-(defcustom org-export-async-init-file user-init-file
+(defcustom org-export-async-init-file nil
"File used to initialize external export process.
-Value must be an absolute file name. It defaults to user's
-initialization file. Though, a specific configuration makes the
-process faster and the export more portable."
+
+Value must be either nil or an absolute file name. When nil, the
+external process is launched like a regular Emacs session,
+loading user's initialization file and any site specific
+configuration. If a file is provided, it, and only it, is loaded
+at start-up.
+
+Therefore, using a specific configuration makes the process to
+load faster and the export more portable."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type '(file :must-match t))
+ :type '(choice
+ (const :tag "Regular startup" nil)
+ (file :tag "Specific start-up file" :must-match t)))
(defcustom org-export-dispatch-use-expert-ui nil
"Non-nil means using a non-intrusive `org-export-dispatch'.
@@ -895,7 +929,7 @@ mode."
"Return export back-end named after NAME.
NAME is a symbol. Return nil if no such back-end is found."
(catch 'found
- (dolist (b org-export--registered-backends)
+ (dolist (b org-export-registered-backends)
(when (eq (org-export-backend-name b) name)
(throw 'found b)))))
@@ -917,8 +951,8 @@ BACKEND is a structure with `org-export-backend' type."
;; registered, replace it with BACKEND. Otherwise, simply add
;; BACKEND to the list of registered back-ends.
(let ((old (org-export-get-backend (org-export-backend-name backend))))
- (if old (setcar (memq old org-export--registered-backends) backend)
- (push backend org-export--registered-backends))))
+ (if old (setcar (memq old org-export-registered-backends) backend)
+ (push backend org-export-registered-backends))))
(defun org-export-barf-if-invalid-backend (backend)
"Signal an error if BACKEND isn't defined."
@@ -1118,14 +1152,15 @@ keywords are understood:
(declare (indent 1))
(let (blocks filters menu-entry options contents)
(while (keywordp (car body))
- (case (pop body)
- (:export-block (let ((names (pop body)))
- (setq blocks (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
- (:filters-alist (setq filters (pop body)))
- (:menu-entry (setq menu-entry (pop body)))
- (:options-alist (setq options (pop body)))
- (t (pop body))))
+ (let ((keyword (pop body)))
+ (case keyword
+ (:export-block (let ((names (pop body)))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
+ (: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)))))
(org-export-register-backend
(org-export-create-backend :name backend
:transcoders transcoders
@@ -1189,15 +1224,16 @@ The back-end could then be called with, for example:
(declare (indent 2))
(let (blocks filters menu-entry options transcoders contents)
(while (keywordp (car body))
- (case (pop body)
- (:export-block (let ((names (pop body)))
- (setq blocks (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
- (: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 (pop body))))
+ (let ((keyword (pop body)))
+ (case keyword
+ (:export-block (let ((names (pop body)))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
+ (: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)))))
(org-export-register-backend
(org-export-create-backend :name child
:parent parent
@@ -1224,273 +1260,6 @@ The back-end could then be called with, for example:
;;
;; 2. Tree properties are extracted directly from the parsed tree,
;; just before export, by `org-export-collect-tree-properties'.
-;;
-;; Here is the full list of properties available during transcode
-;; process, with their category and their value type.
-;;
-;; + `:author' :: Author's name.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:back-end' :: Current back-end used for transcoding.
-;; - category :: tree
-;; - type :: symbol
-;;
-;; + `:creator' :: String to write as creation information.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:date' :: String to use as date.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:description' :: Description text for the current data.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:email' :: Author's email.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:exclude-tags' :: Tags for exclusion of subtrees from export
-;; process.
-;; - category :: option
-;; - type :: list of strings
-;;
-;; + `:export-options' :: List of export options available for current
-;; process.
-;; - category :: none
-;; - type :: list of symbols, among `subtree', `body-only' and
-;; `visible-only'.
-;;
-;; + `:exported-data' :: Hash table used for memoizing
-;; `org-export-data'.
-;; - category :: tree
-;; - type :: hash table
-;;
-;; + `:filetags' :: List of global tags for buffer. Used by
-;; `org-export-get-tags' to get tags with inheritance.
-;; - category :: option
-;; - type :: list of strings
-;;
-;; + `:footnote-definition-alist' :: Alist between footnote labels and
-;; their definition, as parsed data. Only non-inlined footnotes
-;; are represented in this alist. Also, every definition isn't
-;; guaranteed to be referenced in the parse tree. The purpose of
-;; this property is to preserve definitions from oblivion
-;; (i.e. when the parse tree comes from a part of the original
-;; buffer), it isn't meant for direct use in a back-end. To
-;; retrieve a definition relative to a reference, use
-;; `org-export-get-footnote-definition' instead.
-;; - category :: option
-;; - type :: alist (STRING . LIST)
-;;
-;; + `:headline-levels' :: Maximum level being exported as an
-;; headline. Comparison is done with the relative level of
-;; headlines in the parse tree, not necessarily with their
-;; actual level.
-;; - category :: option
-;; - type :: integer
-;;
-;; + `:headline-offset' :: Difference between relative and real level
-;; of headlines in the parse tree. For example, a value of -1
-;; means a level 2 headline should be considered as level
-;; 1 (cf. `org-export-get-relative-level').
-;; - category :: tree
-;; - type :: integer
-;;
-;; + `:headline-numbering' :: Alist between headlines and their
-;; numbering, as a list of numbers
-;; (cf. `org-export-get-headline-number').
-;; - category :: tree
-;; - type :: alist (INTEGER . LIST)
-;;
-;; + `:id-alist' :: Alist between ID strings and destination file's
-;; path, relative to current directory. It is used by
-;; `org-export-resolve-id-link' to resolve ID links targeting an
-;; external file.
-;; - category :: option
-;; - type :: alist (STRING . STRING)
-;;
-;; + `:ignore-list' :: List of elements and objects that should be
-;; ignored during export.
-;; - category :: tree
-;; - type :: list of elements and objects
-;;
-;; + `:input-buffer' :: Name of input buffer.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:input-file' :: Full path to input file, if any.
-;; - category :: option
-;; - type :: string or nil
-;;
-;; + `:keywords' :: List of keywords attached to data.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:language' :: Default language used for translations.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:output-file' :: Full path to output file, if any.
-;; - category :: option
-;; - type :: string or nil
-;;
-;; + `:parse-tree' :: Whole parse tree, available at any time during
-;; transcoding.
-;; - category :: option
-;; - type :: list (as returned by `org-element-parse-buffer')
-;;
-;; + `:preserve-breaks' :: Non-nil means transcoding should preserve
-;; all line breaks.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:section-numbers' :: Non-nil means transcoding should add
-;; section numbers to headlines.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:select-tags' :: List of tags enforcing inclusion of sub-trees
-;; in transcoding. When such a tag is present, subtrees without
-;; it are de facto excluded from the process. See
-;; `use-select-tags'.
-;; - category :: option
-;; - type :: list of strings
-;;
-;; + `:time-stamp-file' :: Non-nil means transcoding should insert
-;; a time stamp in the output.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:translate-alist' :: Alist between element and object types and
-;; transcoding functions relative to the current back-end.
-;; Special keys `inner-template', `template' and `plain-text' are
-;; also possible.
-;; - category :: option
-;; - type :: alist (SYMBOL . FUNCTION)
-;;
-;; + `:with-archived-trees' :: Non-nil when archived subtrees should
-;; also be transcoded. If it is set to the `headline' symbol,
-;; only the archived headline's name is retained.
-;; - category :: option
-;; - type :: symbol (nil, t, `headline')
-;;
-;; + `:with-author' :: Non-nil means author's name should be included
-;; in the output.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-clocks' :: Non-nil means clock keywords should be exported.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-creator' :: Non-nil means a creation sentence should be
-;; inserted at the end of the transcoded string. If the value
-;; is `comment', it should be commented.
-;; - category :: option
-;; - type :: symbol (`comment', nil, t)
-;;
-;; + `:with-date' :: Non-nil means output should contain a date.
-;; - category :: option
-;; - type :. symbol (nil, t)
-;;
-;; + `:with-drawers' :: Non-nil means drawers should be exported. If
-;; its value is a list of names, only drawers with such names
-;; will be transcoded. If that list starts with `not', drawer
-;; with these names will be skipped.
-;; - category :: option
-;; - type :: symbol (nil, t) or list of strings
-;;
-;; + `:with-email' :: Non-nil means output should contain author's
-;; email.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-emphasize' :: Non-nil means emphasized text should be
-;; interpreted.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-fixed-width' :: Non-nil if transcoder should interpret
-;; strings starting with a colon as a fixed-with (verbatim) area.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-footnotes' :: Non-nil if transcoder should interpret
-;; footnotes.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-latex' :: Non-nil means `latex-environment' elements and
-;; `latex-fragment' objects should appear in export output. When
-;; this property is set to `verbatim', they will be left as-is.
-;; - category :: option
-;; - type :: symbol (`verbatim', nil, t)
-;;
-;; + `:with-planning' :: Non-nil means transcoding should include
-;; planning info.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-priority' :: Non-nil means transcoding should include
-;; priority cookies.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-smart-quotes' :: Non-nil means activate smart quotes in
-;; plain text.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-special-strings' :: Non-nil means transcoding should
-;; interpret special strings in plain text.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-sub-superscript' :: Non-nil means transcoding should
-;; interpret subscript and superscript. With a value of "{}",
-;; only interpret those using curly brackets.
-;; - category :: option
-;; - type :: symbol (nil, {}, t)
-;;
-;; + `:with-tables' :: Non-nil means transcoding should interpret
-;; tables.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-tags' :: Non-nil means transcoding should keep tags in
-;; headlines. A `not-in-toc' value will remove them from the
-;; table of contents, if any, nonetheless.
-;; - category :: option
-;; - type :: symbol (nil, t, `not-in-toc')
-;;
-;; + `:with-tasks' :: Non-nil means transcoding should include
-;; headlines with a TODO keyword. A `todo' value will only
-;; include headlines with a todo type keyword while a `done'
-;; value will do the contrary. If a list of strings is provided,
-;; only tasks with keywords belonging to that list will be kept.
-;; - category :: option
-;; - type :: symbol (t, todo, done, nil) or list of strings
-;;
-;; + `:with-timestamps' :: Non-nil means transcoding should include
-;; time stamps. Special value `active' (resp. `inactive') ask to
-;; export only active (resp. inactive) timestamps. Otherwise,
-;; completely remove them.
-;; - category :: option
-;; - type :: symbol: (`active', `inactive', t, nil)
-;;
-;; + `:with-toc' :: Non-nil means that a table of contents has to be
-;; added to the output. An integer value limits its depth.
-;; - category :: option
-;; - type :: symbol (nil, t or integer)
-;;
-;; + `:with-todo-keywords' :: Non-nil means transcoding should
-;; include TODO keywords.
-;; - category :: option
-;; - type :: symbol (nil, t)
-
;;;; Environment Options
;;
@@ -1551,25 +1320,6 @@ inferior to file-local settings."
:back-end
backend
:translate-alist (org-export-get-all-transcoders backend)
- :footnote-definition-alist
- ;; Footnotes definitions must be collected in the original
- ;; buffer, as there's no insurance that they will still be in
- ;; the parse tree, due to possible narrowing.
- (let (alist)
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward org-footnote-definition-re nil t)
- (let ((def (save-match-data (org-element-at-point))))
- (when (eq (org-element-type def) 'footnote-definition)
- (push
- (cons (org-element-property :label def)
- (let ((cbeg (org-element-property :contents-begin def)))
- (when cbeg
- (org-element--parse-elements
- cbeg (org-element-property :contents-end def)
- nil nil nil nil (list 'org-data nil)))))
- alist))))
- alist))
:id-alist
;; Collect id references.
(let (alist)
@@ -1579,7 +1329,7 @@ inferior to file-local settings."
(let ((link (org-element-context)))
(when (eq (org-element-type link) 'link)
(let* ((id (org-element-property :path link))
- (file (org-id-find-id-file id)))
+ (file (car (org-id-find id))))
(when file
(push (cons id (file-relative-name file)) alist)))))))
alist))))
@@ -1589,24 +1339,20 @@ inferior to file-local settings."
Optional argument BACKEND is an export back-end, as returned by,
e.g., `org-export-create-backend'. It specifies which back-end
specific items to read, if any."
- (let* ((all
+ (let ((all
+ (mapcar
+ (lambda (o) (cons (nth 2 o) (car o)))
;; Priority is given to back-end specific options.
(append (and backend (org-export-get-all-options backend))
- org-export-options-alist))
- plist)
- (dolist (option all)
- (let ((property (car option))
- (item (nth 2 option)))
- (when (and item
- (not (plist-member plist property))
- (string-match (concat "\\(\\`\\|[ \t]\\)"
- (regexp-quote item)
- ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)")
- options))
- (setq plist (plist-put plist
- property
- (car (read-from-string
- (match-string 2 options))))))))
+ org-export-options-alist)))
+ (start)
+ plist)
+ (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t\n]*" options start)
+ (setq start (match-end 0))
+ (let ((property (cdr (assoc-string (match-string 1 options) all t))))
+ (when property
+ (setq plist
+ (plist-put plist property (read (match-string 2 options)))))))
plist))
(defun org-export--get-subtree-options (&optional backend)
@@ -1615,60 +1361,48 @@ Optional argument BACKEND is an export back-end, as returned by,
e.g., `org-export-create-backend'. It specifies back-end used
for export. Return options as a plist."
;; For each buffer keyword, create a headline property setting the
- ;; same property in communication channel. The name for the property
- ;; is the keyword with "EXPORT_" appended to it.
+ ;; same property in communication channel. The name for the
+ ;; property is the keyword with "EXPORT_" appended to it.
(org-with-wide-buffer
- (let (prop plist)
- ;; Make sure point is at a heading.
- (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t))
- ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's
- ;; title (with no todo keyword, priority cookie or tag) as its
- ;; fallback value.
- (when (setq prop (or (org-entry-get (point) "EXPORT_TITLE")
- (progn (looking-at org-complex-heading-regexp)
- (org-match-string-no-properties 4))))
- (setq plist
- (plist-put
- plist :title
- (org-element-parse-secondary-string
- prop (org-element-restriction 'keyword)))))
- ;; EXPORT_OPTIONS are parsed in a non-standard way.
- (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS"))
- (setq plist
- (nconc plist (org-export--parse-option-keyword prop backend))))
- ;; Handle other keywords. TITLE keyword is excluded as it has
- ;; been handled already.
- (let ((seen '("TITLE")))
- (mapc
- (lambda (option)
- (let ((property (car option))
- (keyword (nth 1 option)))
- (when (and keyword (not (member keyword seen)))
- (let* ((subtree-prop (concat "EXPORT_" keyword))
- ;; Export properties are not case-sensitive.
- (value (let ((case-fold-search t))
- (org-entry-get (point) subtree-prop))))
- (push keyword seen)
- (when (and value (not (plist-member plist property)))
- (setq plist
- (plist-put
- plist
- property
- (cond
- ;; Parse VALUE if required.
- ((member keyword org-element-document-properties)
- (org-element-parse-secondary-string
- value (org-element-restriction 'keyword)))
- ;; If BEHAVIOR is `split' expected value is
- ;; a list of strings, not a string.
- ((eq (nth 4 option) 'split) (org-split-string value))
- (t value)))))))))
- ;; Look for both general keywords and back-end specific
- ;; options, with priority given to the latter.
- (append (and backend (org-export-get-all-options backend))
- org-export-options-alist)))
- ;; Return value.
- plist)))
+ ;; Make sure point is at a heading.
+ (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t))
+ (let ((plist
+ ;; EXPORT_OPTIONS are parsed in a non-standard way. Take
+ ;; care of them right from the start.
+ (let ((o (org-entry-get (point) "EXPORT_OPTIONS")))
+ (and o (org-export--parse-option-keyword o backend))))
+ ;; Take care of EXPORT_TITLE. If it isn't defined, use
+ ;; headline's title (with no todo keyword, priority cookie or
+ ;; tag) as its fallback value.
+ (cache (list
+ (cons "TITLE"
+ (or (org-entry-get (point) "EXPORT_TITLE")
+ (progn (looking-at org-complex-heading-regexp)
+ (org-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))
+ org-export-options-alist)))
+ ;; Handle other keywords. Then return PLIST.
+ (dolist (option options plist)
+ (let ((property (car option))
+ (keyword (nth 1 option)))
+ (when keyword
+ (let ((value
+ (or (cdr (assoc keyword cache))
+ (let ((v (org-entry-get (point)
+ (concat "EXPORT_" keyword))))
+ (push (cons keyword v) cache) v))))
+ (when value
+ (setq plist
+ (plist-put plist
+ property
+ (case (nth 4 option)
+ (parse
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword)))
+ (split (org-split-string value))
+ (t value))))))))))))
(defun org-export--get-inbuffer-options (&optional backend)
"Return current buffer export options, as a plist.
@@ -1687,7 +1421,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(and backend (org-export-get-all-options backend))
org-export-options-alist))
(regexp (format "^[ \t]*#\\+%s:"
- (regexp-opt (nconc (delq nil (mapcar 'cadr options))
+ (regexp-opt (nconc (delq nil (mapcar #'cadr options))
org-export-special-keywords))))
(find-properties
(lambda (keyword)
@@ -1696,6 +1430,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(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
@@ -1736,56 +1471,65 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(t
;; Options in `org-export-options-alist'.
(dolist (property (funcall find-properties key))
- (let ((behaviour (nth 4 (assq property options))))
- (setq plist
- (plist-put
- plist property
- ;; Handle value depending on specified
- ;; BEHAVIOR.
- (case behaviour
- (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))))))))))))))
- ;; Return final value.
+ (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.
- (setq plist (funcall get-options
- (and buffer-file-name (list buffer-file-name)) nil))
- ;; Parse keywords specified in `org-element-document-properties'
- ;; and return PLIST.
- (dolist (keyword org-element-document-properties plist)
- (dolist (property (funcall find-properties keyword))
- (let ((value (plist-get plist property)))
- (when (stringp value)
- (setq plist
- (plist-put plist property
- (or (org-element-parse-secondary-string
- value (org-element-restriction 'keyword))
- ;; When TITLE keyword sets an empty
- ;; string, make sure it doesn't
- ;; appear as nil in the plist.
- (and (eq property :title) ""))))))))))
+ ;; Read options in the current buffer and return value.
+ (let ((options (funcall get-options
+ (and buffer-file-name (list buffer-file-name))
+ nil)))
+ ;; 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)
+ (let ((value (org-element-parse-secondary-string
+ (plist-get options 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)))))))
(defun org-export--get-buffer-attributes ()
"Return properties related to buffer attributes, as a plist."
- ;; Store full path of input file name, or nil. For internal use.
- (let ((visited-file (buffer-file-name (buffer-base-buffer))))
- (list :input-file visited-file
- :input-buffer (buffer-name (buffer-base-buffer)))))
+ (list :input-buffer (buffer-name (buffer-base-buffer))
+ :input-file (buffer-file-name (buffer-base-buffer))))
(defun org-export--get-global-options (&optional backend)
"Return global export options as a plist.
@@ -1804,13 +1548,9 @@ process."
(plist-put
plist
prop
- ;; Evaluate default value provided. If keyword is
- ;; a member of `org-element-document-properties',
- ;; parse it as a secondary string before storing it.
+ ;; Evaluate default value provided.
(let ((value (eval (nth 3 cell))))
- (if (and (stringp value)
- (member (nth 1 cell)
- org-element-document-properties))
+ (if (eq (nth 4 cell) 'parse)
(org-element-parse-secondary-string
value (org-element-restriction 'keyword))
value)))))))))
@@ -1886,9 +1626,6 @@ Following tree properties are set or updated:
`:exported-data' Hash table used to memoize results from
`org-export-data'.
-`:footnote-definition-alist' List of footnotes definitions in
- original buffer and current parse tree.
-
`: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
@@ -1897,39 +1634,15 @@ Following tree properties are set or updated:
`:headline-numbering' Alist of all headlines as key an the
associated numbering as value.
-`:ignore-list' List of elements that should be ignored during
- export.
-
Return updated plist."
- ;; Install the parse tree in the communication channel, in order to
- ;; use `org-export-get-genealogy' and al.
+ ;; Install the parse tree in the communication channel.
(setq info (plist-put info :parse-tree data))
- ;; Get the list of elements and objects to ignore, and put it into
- ;; `:ignore-list'. Do not overwrite any user ignore that might have
- ;; been done during parse tree filtering.
- (setq info
- (plist-put info
- :ignore-list
- (append (org-export--populate-ignore-list data info)
- (plist-get info :ignore-list))))
;; Compute `:headline-offset' in order to be able to use
;; `org-export-get-relative-level'.
(setq info
(plist-put info
:headline-offset
(- 1 (org-export--get-min-level data info))))
- ;; Update footnotes definitions list with definitions in parse tree.
- ;; This is required since buffer expansion might have modified
- ;; boundaries of footnote definitions contained in the parse tree.
- ;; This way, definitions in `footnote-definition-alist' are bound to
- ;; match those in the parse tree.
- (let ((defs (plist-get info :footnote-definition-alist)))
- (org-element-map data 'footnote-definition
- (lambda (fn)
- (push (cons (org-element-property :label fn)
- `(org-data nil ,@(org-element-contents fn)))
- defs)))
- (setq info (plist-put info :footnote-definition-alist defs)))
;; Properties order doesn't matter: get the rest of the tree
;; properties.
(nconc
@@ -1956,7 +1669,7 @@ OPTIONS is a plist holding export options."
(if (= min-level 10000) 1 min-level))))
(defun org-export--collect-headline-numbering (data options)
- "Return numbering of all exportable headlines in a parse tree.
+ "Return numbering of all exportable, numbered headlines in a parse tree.
DATA is the parse tree. OPTIONS is the plist holding export
options.
@@ -1967,7 +1680,8 @@ for a footnotes section."
(let ((numbering (make-vector org-export-max-depth 0)))
(org-element-map data 'headline
(lambda (headline)
- (unless (org-element-property :footnote-section-p headline)
+ (when (and (org-export-numbered-headline-p headline options)
+ (not (org-element-property :footnote-section-p headline)))
(let ((relative-level
(1- (org-export-get-relative-level headline options))))
(cons
@@ -1979,40 +1693,8 @@ for a footnotes section."
when (> idx relative-level) do (aset numbering idx 0))))))
options)))
-(defun org-export--populate-ignore-list (data options)
- "Return list of elements and objects to ignore during export.
-DATA is the parse tree to traverse. OPTIONS is the plist holding
-export options."
- (let* (ignore
- walk-data
- ;; First find trees containing a select tag, if any.
- (selected (org-export--selected-trees data options))
- (walk-data
- (lambda (data)
- ;; Collect ignored elements or objects into IGNORE-LIST.
- (let ((type (org-element-type data)))
- (if (org-export--skip-p data options selected) (push data ignore)
- (if (and (eq type 'headline)
- (eq (plist-get options :with-archived-trees) 'headline)
- (org-element-property :archivedp data))
- ;; If headline is archived but tree below has
- ;; to be skipped, add it to ignore list.
- (mapc (lambda (e) (push e ignore))
- (org-element-contents data))
- ;; Move into secondary string, if any.
- (let ((sec-prop
- (cdr (assq type org-element-secondary-value-alist))))
- (when sec-prop
- (mapc walk-data (org-element-property sec-prop data))))
- ;; Move into recursive objects/elements.
- (mapc walk-data (org-element-contents data))))))))
- ;; Main call.
- (funcall walk-data data)
- ;; Return value.
- ignore))
-
(defun org-export--selected-trees (data info)
- "Return list of headlines and inlinetasks with a select tag in their tree.
+ "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
@@ -2033,18 +1715,17 @@ INFO is a plist holding export options."
(append
genealogy
(org-element-map data '(headline inlinetask)
- 'identity)
+ #'identity)
selected-trees))
;; If at a headline, continue searching in tree,
;; recursively.
(when (eq type 'headline)
- (mapc (lambda (el)
- (funcall walk-data el (cons data genealogy)))
- (org-element-contents data))))))
+ (dolist (el (org-element-contents data))
+ (funcall walk-data el (cons data genealogy)))))))
((or (eq type 'org-data)
(memq type org-element-greater-elements))
- (mapc (lambda (el) (funcall walk-data el genealogy))
- (org-element-contents data)))))))))
+ (dolist (el (org-element-contents data))
+ (funcall walk-data el genealogy)))))))))
(funcall walk-data data nil)
selected-trees))
@@ -2067,6 +1748,7 @@ a tree with a select tag."
(if (eq (car with-drawers-p) 'not)
(member-ignore-case name (cdr with-drawers-p))
(not (member-ignore-case name with-drawers-p))))))))
+ (fixed-width (not (plist-get options :with-fixed-width)))
((footnote-definition footnote-reference)
(not (plist-get options :with-footnotes)))
((headline inlinetask)
@@ -2095,12 +1777,20 @@ a tree with a select tag."
(not (eq todo-type with-tasks)))
(and (consp with-tasks) (not (member todo with-tasks))))))))
((latex-environment latex-fragment) (not (plist-get options :with-latex)))
+ (node-property
+ (let ((properties-set (plist-get options :with-properties)))
+ (cond ((null properties-set) t)
+ ((consp properties-set)
+ (not (member-ignore-case (org-element-property :key blob)
+ properties-set))))))
(planning (not (plist-get options :with-planning)))
+ (property-drawer (not (plist-get options :with-properties)))
(statistics-cookie (not (plist-get options :with-statistics-cookies)))
+ (table (not (plist-get options :with-tables)))
(table-cell
(and (org-export-table-has-special-column-p
(org-export-get-parent-table blob))
- (not (org-export-get-previous-element blob options))))
+ (org-export-first-sibling-p blob options)))
(table-row (org-export-table-row-is-special-p blob options))
(timestamp
;; `:with-timestamps' only applies to isolated timestamps
@@ -2115,7 +1805,7 @@ a tree with a select tag."
(or (not (stringp obj)) (org-string-nw-p obj)))
options t))))
(case (plist-get options :with-timestamps)
- ('nil t)
+ ((nil) t)
(active
(not (memq (org-element-property :type blob) '(active active-range))))
(inactive
@@ -2136,14 +1826,6 @@ a tree with a select tag."
;; `org-export-data' or even use a temporary back-end by using
;; `org-export-data-with-backend'.
;;
-;; Internally, three functions handle the filtering of objects and
-;; elements during the export. In particular,
-;; `org-export-ignore-element' marks an element or object so future
-;; parse tree traversals skip it, `org-export--interpret-p' tells which
-;; elements or objects should be seen as real Org syntax and
-;; `org-export-expand' transforms the others back into their original
-;; shape
-;;
;; `org-export-transcoder' is an accessor returning appropriate
;; translator function for a given element or object.
@@ -2176,16 +1858,6 @@ Return a string."
(let ((transcoder (org-export-transcoder data info)))
(if transcoder (funcall transcoder data info) data))
info))
- ;; Uninterpreted element/object: change it back to Org
- ;; syntax and export again resulting raw string.
- ((not (org-export--interpret-p data info))
- (org-export-data
- (org-export-expand
- data
- (mapconcat (lambda (blob) (org-export-data blob info))
- (org-element-contents data)
- ""))
- info))
;; Secondary string.
((not type)
(mapconcat (lambda (obj) (org-export-data obj info)) data ""))
@@ -2283,32 +1955,6 @@ recursively convert DATA using BACKEND translation table."
;; will probably be used on small trees.
:exported-data (make-hash-table :test 'eq :size 401)))))
-(defun org-export--interpret-p (blob info)
- "Non-nil if element or object BLOB should be interpreted during export.
-If nil, BLOB will appear as raw Org syntax. Check is done
-according to export options INFO, stored as a plist."
- (case (org-element-type blob)
- ;; ... entities...
- (entity (plist-get info :with-entities))
- ;; ... emphasis...
- ((bold italic strike-through underline)
- (plist-get info :with-emphasize))
- ;; ... fixed-width areas.
- (fixed-width (plist-get info :with-fixed-width))
- ;; ... LaTeX environments and fragments...
- ((latex-environment latex-fragment)
- (let ((with-latex-p (plist-get info :with-latex)))
- (and with-latex-p (not (eq with-latex-p 'verbatim)))))
- ;; ... sub/superscripts...
- ((subscript superscript)
- (let ((sub/super-p (plist-get info :with-sub-superscript)))
- (if (eq sub/super-p '{})
- (org-element-property :use-brackets-p blob)
- sub/super-p)))
- ;; ... tables...
- (table (plist-get info :with-tables))
- (otherwise t)))
-
(defun org-export-expand (blob contents &optional with-affiliated)
"Expand a parsed element or object to its original state.
@@ -2323,13 +1969,6 @@ keywords before output."
(funcall (intern (format "org-element-%s-interpreter" type))
blob contents))))
-(defun org-export-ignore-element (element info)
- "Add ELEMENT to `:ignore-list' in INFO.
-
-Any element in `:ignore-list' will be skipped when using
-`org-element-map'. INFO is modified by side effects."
- (plist-put info :ignore-list (cons element (plist-get info :ignore-list))))
-
;;; The Filter System
@@ -2360,9 +1999,13 @@ Any element in `:ignore-list' will be skipped when using
;; tree. Users can set it through
;; `org-export-filter-parse-tree-functions' variable.
;;
+;; - `:filter-body' applies to the body of the output, before template
+;; translator chimes in. Users can set it through
+;; `org-export-filter-body-functions' variable.
+;;
;; - `:filter-final-output' applies to the final transcoded string.
;; Users can set it with `org-export-filter-final-output-functions'
-;; variable
+;; variable.
;;
;; - `:filter-plain-text' applies to any string not recognized as Org
;; syntax. `org-export-filter-plain-text-functions' allows users to
@@ -2370,7 +2013,7 @@ Any element in `:ignore-list' will be skipped when using
;;
;; - `:filter-TYPE' applies on the string returned after an element or
;; object of type TYPE has been transcoded. A user can modify
-;; `org-export-filter-TYPE-functions'
+;; `org-export-filter-TYPE-functions' to install these filters.
;;
;; All filters sets are applied with
;; `org-export-filter-apply-functions' function. Filters in a set are
@@ -2433,6 +2076,13 @@ contains no Org syntax, the back-end, as a symbol, and the
communication channel, as a plist. It must return a string or
nil.")
+(defvar org-export-filter-body-functions nil
+ "List of functions applied to transcoded body.
+Each filter is called with three arguments: a string which
+contains no Org syntax, the back-end, as a symbol, and the
+communication channel, as a plist. It must return a string or
+nil.")
+
(defvar org-export-filter-final-output-functions nil
"List of functions applied to the transcoded string.
Each filter is called with three arguments: the full transcoded
@@ -2461,18 +2111,6 @@ Each filter is called with three arguments: the transcoded data,
as a string, the back-end, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
-(defvar org-export-filter-comment-functions nil
- "List of functions applied to a transcoded comment.
-Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
-channel, as a plist. It must return a string or nil.")
-
-(defvar org-export-filter-comment-block-functions nil
- "List of functions applied to a transcoded comment-block.
-Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
-channel, as a plist. It must return a string or nil.")
-
(defvar org-export-filter-diary-sexp-functions nil
"List of functions applied to a transcoded diary-sexp.
Each filter is called with three arguments: the transcoded data,
@@ -2588,12 +2226,6 @@ data, as a string, the back-end, as a symbol, and the
communication channel, as a plist. It must return a string or
nil.")
-(defvar org-export-filter-quote-section-functions nil
- "List of functions applied to a transcoded quote-section.
-Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
-channel, as a plist. It must return a string or nil.")
-
(defvar org-export-filter-section-functions nil
"List of functions applied to a transcoded section.
Each filter is called with three arguments: the transcoded data,
@@ -2905,7 +2537,7 @@ The function assumes BUFFER's major mode is `org-mode'."
(when (consp entry)
(let ((var (car entry))
(val (cdr entry)))
- (and (not (eq var 'org-font-lock-keywords))
+ (and (not (memq var org-export-ignored-local-variables))
(or (memq var
'(default-directory
buffer-file-name
@@ -2944,9 +2576,293 @@ The function assumes BUFFER's major mode is `org-mode'."
(overlays-in (point-min) (point-max)))
ov-set)))))
+(defun org-export--delete-comments ()
+ "Delete commented areas in the buffer.
+Commented areas are comments, comment blocks, commented trees and
+inlinetasks. Trailing blank lines after a comment or a comment
+block are preserved. Narrowing, if any, is ignored."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((regexp (concat org-outline-regexp-bol ".*" org-comment-string
+ "\\|"
+ "^[ \t]*#\\(?: \\|$\\|\\+begin_comment\\)"))
+ (case-fold-search t))
+ (while (re-search-forward regexp nil t)
+ (let ((e (org-element-at-point)))
+ (case (org-element-type e)
+ ((comment comment-block)
+ (delete-region (org-element-property :begin e)
+ (progn (goto-char (org-element-property :end e))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
+ ((headline inlinetask)
+ (when (org-element-property :commentedp e)
+ (delete-region (org-element-property :begin e)
+ (org-element-property :end e))))))))))
+
+(defun org-export--prune-tree (data info)
+ "Prune non exportable elements from DATA.
+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 secondary string, if any.
+ (let ((sec-prop
+ (cdr (assq type org-element-secondary-value-alist))))
+ (when sec-prop
+ (mapc walk-data (org-element-property sec-prop data))))
+ ;; Move into recursive objects/elements.
+ (mapc walk-data (org-element-contents data)))))))))
+ ;; If a select tag is active, also ignore the section before the
+ ;; first headline, if any.
+ (when selected
+ (let ((first-element (car (org-element-contents data))))
+ (when (eq (org-element-type first-element) 'section)
+ (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))
+ (when (eq (nth 4 entry) 'parse)
+ (funcall walk-data (plist-get info (car entry)))))
+ ;; Eventually set `:ignore-list'.
+ (plist-put info :ignore-list ignore)))
+
+(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
+options. Each uninterpreted element or object is changed back
+into a string. Contents, if any, are not modified. The parse
+tree is modified by side effect."
+ (org-export--remove-uninterpreted-data-1 data info)
+ (dolist (entry org-export-options-alist)
+ (when (eq (nth 4 entry) 'parse)
+ (let ((p (car entry)))
+ (plist-put info
+ p
+ (org-export--remove-uninterpreted-data-1
+ (plist-get info p)
+ info))))))
+
+(defun org-export--remove-uninterpreted-data-1 (data info)
+ "Change uninterpreted elements back into Org syntax.
+DATA is a parse tree or a secondary string. INFO is a plist
+containing export options. It is modified by side effect and
+returned by the function."
+ (org-element-map data
+ '(entity bold italic latex-environment latex-fragment strike-through
+ subscript superscript underline)
+ (lambda (blob)
+ (let ((new
+ (case (org-element-type blob)
+ ;; ... entities...
+ (entity
+ (and (not (plist-get info :with-entities))
+ (list (concat
+ (org-export-expand blob nil)
+ (make-string
+ (or (org-element-property :post-blank blob) 0)
+ ?\s)))))
+ ;; ... emphasis...
+ ((bold italic strike-through underline)
+ (and (not (plist-get info :with-emphasize))
+ (let ((marker (case (org-element-type blob)
+ (bold "*")
+ (italic "/")
+ (strike-through "+")
+ (underline "_"))))
+ (append
+ (list marker)
+ (org-element-contents blob)
+ (list (concat
+ marker
+ (make-string
+ (or (org-element-property :post-blank blob)
+ 0)
+ ?\s)))))))
+ ;; ... LaTeX environments and fragments...
+ ((latex-environment latex-fragment)
+ (and (eq (plist-get info :with-latex) 'verbatim)
+ (list (org-export-expand blob nil))))
+ ;; ... sub/superscripts...
+ ((subscript superscript)
+ (let ((sub/super-p (plist-get info :with-sub-superscript))
+ (bracketp (org-element-property :use-brackets-p blob)))
+ (and (or (not sub/super-p)
+ (and (eq sub/super-p '{}) (not bracketp)))
+ (append
+ (list (concat
+ (if (eq (org-element-type blob) 'subscript)
+ "_"
+ "^")
+ (and bracketp "{")))
+ (org-element-contents blob)
+ (list (concat
+ (and bracketp "}")
+ (and (org-element-property :post-blank blob)
+ (make-string
+ (org-element-property :post-blank blob)
+ ?\s)))))))))))
+ (when new
+ ;; Splice NEW at BLOB location in parse tree.
+ (dolist (e new (org-element-extract-element blob))
+ (unless (string= e "") (org-element-insert-before e blob))))))
+ info)
+ ;; 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)
+ (backend &optional subtreep visible-only body-only ext-plist)
"Transcode current Org buffer into BACKEND code.
BACKEND is either an export back-end, as returned by, e.g.,
@@ -2997,56 +2913,47 @@ Return code as a string."
(and visible-only 'visible-only)
(and body-only 'body-only))))
(org-export--get-buffer-attributes)))
+ (parsed-keywords
+ (delq nil
+ (mapcar (lambda (o) (and (eq (nth 4 o) 'parse) (nth 1 o)))
+ (append (org-export-get-all-options backend)
+ org-export-options-alist))))
tree)
;; Update communication channel and get parse tree. Buffer
- ;; isn't parsed directly. Instead, a temporary copy is
- ;; created, where include keywords, macros are expanded and
- ;; code blocks are evaluated.
+ ;; isn't parsed directly. Instead, all buffer modifications
+ ;; and consequent parsing are undertaken in a temporary copy.
(org-export-with-buffer-copy
;; Run first hook with current back-end's name as argument.
(run-hook-with-args 'org-export-before-processing-hook
(org-export-backend-name backend))
+ ;; Include files, delete comments and expand macros.
(org-export-expand-include-keyword)
- ;; Update macro templates since #+INCLUDE keywords might have
- ;; added some new ones.
+ (org-export--delete-comments)
(org-macro-initialize-templates)
- (org-macro-replace-all org-macro-templates)
+ (org-macro-replace-all org-macro-templates nil parsed-keywords)
+ ;; Refresh buffer properties and radio targets after
+ ;; potentially invasive previous changes. Likewise, do it
+ ;; again after executing Babel code.
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp)
(org-export-execute-babel-code)
- ;; Update radio targets since keyword inclusion might have
- ;; added some more.
+ (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.
(goto-char (point-min))
(save-excursion
(run-hook-with-args 'org-export-before-parsing-hook
(org-export-backend-name backend)))
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp)
;; Update communication channel with environment. Also
;; install user's and developer's filters.
(setq info
(org-export-install-filters
(org-combine-plists
info (org-export-get-environment backend subtreep ext-plist))))
- ;; Special case: provide original file name or buffer name as
- ;; default value for :title property.
- (unless (plist-get info :title)
- (plist-put
- info :title
- (let ((file (plist-get info :input-file)))
- (if file (file-name-sans-extension (file-name-nondirectory file))
- (plist-get info :input-buffer)))))
- ;; Expand export-specific set of macros: {{{author}}},
- ;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done
- ;; once regular macros have been expanded, since document
- ;; keywords may contain one of them.
- (org-macro-replace-all
- (list (cons "author"
- (org-element-interpret-data (plist-get info :author)))
- (cons "date"
- (org-element-interpret-data (plist-get info :date)))
- ;; EMAIL is not a parsed keyword: store it as-is.
- (cons "email" (or (plist-get info :email) ""))
- (cons "title"
- (org-element-interpret-data (plist-get info :title)))))
;; Call options filters and update export options. We do not
;; use `org-export-filter-apply-functions' here since the
;; arity of such filters is different.
@@ -3054,11 +2961,42 @@ Return code as a string."
(dolist (filter (plist-get info :filter-options))
(let ((result (funcall filter info backend-name)))
(when result (setq info result)))))
- ;; Parse buffer and call parse-tree filter on it.
+ ;; Expand export-specific set of macros: {{{author}}},
+ ;; {{{date(FORMAT)}}}, {{{email}}} and {{{title}}}. It must
+ ;; be done once regular macros have been expanded, since
+ ;; parsed keywords may contain one of them.
+ (org-macro-replace-all
+ (list
+ (cons "author" (org-element-interpret-data (plist-get info :author)))
+ (cons "date"
+ (let* ((date (plist-get info :date))
+ (value (or (org-element-interpret-data date) "")))
+ (if (and (consp date)
+ (not (cdr date))
+ (eq (org-element-type (car date)) 'timestamp))
+ (format "(eval (if (org-string-nw-p \"$1\") %s %S))"
+ (format "(org-timestamp-format '%S \"$1\")"
+ (org-element-copy (car date)))
+ value)
+ value)))
+ (cons "email" (org-element-interpret-data (plist-get info :email)))
+ (cons "title" (org-element-interpret-data (plist-get info :title)))
+ (cons "results" "$1"))
+ 'finalize
+ 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.
+ (org-export--prune-tree tree info)
+ (org-export--remove-uninterpreted-data tree info)
+ ;; Call parse tree filters.
(setq tree
(org-export-filter-apply-functions
- (plist-get info :filter-parse-tree)
- (org-element-parse-buffer nil visible-only) info))
+ (plist-get info :filter-parse-tree) tree info))
;; Now tree is complete, compute its properties and add them
;; to communication channel.
(setq info
@@ -3070,8 +3008,11 @@ Return code as a string."
(or (org-export-data tree info) "")))
(inner-template (cdr (assq 'inner-template
(plist-get info :translate-alist))))
- (full-body (if (not (functionp inner-template)) body
- (funcall inner-template body info)))
+ (full-body (org-export-filter-apply-functions
+ (plist-get info :filter-body)
+ (if (not (functionp inner-template)) body
+ (funcall inner-template body info))
+ info))
(template (cdr (assq 'template
(plist-get info :translate-alist)))))
;; Remove all text properties since they cannot be
@@ -3111,14 +3052,10 @@ Return code as a string."
BACKEND is either an export back-end, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
a registered back-end."
- (if (not (org-region-active-p))
- (user-error "No active region to replace")
- (let* ((beg (region-beginning))
- (end (region-end))
- (str (buffer-substring beg end)) rpl)
- (setq rpl (org-export-string-as str backend t))
- (delete-region beg end)
- (insert rpl))))
+ (unless (org-region-active-p) (user-error "No active region to replace"))
+ (insert
+ (org-export-string-as
+ (delete-and-extract-region (region-beginning) (region-end)) backend t)))
;;;###autoload
(defun org-export-insert-default-template (&optional backend subtreep)
@@ -3144,7 +3081,8 @@ locally for the subtree through node properties."
(cons "default"
(mapcar (lambda (b)
(symbol-name (org-export-backend-name b)))
- org-export--registered-backends))))))
+ org-export-registered-backends))
+ nil t))))
options keywords)
;; Populate OPTIONS and KEYWORDS.
(dolist (entry (cond ((eq backend 'default) org-export-options-alist)
@@ -3158,43 +3096,14 @@ locally for the subtree through node properties."
(keyword (unless (assoc keyword keywords)
(let ((value
(if (eq (nth 4 entry) 'split)
- (mapconcat 'identity (eval (nth 3 entry)) " ")
+ (mapconcat #'identity (eval (nth 3 entry)) " ")
(eval (nth 3 entry)))))
(push (cons keyword value) keywords))))
(option (unless (assoc option options)
(push (cons option (eval (nth 3 entry))) options))))))
;; Move to an appropriate location in order to insert options.
(unless subtreep (beginning-of-line))
- ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the
- ;; list of available keywords.
- (when (assoc "TITLE" keywords)
- (let ((title
- (or (let ((visited-file (buffer-file-name (buffer-base-buffer))))
- (and visited-file
- (file-name-sans-extension
- (file-name-nondirectory visited-file))))
- (buffer-name (buffer-base-buffer)))))
- (if (not subtreep) (insert (format "#+TITLE: %s\n" title))
- (org-entry-put node "EXPORT_TITLE" title))))
- (when (assoc "DATE" keywords)
- (let ((date (with-temp-buffer (org-insert-time-stamp (current-time)))))
- (if (not subtreep) (insert "#+DATE: " date "\n")
- (org-entry-put node "EXPORT_DATE" date))))
- (when (assoc "AUTHOR" keywords)
- (let ((author (cdr (assoc "AUTHOR" keywords))))
- (if subtreep (org-entry-put node "EXPORT_AUTHOR" author)
- (insert
- (format "#+AUTHOR:%s\n"
- (if (not (org-string-nw-p author)) ""
- (concat " " author)))))))
- (when (assoc "EMAIL" keywords)
- (let ((email (cdr (assoc "EMAIL" keywords))))
- (if subtreep (org-entry-put node "EXPORT_EMAIL" email)
- (insert
- (format "#+EMAIL:%s\n"
- (if (not (org-string-nw-p email)) ""
- (concat " " email)))))))
- ;; Then (multiple) OPTIONS lines. Never go past fill-column.
+ ;; First (multiple) OPTIONS lines. Never go past fill-column.
(when options
(let ((items
(mapcar
@@ -3212,48 +3121,90 @@ locally for the subtree through node properties."
(insert " " item)
(incf width (1+ (length item))))))
(insert "\n")))))
- ;; And the rest of keywords.
- (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2)))))
- (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL"))
- (let ((val (cdr key)))
- (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val)
- (insert
- (format "#+%s:%s\n"
- (car key)
- (if (org-string-nw-p val) (format " %s" val) "")))))))))
-
-(defun org-export-expand-include-keyword (&optional included dir)
+ ;; Then the rest of keywords, in the order specified in either
+ ;; `org-export-options-alist' or respective export back-ends.
+ (dolist (key (nreverse keywords))
+ (let ((val (cond ((equal (car key) "DATE")
+ (or (cdr key)
+ (with-temp-buffer
+ (org-insert-time-stamp (current-time)))))
+ ((equal (car key) "TITLE")
+ (or (let ((visited-file
+ (buffer-file-name (buffer-base-buffer))))
+ (and visited-file
+ (file-name-sans-extension
+ (file-name-nondirectory visited-file))))
+ (buffer-name (buffer-base-buffer))))
+ (t (cdr key)))))
+ (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val)
+ (insert
+ (format "#+%s:%s\n"
+ (car key)
+ (if (org-string-nw-p val) (format " %s" val) ""))))))))
+
+(defun org-export-expand-include-keyword (&optional included dir footnotes)
"Expand every include keyword in buffer.
Optional argument INCLUDED is a list of included file names along
with their line restriction, when appropriate. It is used to
avoid infinite recursion. Optional argument DIR is the current
working directory. It is used to properly resolve relative
-paths."
- (let ((case-fold-search t))
+paths. Optional argument FOOTNOTES is a hash-table used for
+storing and resolving footnotes. It is created automatically."
+ (let ((case-fold-search t)
+ (file-prefix (make-hash-table :test #'equal))
+ (current-prefix 0)
+ (footnotes (or footnotes (make-hash-table :test #'equal)))
+ (include-re "^[ \t]*#\\+INCLUDE:"))
+ ;; If :minlevel is not set the text-property
+ ;; `:org-include-induced-level' will be used to determine the
+ ;; relative level when expanding INCLUDE.
+ ;; Only affects included Org documents.
+ (goto-char (point-min))
+ (while (re-search-forward include-re nil t)
+ (put-text-property (line-beginning-position) (line-end-position)
+ :org-include-induced-level
+ (1+ (org-reduced-level (or (org-current-level) 0)))))
+ ;; Expand INCLUDE keywords.
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
+ (while (re-search-forward include-re nil t)
(let ((element (save-match-data (org-element-at-point))))
(when (eq (org-element-type element) 'keyword)
(beginning-of-line)
;; Extract arguments from keyword's value.
(let* ((value (org-element-property :value element))
(ind (org-get-indentation))
- (file (and (string-match
- "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
- (prog1 (expand-file-name
- (org-remove-double-quotes
- (match-string 1 value))
- dir)
- (setq value (replace-match "" nil nil value)))))
+ location
+ (file
+ (and (string-match
+ "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
+ (prog1
+ (save-match-data
+ (let ((matched (match-string 1 value)))
+ (when (string-match "\\(::\\(.*?\\)\\)\"?\\'"
+ matched)
+ (setq location (match-string 2 matched))
+ (setq matched
+ (replace-match "" nil nil matched 1)))
+ (expand-file-name
+ (org-remove-double-quotes
+ matched)
+ dir)))
+ (setq value (replace-match "" nil nil value)))))
+ (only-contents
+ (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?"
+ value)
+ (prog1 (org-not-nil (match-string 1 value))
+ (setq value (replace-match "" nil nil value)))))
(lines
(and (string-match
":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
value)
(prog1 (match-string 1 value)
(setq value (replace-match "" nil nil value)))))
- (env (cond ((string-match "\\<example\\>" value) 'example)
+ (env (cond ((string-match "\\<example\\>" value)
+ 'literal)
((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
- (match-string 1 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
@@ -3263,8 +3214,12 @@ paths."
(if (string-match ":minlevel +\\([0-9]+\\)" value)
(prog1 (string-to-number (match-string 1 value))
(setq value (replace-match "" nil nil value)))
- (let ((cur (org-current-level)))
- (if cur (1+ (org-reduced-level cur)) 1))))))
+ (get-text-property (point)
+ :org-include-induced-level))))
+ (src-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)))
(cond
@@ -3278,35 +3233,136 @@ paths."
(error "Recursive file inclusion: %s" file))
(t
(cond
- ((eq env 'example)
+ ((eq env 'literal)
(insert
(let ((ind-str (make-string ind ? ))
+ (arg-str (if (stringp src-args)
+ (format " %s" src-args)
+ ""))
(contents
(org-escape-code-in-string
(org-export--prepare-file-contents file lines))))
- (format "%s#+BEGIN_EXAMPLE\n%s%s#+END_EXAMPLE\n"
- ind-str contents ind-str))))
- ((stringp env)
+ (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n"
+ ind-str block arg-str contents ind-str block))))
+ ((stringp block)
(insert
(let ((ind-str (make-string ind ? ))
(contents
- (org-escape-code-in-string
- (org-export--prepare-file-contents file lines))))
- (format "%s#+BEGIN_SRC %s\n%s%s#+END_SRC\n"
- ind-str env contents ind-str))))
+ (org-export--prepare-file-contents file lines)))
+ (format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
+ ind-str block contents ind-str block))))
(t
(insert
(with-temp-buffer
- (let ((org-inhibit-startup t)) (org-mode))
- (insert
- (org-export--prepare-file-contents file lines ind minlevel))
+ (let ((org-inhibit-startup t)
+ (lines
+ (if location
+ (org-export--inclusion-absolute-lines
+ file location only-contents lines)
+ lines)))
+ (org-mode)
+ (insert
+ (org-export--prepare-file-contents
+ file lines ind minlevel
+ (or (gethash file file-prefix)
+ (puthash file (incf current-prefix) file-prefix))
+ footnotes)))
(org-export-expand-include-keyword
(cons (list file lines) included)
- (file-name-directory file))
- (buffer-string)))))))))))))
+ (file-name-directory file)
+ footnotes)
+ (buffer-string)))))
+ ;; Expand footnotes after all files have been included.
+ ;; Footnotes are stored at end of buffer.
+ (unless included
+ (org-with-wide-buffer
+ (goto-char (point-max))
+ (maphash (lambda (k v) (insert (format "\n[%s] %s\n" k v)))
+ footnotes)))))))))))
+
+(defun org-export--inclusion-absolute-lines (file location only-contents lines)
+ "Resolve absolute lines for an included file with file-link.
-(defun org-export--prepare-file-contents (file &optional lines ind minlevel)
- "Prepare the contents of FILE for inclusion and return them as a string.
+FILE is string file-name of the file to include. LOCATION is a
+string name within FILE to be included (located via
+`org-link-search'). If ONLY-CONTENTS is non-nil only the
+contents of the named element will be included, as determined
+Org-Element. If LINES is non-nil only those lines are included.
+
+Return a string of lines to be included in the format expected by
+`org-export--prepare-file-contents'."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (unless (eq major-mode 'org-mode)
+ (let ((org-inhibit-startup t)) (org-mode)))
+ (condition-case err
+ ;; Enforce consistent search.
+ (let ((org-link-search-must-match-exact-headline nil))
+ (org-link-search location))
+ (error
+ (error "%s for %s::%s" (error-message-string err) file location)))
+ (let* ((element (org-element-at-point))
+ (contents-begin
+ (and only-contents (org-element-property :contents-begin element))))
+ (narrow-to-region
+ (or contents-begin (org-element-property :begin element))
+ (org-element-property (if contents-begin :contents-end :end) element))
+ (when (and only-contents
+ (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 org-property-drawer-re) (goto-char (match-end 0)))
+ (unless (bolp) (forward-line))
+ (narrow-to-region (point) (point-max))))
+ (when lines
+ (org-skip-whitespace)
+ (beginning-of-line)
+ (let* ((lines (split-string lines "-"))
+ (lbeg (string-to-number (car lines)))
+ (lend (string-to-number (cadr lines)))
+ (beg (if (zerop lbeg) (point-min)
+ (goto-char (point-min))
+ (forward-line (1- lbeg))
+ (point)))
+ (end (if (zerop lend) (point-max)
+ (goto-char beg)
+ (forward-line (1- lend))
+ (point))))
+ (narrow-to-region beg end)))
+ (let ((end (point-max)))
+ (goto-char (point-min))
+ (widen)
+ (let ((start-line (line-number-at-pos)))
+ (format "%d-%d"
+ start-line
+ (save-excursion
+ (+ start-line
+ (let ((counter 0))
+ (while (< (point) end) (incf counter) (forward-line))
+ counter))))))))
+
+(defun org-export--update-footnote-label (ref-begin digit-label id)
+ "Prefix footnote-label at point REF-BEGIN in buffer with ID.
+
+REF-BEGIN corresponds to the property `:begin' of objects of type
+footnote-definition and footnote-reference.
+
+If DIGIT-LABEL is non-nil the label is assumed to be of the form
+\[N] where N is one or more numbers.
+
+Return the new label."
+ (goto-char (1+ ref-begin))
+ (buffer-substring (point)
+ (progn
+ (if digit-label (insert (format "fn:%d-" id))
+ (forward-char 3)
+ (insert (format "%d-" id)))
+ (1- (search-forward "]")))))
+
+(defun org-export--prepare-file-contents
+ (file &optional lines ind minlevel id footnotes)
+ "Prepare contents of FILE for inclusion and return it as a string.
When optional argument LINES is a string specifying a range of
lines, include only those lines.
@@ -3319,7 +3375,15 @@ headline encountered.
Optional argument MINLEVEL, when non-nil, is an integer
specifying the level that any top-level headline in the included
-file should have."
+file should have.
+Optional argument ID is an integer that will be inserted before
+each footnote definition and reference if FILE is an Org file.
+This is useful to avoid conflicts when more than one Org file
+with footnotes is included in a document.
+
+Optional argument FOOTNOTES is a hash-table to store footnotes in
+the included document.
+"
(with-temp-buffer
(insert-file-contents file)
(when lines
@@ -3378,6 +3442,51 @@ file should have."
(org-map-entries
(lambda () (if (< offset 0) (delete-char (abs offset))
(insert (make-string offset ?*)))))))))))
+ ;; Append ID to all footnote references and definitions, so they
+ ;; become file specific and cannot collide with footnotes in other
+ ;; included files. Further, collect relevant footnotes outside of
+ ;; LINES.
+ (when id
+ (let ((marker-min (point-min-marker))
+ (marker-max (point-max-marker)))
+ (goto-char (point-min))
+ (while (re-search-forward org-footnote-re nil t)
+ (let ((reference (org-element-context)))
+ (when (eq (org-element-type reference) 'footnote-reference)
+ (let* ((label (org-element-property :label reference))
+ (digit-label
+ (and label (org-string-match-p "\\`[0-9]+\\'" label))))
+ ;; Update the footnote-reference at point and collect
+ ;; the new label, which is only used for footnotes
+ ;; outsides LINES.
+ (when label
+ ;; If label is akin to [1] convert it to [fn:ID-1].
+ ;; Otherwise add "ID-" after "fn:".
+ (let ((new-label (org-export--update-footnote-label
+ (org-element-property :begin reference)
+ digit-label id)))
+ (unless (eq (org-element-property :type reference) 'inline)
+ (org-with-wide-buffer
+ (let* ((definition (org-footnote-get-definition label))
+ (beginning (nth 1 definition)))
+ (unless definition
+ (error
+ "Definition not found for footnote %s in file %s"
+ label file))
+ (if (or (< beginning marker-min)
+ (> beginning marker-max))
+ ;; Store since footnote-definition is
+ ;; outside of LINES.
+ (puthash new-label
+ (org-element-normalize-string
+ (nth 3 definition))
+ footnotes)
+ ;; Update label of definition since it is
+ ;; included directly.
+ (org-export--update-footnote-label
+ beginning digit-label id)))))))))))
+ (set-marker marker-min nil)
+ (set-marker marker-max nil)))
(org-element-normalize-string (buffer-string))))
(defun org-export-execute-babel-code ()
@@ -3385,8 +3494,7 @@ file should have."
;; Get a pristine copy of current buffer so Babel references can be
;; properly resolved.
(let ((reference (org-export-copy-buffer)))
- (unwind-protect (let ((org-current-export-file reference))
- (org-babel-exp-process-buffer))
+ (unwind-protect (org-babel-exp-process-buffer reference)
(kill-buffer reference))))
(defun org-export--copy-to-kill-ring-p ()
@@ -3491,9 +3599,10 @@ the communication channel used for export, as a plist."
(funcall
transcoder data contents
(org-combine-plists
- info (list :back-end backend
- :translate-alist all-transcoders
- :exported-data (make-hash-table :test 'eq :size 401)))))))))
+ info (list
+ :back-end backend
+ :translate-alist all-transcoders
+ :exported-data (make-hash-table :test #'eq :size 401)))))))))
;;;; For Export Snippets
@@ -3529,127 +3638,156 @@ applied."
;; `org-export-get-footnote-number' provide easier access to
;; additional information relative to a footnote reference.
-(defun org-export-collect-footnote-definitions (data info)
+(defun org-export-get-footnote-definition (footnote-reference info)
+ "Return definition of FOOTNOTE-REFERENCE as parsed data.
+INFO is the plist used as a communication channel. If no such
+definition can be found, raise an error."
+ (let ((label (org-element-property :label footnote-reference)))
+ (if (not label) (org-element-contents footnote-reference)
+ (let ((cache (or (plist-get info :footnote-definition-cache)
+ (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))))))
+
+(defun org-export--footnote-reference-map
+ (function data info &optional body-first)
+ "Apply FUNCTION on every footnote reference in DATA.
+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)))))
+ (funcall search-ref data body-first)
+ (funcall search-ref (nreverse definitions) nil)))
+
+(defun org-export-collect-footnote-definitions (info &optional data body-first)
"Return an alist between footnote numbers, labels and definitions.
-DATA is the parse tree from which definitions are collected.
-INFO is the plist used as a communication channel.
-
-Definitions are sorted by order of references. They either
-appear as Org data or as a secondary string for inlined
-footnotes. Unreferenced definitions are ignored."
- (let* (num-alist
- collect-fn ; for byte-compiler.
- (collect-fn
- (function
- (lambda (data)
- ;; Collect footnote number, label and definition in DATA.
- (org-element-map data 'footnote-reference
- (lambda (fn)
- (when (org-export-footnote-first-reference-p fn info)
- (let ((def (org-export-get-footnote-definition fn info)))
- (push
- (list (org-export-get-footnote-number fn info)
- (org-element-property :label fn)
- def)
- num-alist)
- ;; Also search in definition for nested footnotes.
- (when (eq (org-element-property :type fn) 'standard)
- (funcall collect-fn def)))))
- ;; Don't enter footnote definitions since it will happen
- ;; when their first reference is found.
- info nil 'footnote-definition)))))
- (funcall collect-fn (plist-get info :parse-tree))
- (reverse num-alist)))
-
-(defun org-export-footnote-first-reference-p (footnote-reference info)
+INFO is the current export state, as a plist.
+
+Definitions are collected throughout the whole parse tree, or
+DATA when non-nil.
+
+Sorting is done by order of references. As soon as a new
+reference is encountered, other references are searched within
+its definition. However, if BODY-FIRST is non-nil, this step is
+delayed after the whole tree is checked. This alters results
+when references are found in footnote definitions.
+
+Definitions either appear as Org data or as a secondary string
+for inlined footnotes. Unreferenced definitions are ignored."
+ (let ((n 0) labels alist)
+ (org-export--footnote-reference-map
+ (lambda (f)
+ ;; Collect footnote number, label and definition.
+ (let ((l (org-element-property :label f)))
+ (unless (and l (member l labels))
+ (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)
+ (nreverse alist)))
+
+(defun org-export-footnote-first-reference-p
+ (footnote-reference info &optional data body-first)
"Non-nil when a footnote reference is the first one for its label.
FOOTNOTE-REFERENCE is the footnote reference being considered.
-INFO is the plist used as a communication channel."
- (let ((label (org-element-property :label footnote-reference)))
- ;; Anonymous footnotes are always a first reference.
- (if (not label) t
- ;; Otherwise, return the first footnote with the same LABEL and
- ;; test if it is equal to FOOTNOTE-REFERENCE.
- (let* (search-refs ; for byte-compiler.
- (search-refs
- (function
- (lambda (data)
- (org-element-map data 'footnote-reference
- (lambda (fn)
- (cond
- ((string= (org-element-property :label fn) label)
- (throw 'exit fn))
- ;; If FN isn't inlined, be sure to traverse its
- ;; definition before resuming search. See
- ;; comments in `org-export-get-footnote-number'
- ;; for more information.
- ((eq (org-element-property :type fn) 'standard)
- (funcall search-refs
- (org-export-get-footnote-definition fn info)))))
- ;; Don't enter footnote definitions since it will
- ;; happen when their first reference is found.
- info 'first-match 'footnote-definition)))))
- (eq (catch 'exit (funcall search-refs (plist-get info :parse-tree)))
- footnote-reference)))))
+INFO is a plist containing current export state.
-(defun org-export-get-footnote-definition (footnote-reference info)
- "Return definition of FOOTNOTE-REFERENCE as parsed data.
-INFO is the plist used as a communication channel. If no such
-definition can be found, return the \"DEFINITION NOT FOUND\"
-string."
- (let ((label (org-element-property :label footnote-reference)))
- (or (org-element-property :inline-definition footnote-reference)
- (cdr (assoc label (plist-get info :footnote-definition-alist)))
- "DEFINITION NOT FOUND.")))
+Search is done throughout the whole parse tree, or DATA when
+non-nil.
-(defun org-export-get-footnote-number (footnote info)
+By default, as soon as a new footnote reference is encountered,
+other references are searched within its definition. However, if
+BODY-FIRST is non-nil, this step is delayed after the whole tree
+is checked. This alters results when references are found in
+footnote definitions."
+ (let ((label (org-element-property :label footnote-reference)))
+ ;; Anonymous footnotes are always a first reference.
+ (or (not label)
+ (catch 'exit
+ (org-export--footnote-reference-map
+ (lambda (f)
+ (let ((l (org-element-property :label f)))
+ (when (and l label (string= label l))
+ (throw 'exit (eq footnote-reference f)))))
+ (or data (plist-get info :parse-tree)) info body-first)))))
+
+(defun org-export-get-footnote-number (footnote info &optional data body-first)
"Return number associated to a footnote.
FOOTNOTE is either a footnote reference or a footnote definition.
-INFO is the plist used as a communication channel."
- (let* ((label (org-element-property :label footnote))
- seen-refs
- search-ref ; For byte-compiler.
- (search-ref
- (function
- (lambda (data)
- ;; Search footnote references through DATA, filling
- ;; SEEN-REFS along the way.
- (org-element-map data 'footnote-reference
- (lambda (fn)
- (let ((fn-lbl (org-element-property :label fn)))
- (cond
- ;; Anonymous footnote match: return number.
- ((and (not fn-lbl) (eq fn footnote))
- (throw 'exit (1+ (length seen-refs))))
- ;; Labels match: return number.
- ((and label (string= label fn-lbl))
- (throw 'exit (1+ (length seen-refs))))
- ;; Anonymous footnote: it's always a new one.
- ;; Also, be sure to return nil from the `cond' so
- ;; `first-match' doesn't get us out of the loop.
- ((not fn-lbl) (push 'inline seen-refs) nil)
- ;; Label not seen so far: add it so SEEN-REFS.
- ;;
- ;; Also search for subsequent references in
- ;; footnote definition so numbering follows
- ;; reading logic. Note that we don't have to care
- ;; about inline definitions, since
- ;; `org-element-map' already traverses them at the
- ;; right time.
- ;;
- ;; Once again, return nil to stay in the loop.
- ((not (member fn-lbl seen-refs))
- (push fn-lbl seen-refs)
- (funcall search-ref
- (org-export-get-footnote-definition fn info))
- nil))))
- ;; Don't enter footnote definitions since it will
- ;; happen when their first reference is found.
- info 'first-match 'footnote-definition)))))
- (catch 'exit (funcall search-ref (plist-get info :parse-tree)))))
+INFO is the plist containing export state.
+
+Number is unique throughout the whole parse tree, or DATA, when
+non-nil.
+
+By default, as soon as a new footnote reference is encountered,
+counting process moves into its definition. However, if
+BODY-FIRST is non-nil, this step is delayed until the end of the
+process, leading to a different order when footnotes are nested."
+ (let ((count 0)
+ (seen)
+ (label (org-element-property :label footnote)))
+ (catch 'exit
+ (org-export--footnote-reference-map
+ (lambda (f)
+ (let ((l (org-element-property :label f)))
+ (cond
+ ;; Anonymous footnote match: return number.
+ ((and (not l) (not label) (eq footnote f)) (throw 'exit (1+ count)))
+ ;; Labels match: return number.
+ ((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)))))
+ (or data (plist-get info :parse-tree)) info body-first))))
;;;; For Headlines
@@ -3659,7 +3797,9 @@ INFO is the plist used as a communication channel."
;;
;; `org-export-get-headline-number' returns the section number of an
;; headline, while `org-export-number-to-roman' allows to convert it
-;; to roman numbers.
+;; to roman numbers. With an optional argument,
+;; `org-export-get-headline-number' returns a number to unnumbered
+;; headlines (used for internal id).
;;
;; `org-export-low-level-p', `org-export-first-sibling-p' and
;; `org-export-last-sibling-p' are three useful predicates when it
@@ -3695,16 +3835,20 @@ and the last level being considered as high enough, or nil."
(and (> level limit) (- level limit))))))
(defun org-export-get-headline-number (headline info)
- "Return HEADLINE numbering as a list of numbers.
+ "Return numbered HEADLINE numbering as a list of numbers.
INFO is a plist holding contextual information."
- (cdr (assoc headline (plist-get info :headline-numbering))))
+ (and (org-export-numbered-headline-p headline info)
+ (cdr (assq headline (plist-get info :headline-numbering)))))
(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."
- (let ((sec-num (plist-get info :section-numbers))
- (level (org-export-get-relative-level headline info)))
- (if (wholenump sec-num) (<= level sec-num) sec-num)))
+ (unless (org-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))
+ (level (org-export-get-relative-level headline info)))
+ (if (wholenump sec-num) (<= level sec-num) sec-num))))
(defun org-export-number-to-roman (n)
"Convert integer N into a roman numeral."
@@ -3743,15 +3887,11 @@ inherited from parent headlines and FILETAGS keywords."
(if (not inherited) (org-element-property :tags element)
;; Build complete list of inherited tags.
(let ((current-tag-list (org-element-property :tags element)))
- (mapc
- (lambda (parent)
- (mapc
- (lambda (tag)
- (when (and (memq (org-element-type parent) '(headline inlinetask))
- (not (member tag current-tag-list)))
- (push tag current-tag-list)))
- (org-element-property :tags parent)))
- (org-export-get-genealogy element))
+ (dolist (parent (org-element-lineage element))
+ (dolist (tag (org-element-property :tags parent))
+ (when (and (memq (org-element-type parent) '(headline inlinetask))
+ (not (member tag current-tag-list)))
+ (push tag current-tag-list))))
;; Add FILETAGS keywords and return results.
(org-uniquify (append (plist-get info :filetags) current-tag-list))))))
@@ -3783,19 +3923,7 @@ INFO is a plist used as a communication channel.
CATEGORY is automatically inherited from a parent headline, from
#+CATEGORY: keyword or created out of original file name. If all
fail, the fall-back value is \"???\"."
- (or (let ((headline (if (eq (org-element-type blob) 'headline) blob
- (org-export-get-parent-headline blob))))
- ;; Almost like `org-export-node-property', but we cannot trust
- ;; `plist-member' as every headline has a `:CATEGORY'
- ;; property, would it be nil or equal to "???" (which has the
- ;; same meaning).
- (let ((parent headline) value)
- (catch 'found
- (while parent
- (let ((category (org-element-property :CATEGORY parent)))
- (and category (not (equal "???" category))
- (throw 'found category)))
- (setq parent (org-element-property :parent parent))))))
+ (or (org-export-get-node-property :CATEGORY blob t)
(org-element-map (plist-get info :parse-tree) 'keyword
(lambda (kwd)
(when (equal (org-element-property :key kwd) "CATEGORY")
@@ -3809,19 +3937,24 @@ fail, the fall-back value is \"???\"."
"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."
- (or (org-element-property :alt-title headline)
- (org-element-property :title headline)))
-
-(defun org-export-first-sibling-p (headline info)
- "Non-nil when HEADLINE is the first sibling in its sub-tree.
-INFO is a plist used as a communication channel."
- (not (eq (org-element-type (org-export-get-previous-element headline info))
- 'headline)))
-
-(defun org-export-last-sibling-p (headline info)
- "Non-nil when HEADLINE is the last sibling in its sub-tree.
-INFO is a plist used as a communication channel."
- (not (org-export-get-next-element headline info)))
+ (let ((alt (org-element-property :ALT_TITLE headline)))
+ (if alt (org-element-parse-secondary-string
+ alt (org-element-restriction 'headline) headline)
+ (org-element-property :title headline))))
+
+(defun org-export-first-sibling-p (blob info)
+ "Non-nil when BLOB is the first sibling in its parent.
+BLOB is an element or an object. If BLOB is a headline, non-nil
+means it is the first sibling in the sub-tree. INFO is a plist
+used as a communication channel."
+ (memq (org-element-type (org-export-get-previous-element blob info))
+ '(nil section)))
+
+(defun org-export-last-sibling-p (blob info)
+ "Non-nil when BLOB is the last sibling in its parent.
+BLOB is an element or an object. INFO is a plist used as
+a communication channel."
+ (not (org-export-get-next-element blob info)))
;;;; For Keywords
@@ -3852,8 +3985,8 @@ meant to be translated with `org-export-data' or alike."
;;;; For Links
;;
-;; `org-export-solidify-link-text' turns a string into a safer version
-;; for links, replacing most non-standard characters with hyphens.
+;; `org-export-custom-protocol-maybe' handles custom protocol defined
+;; with `org-add-link-type', which see.
;;
;; `org-export-get-coderef-format' returns an appropriate format
;; string for coderefs.
@@ -3872,11 +4005,30 @@ meant to be translated with `org-export-data' or alike."
;; `org-export-resolve-coderef' associates a reference to a line
;; number in the element it belongs, or returns the reference itself
;; when the element isn't numbered.
+;;
+;; `org-export-file-uri' expands a filename as stored in :path value
+;; of a "file" link into a file URI.
-(defun org-export-solidify-link-text (s)
- "Take link text S and make a safe target out of it."
- (save-match-data
- (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-")))
+(defun org-export-custom-protocol-maybe (link desc backend)
+ "Try exporting LINK with a dedicated function.
+
+DESC is its description, as a string, or nil. BACKEND is the
+back-end used for export, as a symbol.
+
+Return output as a string, or nil if no protocol handles LINK.
+
+A custom protocol has precedence over regular back-end export.
+The function ignores links with an implicit type (e.g.,
+\"custom-id\")."
+ (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))))
+ (and (functionp protocol)
+ (funcall protocol
+ (org-link-unescape (org-element-property :path link))
+ desc
+ backend))))))
(defun org-export-get-coderef-format (path desc)
"Return format string for code reference link.
@@ -3902,18 +4054,13 @@ the provided rules is non-nil. The default rule is
This only applies to links without a description."
(and (not (org-element-contents link))
- (let ((case-fold-search t)
- (rules (or rules org-export-default-inline-image-rule)))
+ (let ((case-fold-search t))
(catch 'exit
- (mapc
- (lambda (rule)
- (and (string= (org-element-property :type link) (car rule))
- (string-match (cdr rule)
- (org-element-property :path link))
- (throw 'exit t)))
- rules)
- ;; Return nil if no rule matched.
- nil))))
+ (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))
+ (throw 'exit t)))))))
(defun org-export-resolve-coderef (ref info)
"Resolve a code reference REF.
@@ -3921,26 +4068,28 @@ This only applies to links without a description."
INFO is a plist used as a communication channel.
Return associated line number in source code, or REF itself,
-depending on src-block or example element's switches."
- (org-element-map (plist-get info :parse-tree) '(example-block src-block)
- (lambda (el)
- (with-temp-buffer
- (insert (org-trim (org-element-property :value el)))
- (let* ((label-fmt (regexp-quote
- (or (org-element-property :label-fmt el)
- org-coderef-label-format)))
- (ref-re
- (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$"
- (replace-regexp-in-string "%s" ref label-fmt nil t))))
- ;; Element containing REF is found. Resolve it to either
- ;; a label or a line number, as needed.
- (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)))))))
- info 'first-match))
+depending on src-block or example element's switches. Throw an
+error if no block contains REF."
+ (or (org-element-map (plist-get info :parse-tree) '(example-block src-block)
+ (lambda (el)
+ (with-temp-buffer
+ (insert (org-trim (org-element-property :value el)))
+ (let* ((label-fmt (regexp-quote
+ (or (org-element-property :label-fmt el)
+ org-coderef-label-format)))
+ (ref-re
+ (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$"
+ (format label-fmt ref))))
+ ;; Element containing REF is found. Resolve it to
+ ;; either a label or a line number, as needed.
+ (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)))))))
+ info 'first-match)
+ (user-error "Unable to resolve code reference: %s" ref)))
(defun org-export-resolve-fuzzy-link (link info)
"Return LINK destination.
@@ -3955,86 +4104,61 @@ Return value can be an object, an element, or nil:
\(i.e. #+NAME: path) of an element, return that element.
- If LINK path exactly matches any headline name, return that
- element. If more than one headline share that name, priority
- will be given to the one with the closest common ancestor, if
- any, or the first one in the parse tree otherwise.
+ element.
-- Otherwise, return nil.
+- Otherwise, throw an error.
Assume LINK type is \"fuzzy\". White spaces are not
significant."
- (let* ((raw-path (org-element-property :path link))
- (match-title-p (eq (aref raw-path 0) ?*))
+ (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 match-title-p (substring raw-path 1) raw-path)))
- ;; Cache for destinations that are not position dependent.
+ (if headline-only (substring raw-path 1) raw-path)))
(link-cache
(or (plist-get info :resolve-fuzzy-link-cache)
- (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache
- (make-hash-table :test 'equal)))
+ (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)))
- (cond
- ;; Destination is not position dependent: use cached value.
- ((and (not match-title-p) (not (eq cached 'not-found))) cached)
- ;; First try to find a matching "<<path>>" unless user specified
- ;; he was looking for a headline (path starts with a "*"
- ;; character).
- ((and (not match-title-p)
- (let ((match (org-element-map (plist-get info :parse-tree) 'target
- (lambda (blob)
- (and (equal (org-split-string
- (org-element-property :value blob))
- path)
- blob))
- info 'first-match)))
- (and match (puthash path match link-cache)))))
- ;; Then try to find an element with a matching "#+NAME: path"
- ;; affiliated keyword.
- ((and (not match-title-p)
- (let ((match (org-element-map (plist-get info :parse-tree)
- org-element-all-elements
- (lambda (el)
- (let ((name (org-element-property :name el)))
- (when (and name
- (equal (org-split-string name) path))
- el)))
- info 'first-match)))
- (and match (puthash path match link-cache)))))
- ;; Last case: link either points to a headline or to nothingness.
- ;; Try to find the source, with priority given to headlines with
- ;; the closest common ancestor. If such candidate is found,
- ;; return it, otherwise return nil.
- (t
- (let ((find-headline
- (function
- ;; Return first headline whose `:raw-value' property is
- ;; NAME in parse tree DATA, or nil. Statistics cookies
- ;; are ignored.
- (lambda (name data)
- (org-element-map data 'headline
- (lambda (headline)
- (when (equal (org-split-string
- (replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (org-element-property :raw-value headline)))
- name)
- headline))
- info 'first-match)))))
- ;; Search among headlines sharing an ancestor with link, from
- ;; closest to farthest.
- (catch 'exit
- (mapc
- (lambda (parent)
- (let ((foundp (funcall find-headline path parent)))
- (when foundp (throw 'exit foundp))))
- (let ((parent-hl (org-export-get-parent-headline link)))
- (if (not parent-hl) (list (plist-get info :parse-tree))
- (cons parent-hl (org-export-get-genealogy parent-hl)))))
- ;; No destination found: return nil.
- (and (not match-title-p) (puthash path nil link-cache))))))))
+ (if (not (eq cached 'not-found)) cached
+ (let ((ast (plist-get info :parse-tree)))
+ (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)))
+ link-cache)))))
(defun org-export-resolve-id-link (link info)
"Return headline referenced as LINK destination.
@@ -4042,18 +4166,19 @@ significant."
INFO is a plist used as a communication channel.
Return value can be the headline element matched in current parse
-tree, a file name or nil. Assume LINK type is either \"id\" or
-\"custom-id\"."
+tree or a file name. Assume LINK type is either \"id\" or
+\"custom-id\". Throw an error if no match is found."
(let ((id (org-element-property :path link)))
;; First check if id is within the current parse tree.
(or (org-element-map (plist-get info :parse-tree) 'headline
(lambda (headline)
- (when (or (string= (org-element-property :ID headline) id)
- (string= (org-element-property :CUSTOM_ID headline) id))
+ (when (or (equal (org-element-property :ID headline) id)
+ (equal (org-element-property :CUSTOM_ID headline) id))
headline))
info 'first-match)
;; Otherwise, look for external files.
- (cdr (assoc id (plist-get info :id-alist))))))
+ (cdr (assoc id (plist-get info :id-alist)))
+ (user-error "Unable to resolve ID \"%s\"" id))))
(defun org-export-resolve-radio-link (link info)
"Return radio-target object referenced as LINK destination.
@@ -4074,12 +4199,43 @@ has type \"radio\"."
radio))
info 'first-match)))
+(defun org-export-file-uri (filename)
+ "Return file URI associated to FILENAME."
+ (if (not (file-name-absolute-p filename)) filename
+ (concat "file:/"
+ (and (not (org-file-remote-p filename)) "/")
+ (if (org-string-match-p "\\`~" filename)
+ (expand-file-name filename)
+ filename))))
+
;;;; For References
;;
+;; `org-export-get-reference' associate a unique reference for any
+;; object or element.
+;;
;; `org-export-get-ordinal' associates a sequence number to any object
;; or element.
+(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))))
+
(defun org-export-get-ordinal (element info &optional types predicate)
"Return ordinal number of an element or object.
@@ -4107,13 +4263,9 @@ objects of the same type."
;; table, item, or headline containing the object.
(when (eq (org-element-type element) 'target)
(setq element
- (loop for parent in (org-export-get-genealogy element)
- when
- (memq
- (org-element-type parent)
- '(footnote-definition footnote-reference headline item
- table))
- return parent)))
+ (org-element-lineage
+ element
+ '(footnote-definition footnote-reference headline item table))))
(case (org-element-type element)
;; Special case 1: A headline returns its number as a list.
(headline (org-export-get-headline-number element info))
@@ -4195,17 +4347,21 @@ ELEMENT is excluded from count."
ELEMENT has either a `src-block' an `example-block' type.
Return a cons cell whose CAR is the source code, cleaned from any
-reference and protective comma and CDR is an alist between
-relative line number (integer) and name of code reference on that
-line (string)."
+reference, protective commas and spurious indentation, and CDR is
+an alist between relative line number (integer) and name of code
+reference on that line (string)."
(let* ((line 0) refs
+ (value (org-element-property :value element))
;; Get code and clean it. Remove blank lines at its
;; beginning and end.
(code (replace-regexp-in-string
"\\`\\([ \t]*\n\\)+" ""
(replace-regexp-in-string
"\\([ \t]*\n\\)*[ \t]*\\'" "\n"
- (org-element-property :value element))))
+ (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)
@@ -4331,9 +4487,10 @@ code."
;; `org-export-table-cell-ends-colgroup-p',
;; `org-export-table-row-starts-rowgroup-p',
;; `org-export-table-row-ends-rowgroup-p',
-;; `org-export-table-row-starts-header-p' and
-;; `org-export-table-row-ends-header-p' indicate position of current
-;; row or cell within the table.
+;; `org-export-table-row-starts-header-p',
+;; `org-export-table-row-ends-header-p' and
+;; `org-export-table-row-in-header-p' indicate position of current row
+;; or cell within the table.
(defun org-export-table-has-special-column-p (table)
"Non-nil when TABLE has a special column.
@@ -4649,7 +4806,7 @@ Returned borders ignore special rows."
borders))
(defun org-export-table-cell-starts-colgroup-p (table-cell info)
- "Non-nil when TABLE-CELL is at the beginning of a row group.
+ "Non-nil when TABLE-CELL is at the beginning of a column group.
INFO is a plist used as a communication channel."
;; A cell starts a column group either when it is at the beginning
;; of a row (or after the special column, if any) or when it has
@@ -4660,7 +4817,7 @@ INFO is a plist used as a communication channel."
(memq 'left (org-export-table-cell-borders table-cell info))))
(defun org-export-table-cell-ends-colgroup-p (table-cell info)
- "Non-nil when TABLE-CELL is at the end of a row group.
+ "Non-nil when TABLE-CELL is at the end of a column group.
INFO is a plist used as a communication channel."
;; A cell ends a column group either when it is at the end of a row
;; or when it has a right border.
@@ -4670,7 +4827,7 @@ INFO is a plist used as a communication channel."
(memq 'right (org-export-table-cell-borders table-cell info))))
(defun org-export-table-row-starts-rowgroup-p (table-row info)
- "Non-nil when TABLE-ROW is at the beginning of a column group.
+ "Non-nil when TABLE-ROW is at the beginning of a row group.
INFO is a plist used as a communication channel."
(unless (or (eq (org-element-property :type table-row) 'rule)
(org-export-table-row-is-special-p table-row info))
@@ -4679,7 +4836,7 @@ INFO is a plist used as a communication channel."
(or (memq 'top borders) (memq 'above borders)))))
(defun org-export-table-row-ends-rowgroup-p (table-row info)
- "Non-nil when TABLE-ROW is at the end of a column group.
+ "Non-nil when TABLE-ROW is at the end of a row group.
INFO is a plist used as a communication channel."
(unless (or (eq (org-element-property :type table-row) 'rule)
(org-export-table-row-is-special-p table-row info))
@@ -4687,21 +4844,25 @@ INFO is a plist used as a communication channel."
(car (org-element-contents table-row)) info)))
(or (memq 'bottom borders) (memq 'below borders)))))
+(defun org-export-table-row-in-header-p (table-row info)
+ "Non-nil when TABLE-ROW is located within table's header.
+INFO is a plist used as a communication channel. Always return
+nil for special rows and rows separators."
+ (and (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info)
+ (eql (org-export-table-row-group table-row info) 1)))
+
(defun org-export-table-row-starts-header-p (table-row info)
"Non-nil when TABLE-ROW is the first table header's row.
INFO is a plist used as a communication channel."
- (and (org-export-table-has-header-p
- (org-export-get-parent-table table-row) info)
- (org-export-table-row-starts-rowgroup-p table-row info)
- (= (org-export-table-row-group table-row info) 1)))
+ (and (org-export-table-row-in-header-p table-row info)
+ (org-export-table-row-starts-rowgroup-p table-row info)))
(defun org-export-table-row-ends-header-p (table-row info)
"Non-nil when TABLE-ROW is the last table header's row.
INFO is a plist used as a communication channel."
- (and (org-export-table-has-header-p
- (org-export-get-parent-table table-row) info)
- (org-export-table-row-ends-rowgroup-p table-row info)
- (= (org-export-table-row-group table-row info) 1)))
+ (and (org-export-table-row-in-header-p table-row info)
+ (org-export-table-row-ends-rowgroup-p table-row info)))
(defun org-export-table-row-number (table-row info)
"Return TABLE-ROW number.
@@ -4794,7 +4955,7 @@ return nil."
;; `org-export-collect-tables', `org-export-collect-figures' and
;; `org-export-collect-listings' can be derived from it.
-(defun org-export-collect-headlines (info &optional n)
+(defun org-export-collect-headlines (info &optional n scope)
"Collect headlines in order to build a table of contents.
INFO is a plist used as a communication channel.
@@ -4804,15 +4965,28 @@ the table of contents. Otherwise, it is set to the value of the
last headline level. See `org-export-headline-levels' for more
information.
+Optional argument SCOPE, when non-nil, is an element. If it is
+a headline, only children of SCOPE are collected. Otherwise,
+collect children of the headline containing provided element. If
+there is no such headline, collect all headlines. In any case,
+argument N becomes relative to the level of that headline.
+
Return a list of all exportable headlines as parsed elements.
-Footnote sections, if any, will be ignored."
- (let ((limit (plist-get info :headline-levels)))
- (setq n (if (wholenump n) (min n limit) limit))
- (org-element-map (plist-get info :parse-tree) 'headline
- #'(lambda (headline)
- (unless (org-element-property :footnote-section-p headline)
- (let ((level (org-export-get-relative-level headline info)))
- (and (<= level n) headline))))
+Footnote sections are ignored."
+ (let* ((scope (cond ((not scope) (plist-get info :parse-tree))
+ ((eq (org-element-type scope) 'headline) scope)
+ ((org-export-get-parent-headline scope))
+ (t (plist-get info :parse-tree))))
+ (limit (plist-get info :headline-levels))
+ (n (if (not (wholenump n)) limit
+ (min (if (eq (org-element-type scope) 'org-data) n
+ (+ (org-export-get-relative-level scope info) n))
+ limit))))
+ (org-element-map (org-element-contents scope) 'headline
+ (lambda (headline)
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((level (org-export-get-relative-level headline info)))
+ (and (<= level n) headline))))
info)))
(defun org-export-collect-elements (type info &optional predicate)
@@ -4954,6 +5128,18 @@ Return a list of src-block elements with a caption."
(opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
(closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
(apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("ru"
+ ;; http://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5
+ ;; http://www.artlebedev.ru/kovodstvo/sections/104/
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "{}<<"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex ">>{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "„" :html "&bdquo;" :latex "\\glqq{}"
+ :texinfo "@quotedblbase{}")
+ (closing-single-quote :utf-8 "“" :html "&ldquo;" :latex "\\grqq{}"
+ :texinfo "@quotedblleft{}")
+ (apostrophe :utf-8 "’" :html: "&#39;"))
("sv"
;; based on https://sv.wikipedia.org/wiki/Citattecken
(opening-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
@@ -4977,28 +5163,77 @@ Valid encodings include `:utf-8', `:html', `:latex' and
If no translation is found, the quote character is left as-is.")
-(defconst org-export-smart-quotes-regexps
- (list
- ;; Possible opening quote at beginning of string.
- "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\|\\s(\\)"
- ;; Possible closing quote at beginning of string.
- "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)"
- ;; Possible apostrophe at beginning of string.
- "\\`\\('\\)\\S-"
- ;; Opening single and double quotes.
- "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)"
- ;; Closing single and double quotes.
- "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)"
- ;; Apostrophe.
- "\\S-\\('\\)\\S-"
- ;; Possible opening quote at end of string.
- "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'"
- ;; Possible closing quote at end of string.
- "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'"
- ;; Possible apostrophe at end of string.
- "\\S-\\('\\)\\'")
- "List of regexps matching a quote or an apostrophe.
-In every regexp, quote or apostrophe matched is put in group 1.")
+(defun org-export--smart-quote-status (s info)
+ "Return smart quote status at the beginning of string S.
+INFO is the current export state, as a plist."
+ (let* ((parent (org-element-property :parent s))
+ (cache (or (plist-get info :smart-quote-cache)
+ (let ((table (make-hash-table :test #'eq)))
+ (plist-put info :smart-quote-cache table)
+ table)))
+ (value (gethash parent cache 'missing-data)))
+ (if (not (eq value 'missing-data)) (cdr (assq s value))
+ (let (level1-open level2-open full-status)
+ (org-element-map parent 'plain-text
+ (lambda (text)
+ (let ((start 0) current-status)
+ (while (setq start (string-match "['\"]" text start))
+ (incf start)
+ (push
+ (cond
+ ((equal (match-string 0 text) "\"")
+ (setf level1-open (not level1-open))
+ (setf level2-open nil)
+ (if level1-open 'opening-double-quote 'closing-double-quote))
+ ;; Not already in a level 1 quote: this is an
+ ;; apostrophe.
+ ((not level1-open) 'apostrophe)
+ ;; Apostrophe.
+ ((org-string-match-p "\\S-'\\S-" text) 'apostrophe)
+ ;; Apostrophe at the beginning of a string. Check
+ ;; white space at the end of the last object.
+ ((and (org-string-match-p "\\`'\\S-" text)
+ (let ((p (org-export-get-previous-element text info)))
+ (and p
+ (if (stringp p)
+ (not (org-string-match-p "[ \t]\\'" p))
+ (memq (org-element-property :post-blank p)
+ '(0 nil))))))
+ 'apostrophe)
+ ;; Apostrophe at the end of a string. Check white
+ ;; space at the beginning of the next object, which
+ ;; can only happen if that object is a string.
+ ((and (org-string-match-p "\\S-'\\'" text)
+ (let ((n (org-export-get-next-element text info)))
+ (and n
+ (not (and (stringp n)
+ (org-string-match-p "\\`[ \t]" n))))))
+ 'apostrophe)
+ ;; Lonesome apostrophe. Check white space around
+ ;; both ends.
+ ((and (equal text "'")
+ (let ((p (org-export-get-previous-element text info)))
+ (and p
+ (if (stringp p)
+ (not (org-string-match-p "[ \t]\\'" p))
+ (memq (org-element-property :post-blank p)
+ '(0 nil)))
+ (let ((n (org-export-get-next-element text info)))
+ (and n
+ (not (and (stringp n)
+ (org-string-match-p "\\`[ \t]"
+ n))))))))
+ 'apostrophe)
+ ;; Else, consider it as a level 2 quote.
+ (t (setf level2-open (not level2-open))
+ (if level2-open 'opening-single-quote
+ 'closing-single-quote)))
+ current-status))
+ (when current-status
+ (push (cons text (nreverse current-status)) full-status))))
+ info nil org-element-recursive-objects)
+ (puthash parent full-status cache)
+ (cdr (assq s full-status))))))
(defun org-export-activate-smart-quotes (s encoding info &optional original)
"Replace regular quotes with \"smart\" quotes in string S.
@@ -5013,107 +5248,18 @@ process, a non-nil ORIGINAL optional argument will provide that
original string.
Return the new string."
- (if (equal s "") ""
- (let* ((prev (org-export-get-previous-element (or original s) info))
- ;; Try to be flexible when computing number of blanks
- ;; before object. The previous object may be a string
- ;; introduced by the back-end and not completely parsed.
- (pre-blank (and prev
- (or (org-element-property :post-blank prev)
- ;; A string with missing `:post-blank'
- ;; property.
- (and (stringp prev)
- (string-match " *\\'" prev)
- (length (match-string 0 prev)))
- ;; Fallback value.
- 0)))
- (next (org-export-get-next-element (or original s) info))
- (get-smart-quote
- (lambda (q type)
- ;; Return smart quote associated to a give quote Q, as
- ;; a string. TYPE is a symbol among `open', `close' and
- ;; `apostrophe'.
- (let ((key (case type
- (apostrophe 'apostrophe)
- (open (if (equal "'" q) 'opening-single-quote
- 'opening-double-quote))
- (otherwise (if (equal "'" q) 'closing-single-quote
- 'closing-double-quote)))))
- (or (plist-get
- (cdr (assq key
- (cdr (assoc (plist-get info :language)
- org-export-smart-quotes-alist))))
- encoding)
- q)))))
- (if (or (equal "\"" s) (equal "'" s))
- ;; Only a quote: no regexp can match. We have to check both
- ;; sides and decide what to do.
- (cond ((and (not prev) (not next)) s)
- ((not prev) (funcall get-smart-quote s 'open))
- ((and (not next) (zerop pre-blank))
- (funcall get-smart-quote s 'close))
- ((not next) s)
- ((zerop pre-blank) (funcall get-smart-quote s 'apostrophe))
- (t (funcall get-smart-quote 'open)))
- ;; 1. Replace quote character at the beginning of S.
- (cond
- ;; Apostrophe?
- ((and prev (zerop pre-blank)
- (string-match (nth 2 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'apostrophe)
- nil t s 1)))
- ;; Closing quote?
- ((and prev (zerop pre-blank)
- (string-match (nth 1 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'close)
- nil t s 1)))
- ;; Opening quote?
- ((and (or (not prev) (> pre-blank 0))
- (string-match (nth 0 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'open)
- nil t s 1))))
- ;; 2. Replace quotes in the middle of the string.
- (setq s (replace-regexp-in-string
- ;; Opening quotes.
- (nth 3 org-export-smart-quotes-regexps)
- (lambda (text)
- (funcall get-smart-quote (match-string 1 text) 'open))
- s nil t 1))
- (setq s (replace-regexp-in-string
- ;; Closing quotes.
- (nth 4 org-export-smart-quotes-regexps)
- (lambda (text)
- (funcall get-smart-quote (match-string 1 text) 'close))
- s nil t 1))
- (setq s (replace-regexp-in-string
- ;; Apostrophes.
- (nth 5 org-export-smart-quotes-regexps)
- (lambda (text)
- (funcall get-smart-quote (match-string 1 text) 'apostrophe))
- s nil t 1))
- ;; 3. Replace quote character at the end of S.
- (cond
- ;; Apostrophe?
- ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'apostrophe)
- nil t s 1)))
- ;; Closing quote?
- ((and (not next)
- (string-match (nth 7 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'close)
- nil t s 1)))
- ;; Opening quote?
- ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'open)
- nil t s 1))))
- ;; Return string with smart quotes.
- s))))
+ (let ((quote-status
+ (copy-sequence (org-export--smart-quote-status (or original s) info))))
+ (replace-regexp-in-string
+ "['\"]"
+ (lambda (match)
+ (or (plist-get
+ (cdr (assq (pop quote-status)
+ (cdr (assoc (plist-get info :language)
+ org-export-smart-quotes-alist))))
+ encoding)
+ match))
+ s nil t)))
;;;; Topology
;;
@@ -5125,46 +5271,26 @@ Return the new string."
;; (`org-export-get-parent-table'), previous element or object
;; (`org-export-get-previous-element') and next element or object
;; (`org-export-get-next-element').
-;;
-;; `org-export-get-genealogy' returns the full genealogy of a given
-;; element or object, from closest parent to full parse tree.
;; defsubst org-export-get-parent must be defined before first use
-(defun org-export-get-genealogy (blob)
- "Return full genealogy relative to a given element or object.
-
-BLOB is the element or object being considered.
-Ancestors are returned from closest to farthest, the last one
-being the full parse tree."
- (let (genealogy (parent blob))
- (while (setq parent (org-element-property :parent parent))
- (push parent genealogy))
- (nreverse genealogy)))
+(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."
- (let ((parent blob))
- (while (and (setq parent (org-element-property :parent parent))
- (not (eq (org-element-type parent) 'headline))))
- parent))
+ (org-element-lineage blob '(headline)))
(defun org-export-get-parent-element (object)
"Return first element containing OBJECT or nil.
OBJECT is the object to consider."
- (let ((parent object))
- (while (and (setq parent (org-element-property :parent parent))
- (memq (org-element-type parent) org-element-all-objects)))
- parent))
+ (org-element-lineage object org-element-all-elements))
(defun org-export-get-parent-table (object)
"Return OBJECT parent table or nil.
OBJECT is either a `table-cell' or `table-element' type object."
- (let ((parent object))
- (while (and (setq parent (org-element-property :parent parent))
- (not (eq (org-element-type parent) 'table))))
- parent))
+ (org-element-lineage object '(table)))
(defun org-export-get-previous-element (blob info &optional n)
"Return previous element or object.
@@ -5177,27 +5303,19 @@ When optional argument N is a positive integer, return a list
containing up to N siblings before BLOB, from farthest to
closest. With any other non-nil value, return a list containing
all of them."
- (let ((siblings
- ;; An object can belong to the contents of its parent or
- ;; to a secondary string. We check the latter option
- ;; first.
- (let ((parent (org-export-get-parent blob)))
- (or (let ((sec-value (org-element-property
- (cdr (assq (org-element-type parent)
- org-element-secondary-value-alist))
- parent)))
- (and (memq blob sec-value) sec-value))
- (org-element-contents parent))))
- prev)
+ (let* ((secondary (org-element-secondary-p blob))
+ (parent (org-export-get-parent blob))
+ (siblings
+ (if secondary (org-element-property secondary parent)
+ (org-element-contents parent)))
+ prev)
(catch 'exit
- (mapc (lambda (obj)
- (cond ((memq obj (plist-get info :ignore-list)))
- ((null n) (throw 'exit obj))
- ((not (wholenump n)) (push obj prev))
- ((zerop n) (throw 'exit prev))
- (t (decf n) (push obj prev))))
- (cdr (memq blob (reverse siblings))))
- prev)))
+ (dolist (obj (cdr (memq blob (reverse siblings))) prev)
+ (cond ((memq obj (plist-get info :ignore-list)))
+ ((null n) (throw 'exit obj))
+ ((not (wholenump n)) (push obj prev))
+ ((zerop n) (throw 'exit prev))
+ (t (decf n) (push obj prev)))))))
(defun org-export-get-next-element (blob info &optional n)
"Return next element or object.
@@ -5210,26 +5328,20 @@ When optional argument N is a positive integer, return a list
containing up to N siblings after BLOB, from closest to farthest.
With any other non-nil value, return a list containing all of
them."
- (let ((siblings
- ;; An object can belong to the contents of its parent or to
- ;; a secondary string. We check the latter option first.
- (let ((parent (org-export-get-parent blob)))
- (or (let ((sec-value (org-element-property
- (cdr (assq (org-element-type parent)
- org-element-secondary-value-alist))
- parent)))
- (cdr (memq blob sec-value)))
- (cdr (memq blob (org-element-contents parent))))))
- next)
+ (let* ((secondary (org-element-secondary-p blob))
+ (parent (org-export-get-parent blob))
+ (siblings
+ (cdr (memq blob
+ (if secondary (org-element-property secondary parent)
+ (org-element-contents parent)))))
+ next)
(catch 'exit
- (mapc (lambda (obj)
- (cond ((memq obj (plist-get info :ignore-list)))
- ((null n) (throw 'exit obj))
- ((not (wholenump n)) (push obj next))
- ((zerop n) (throw 'exit (nreverse next)))
- (t (decf n) (push obj next))))
- siblings)
- (nreverse next))))
+ (dolist (obj siblings (nreverse next))
+ (cond ((memq obj (plist-get info :ignore-list)))
+ ((null n) (throw 'exit obj))
+ ((not (wholenump n)) (push obj next))
+ ((zerop n) (throw 'exit (nreverse next)))
+ (t (decf n) (push obj next)))))))
;;;; Translation
@@ -5248,22 +5360,44 @@ them."
("de" :default "Autor")
("eo" :html "A&#365;toro")
("es" :default "Autor")
+ ("et" :default "Autor")
("fi" :html "Tekij&auml;")
("fr" :default "Auteur")
("hu" :default "Szerz&otilde;")
("is" :html "H&ouml;fundur")
("it" :default "Autore")
- ("ja" :html "&#33879;&#32773;" :utf-8 "著者")
+ ("ja" :default "著者" :html "&#33879;&#32773;")
("nl" :default "Auteur")
("no" :default "Forfatter")
("nb" :default "Forfatter")
("nn" :default "Forfattar")
("pl" :default "Autor")
+ ("pt_BR" :default "Autor")
("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
("sv" :html "F&ouml;rfattare")
("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者")
("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者"))
+ ("Continued from previous page"
+ ("de" :default "Fortsetzung von vorheriger Seite")
+ ("es" :html "Contin&uacute;a de la p&aacute;gina anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior")
+ ("fr" :default "Suite de la page précédente")
+ ("it" :default "Continua da pagina precedente")
+ ("ja" :default "前ページからの続き")
+ ("nl" :default "Vervolg van vorige pagina")
+ ("pt" :default "Continuação da página anterior")
+ ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077;)"
+ :utf-8 "(Продолжение)"))
+ ("Continued on next page"
+ ("de" :default "Fortsetzung nächste Seite")
+ ("es" :html "Contin&uacute;a en la siguiente p&aacute;gina" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página")
+ ("fr" :default "Suite page suivante")
+ ("it" :default "Continua alla pagina successiva")
+ ("ja" :default "次ページに続く")
+ ("nl" :default "Vervolg op volgende pagina")
+ ("pt" :default "Continua na página seguinte")
+ ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077; &#1089;&#1083;&#1077;&#1076;&#1091;&#1077;&#1090;)"
+ :utf-8 "(Продолжение следует)"))
("Date"
("ca" :default "Data")
("cs" :default "Datum")
@@ -5271,16 +5405,18 @@ them."
("de" :default "Datum")
("eo" :default "Dato")
("es" :default "Fecha")
+ ("et" :html "Kuup&#228;ev" :utf-8 "Kuupäev")
("fi" :html "P&auml;iv&auml;m&auml;&auml;r&auml;")
("hu" :html "D&aacute;tum")
("is" :default "Dagsetning")
("it" :default "Data")
- ("ja" :html "&#26085;&#20184;" :utf-8 "日付")
+ ("ja" :default "日付" :html "&#26085;&#20184;")
("nl" :default "Datum")
("no" :default "Dato")
("nb" :default "Dato")
("nn" :default "Dato")
("pl" :default "Data")
+ ("pt_BR" :default "Data")
("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
("sv" :default "Datum")
("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
@@ -5289,32 +5425,43 @@ them."
("Equation"
("da" :default "Ligning")
("de" :default "Gleichung")
- ("es" :html "Ecuaci&oacute;n" :default "Ecuación")
+ ("es" :ascii "Ecuacion" :html "Ecuaci&oacute;n" :default "Ecuación")
+ ("et" :html "V&#245;rrand" :utf-8 "Võrrand")
("fr" :ascii "Equation" :default "Équation")
+ ("ja" :default "方程式")
("no" :default "Ligning")
("nb" :default "Ligning")
("nn" :default "Likning")
+ ("pt_BR" :html "Equa&ccedil;&atilde;o" :default "Equação" :ascii "Equacao")
+ ("ru" :html "&#1059;&#1088;&#1072;&#1074;&#1085;&#1077;&#1085;&#1080;&#1077;"
+ :utf-8 "Уравнение")
("sv" :default "Ekvation")
("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程"))
("Figure"
("da" :default "Figur")
("de" :default "Abbildung")
("es" :default "Figura")
- ("ja" :html "&#22259;" :utf-8 "図")
+ ("et" :default "Joonis")
+ ("ja" :default "図" :html "&#22259;")
("no" :default "Illustrasjon")
("nb" :default "Illustrasjon")
("nn" :default "Illustrasjon")
+ ("pt_BR" :default "Figura")
+ ("ru" :html "&#1056;&#1080;&#1089;&#1091;&#1085;&#1086;&#1082;" :utf-8 "Рисунок")
("sv" :default "Illustration")
("zh-CN" :html "&#22270;" :utf-8 "图"))
("Figure %d:"
("da" :default "Figur %d")
("de" :default "Abbildung %d:")
("es" :default "Figura %d:")
+ ("et" :default "Joonis %d:")
("fr" :default "Figure %d :" :html "Figure&nbsp;%d&nbsp;:")
- ("ja" :html "&#22259;%d: " :utf-8 "図%d: ")
+ ("ja" :default "図%d: " :html "&#22259;%d: ")
("no" :default "Illustrasjon %d")
("nb" :default "Illustrasjon %d")
("nn" :default "Illustrasjon %d")
+ ("pt_BR" :default "Figura %d:")
+ ("ru" :html "&#1056;&#1080;&#1089;. %d.:" :utf-8 "Рис. %d.:")
("sv" :default "Illustration %d")
("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d "))
("Footnotes"
@@ -5323,18 +5470,20 @@ them."
("da" :default "Fodnoter")
("de" :html "Fu&szlig;noten" :default "Fußnoten")
("eo" :default "Piednotoj")
- ("es" :html "Nota al pie de p&aacute;gina" :default "Nota al pie de página")
+ ("es" :ascii "Nota al pie de pagina" :html "Nota al pie de p&aacute;gina" :default "Nota al pie de página")
+ ("et" :html "Allm&#228;rkused" :utf-8 "Allmärkused")
("fi" :default "Alaviitteet")
("fr" :default "Notes de bas de page")
("hu" :html "L&aacute;bjegyzet")
("is" :html "Aftanm&aacute;lsgreinar")
("it" :html "Note a pi&egrave; di pagina")
- ("ja" :html "&#33050;&#27880;" :utf-8 "脚注")
+ ("ja" :default "脚注" :html "&#33050;&#27880;")
("nl" :default "Voetnoten")
("no" :default "Fotnoter")
("nb" :default "Fotnoter")
("nn" :default "Fotnotar")
("pl" :default "Przypis")
+ ("pt_BR" :html "Notas de Rodap&eacute;" :default "Notas de Rodapé" :ascii "Notas de Rodape")
("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски")
("sv" :default "Fotnoter")
("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;"
@@ -5344,50 +5493,95 @@ them."
("List of Listings"
("da" :default "Programmer")
("de" :default "Programmauflistungsverzeichnis")
- ("es" :default "Indice de Listados de programas")
+ ("es" :ascii "Indice de Listados de programas" :html "&Iacute;ndice de Listados de programas" :default "Índice de Listados de programas")
+ ("et" :default "Loendite nimekiri")
("fr" :default "Liste des programmes")
+ ("ja" :default "ソースコード目次")
("no" :default "Dataprogrammer")
("nb" :default "Dataprogrammer")
+ ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1088;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1086;&#1082;"
+ :utf-8 "Список распечаток")
("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录"))
("List of Tables"
("da" :default "Tabeller")
("de" :default "Tabellenverzeichnis")
- ("es" :default "Indice de tablas")
+ ("es" :ascii "Indice de tablas" :html "&Iacute;ndice de tablas" :default "Índice de tablas")
+ ("et" :default "Tabelite nimekiri")
("fr" :default "Liste des tableaux")
+ ("ja" :default "表目次")
("no" :default "Tabeller")
("nb" :default "Tabeller")
("nn" :default "Tabeller")
+ ("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas")
+ ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1090;&#1072;&#1073;&#1083;&#1080;&#1094;"
+ :utf-8 "Список таблиц")
("sv" :default "Tabeller")
("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录"))
+ ("Listing"
+ ("da" :default "Program")
+ ("de" :default "Programmlisting")
+ ("es" :default "Listado de programa")
+ ("et" :default "Loend")
+ ("fr" :default "Programme" :html "Programme")
+ ("ja" :default "ソースコード")
+ ("no" :default "Dataprogram")
+ ("nb" :default "Dataprogram")
+ ("pt_BR" :default "Listagem")
+ ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072;"
+ :utf-8 "Распечатка")
+ ("zh-CN" :html "&#20195;&#30721;" :utf-8 "代码"))
("Listing %d:"
("da" :default "Program %d")
("de" :default "Programmlisting %d")
("es" :default "Listado de programa %d")
+ ("et" :default "Loend %d")
("fr" :default "Programme %d :" :html "Programme&nbsp;%d&nbsp;:")
- ("no" :default "Dataprogram")
- ("nb" :default "Dataprogram")
+ ("ja" :default "ソースコード%d:")
+ ("no" :default "Dataprogram %d")
+ ("nb" :default "Dataprogram %d")
+ ("pt_BR" :default "Listagem %d")
+ ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072; %d.:"
+ :utf-8 "Распечатка %d.:")
("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d "))
+ ("References"
+ ("fr" :ascii "References" :default "Références")
+ ("de" :default "Quellen")
+ ("es" :default "Referencias"))
("See section %s"
("da" :default "jævnfør afsnit %s")
("de" :default "siehe Abschnitt %s")
- ("es" :default "vea seccion %s")
+ ("es" :ascii "Vea seccion %s" :html "Vea secci&oacute;n %s" :default "Vea sección %s")
+ ("et" :html "Vaata peat&#252;kki %s" :utf-8 "Vaata peatükki %s")
("fr" :default "cf. section %s")
- ("zh-CN" :html "&#21442;&#35265;&#31532;%d&#33410;" :utf-8 "参见第%s节"))
+ ("ja" :default "セクション %s を参照")
+ ("pt_BR" :html "Veja a se&ccedil;&atilde;o %s" :default "Veja a seção %s"
+ :ascii "Veja a secao %s")
+ ("ru" :html "&#1057;&#1084;. &#1088;&#1072;&#1079;&#1076;&#1077;&#1083; %s"
+ :utf-8 "См. раздел %s")
+ ("zh-CN" :html "&#21442;&#35265;&#31532;%s&#33410;" :utf-8 "参见第%s节"))
("Table"
("de" :default "Tabelle")
("es" :default "Tabla")
+ ("et" :default "Tabel")
("fr" :default "Tableau")
- ("ja" :html "&#34920;" :utf-8 "表")
+ ("ja" :default "表" :html "&#34920;")
+ ("pt_BR" :default "Tabela")
+ ("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072;"
+ :utf-8 "Таблица")
("zh-CN" :html "&#34920;" :utf-8 "表"))
("Table %d:"
("da" :default "Tabel %d")
("de" :default "Tabelle %d")
("es" :default "Tabla %d")
+ ("et" :default "Tabel %d")
("fr" :default "Tableau %d :")
- ("ja" :html "&#34920;%d:" :utf-8 "表%d:")
+ ("ja" :default "表%d:" :html "&#34920;%d:")
("no" :default "Tabell %d")
("nb" :default "Tabell %d")
("nn" :default "Tabell %d")
+ ("pt_BR" :default "Tabela %d")
+ ("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072; %d.:"
+ :utf-8 "Таблица %d.:")
("sv" :default "Tabell %d")
("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d "))
("Table of Contents"
@@ -5396,18 +5590,20 @@ them."
("da" :default "Indhold")
("de" :default "Inhaltsverzeichnis")
("eo" :default "Enhavo")
- ("es" :html "&Iacute;ndice")
+ ("es" :ascii "Indice" :html "&Iacute;ndice" :default "Índice")
+ ("et" :default "Sisukord")
("fi" :html "Sis&auml;llysluettelo")
("fr" :ascii "Sommaire" :default "Table des matières")
("hu" :html "Tartalomjegyz&eacute;k")
("is" :default "Efnisyfirlit")
("it" :default "Indice")
- ("ja" :html "&#30446;&#27425;" :utf-8 "目次")
+ ("ja" :default "目次" :html "&#30446;&#27425;")
("nl" :default "Inhoudsopgave")
("no" :default "Innhold")
("nb" :default "Innhold")
("nn" :default "Innhald")
("pl" :html "Spis tre&#x015b;ci")
+ ("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice")
("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
:utf-8 "Содержание")
("sv" :html "Inneh&aring;ll")
@@ -5417,16 +5613,22 @@ them."
("Unknown reference"
("da" :default "ukendt reference")
("de" :default "Unbekannter Verweis")
- ("es" :default "referencia desconocida")
+ ("es" :default "Referencia desconocida")
+ ("et" :default "Tundmatu viide")
("fr" :ascii "Destination inconnue" :default "Référence inconnue")
+ ("ja" :default "不明な参照先")
+ ("pt_BR" :default "Referência desconhecida"
+ :ascii "Referencia desconhecida")
+ ("ru" :html "&#1053;&#1077;&#1080;&#1079;&#1074;&#1077;&#1089;&#1090;&#1085;&#1072;&#1103; &#1089;&#1089;&#1099;&#1083;&#1082;&#1072;"
+ :utf-8 "Неизвестная ссылка")
("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用")))
"Dictionary for export engine.
-Alist whose CAR is the string to translate and CDR is an alist
-whose CAR is the language string and CDR is a plist whose
+Alist whose car is the string to translate and cdr is an alist
+whose car is the language string and cdr is a plist whose
properties are possible charsets and values translated terms.
-It is used as a database for `org-export-translate'. Since this
+It is used as a database for `org-export-translate'. Since this
function returns the string as-is if no translation was found,
the variable only needs to record values different from the
entry.")
@@ -5437,9 +5639,9 @@ entry.")
ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1'
and `:utf-8'. INFO is a plist used as a communication channel.
-Translation depends on `:language' property. Return the
-translated string. If no translation is found, try to fall back
-to `:default' encoding. If it fails, return S."
+Translation depends on `:language' property. Return the
+translated string. If no translation is found, try to fall back
+to `:default' encoding. If it fails, return S."
(let* ((lang (plist-get info :language))
(translations (cdr (assoc lang
(cdr (assoc s org-export-dictionary))))))
@@ -5524,12 +5726,17 @@ and `org-export-to-file' for more specialized functions."
(let* ((process-connection-type nil)
(,proc-buffer (generate-new-buffer-name "*Org Export Process*"))
(,process
- (start-process
- "org-export-process" ,proc-buffer
- (expand-file-name invocation-name invocation-directory)
- "-Q" "--batch"
- "-l" org-export-async-init-file
- "-l" ,temp-file)))
+ (apply
+ #'start-process
+ (append
+ (list "org-export-process"
+ ,proc-buffer
+ (expand-file-name invocation-name invocation-directory)
+ "--batch")
+ (if org-export-async-init-file
+ (list "-Q" "-l" org-export-async-init-file)
+ (list "-l" user-init-file))
+ (list "-l" ,temp-file)))))
;; Register running process in stack.
(org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
;; Set-up sentinel in order to catch results.
@@ -5698,9 +5905,6 @@ of subtree at point.
When optional argument PUB-DIR is set, use it as the publishing
directory.
-When optional argument VISIBLE-ONLY is non-nil, don't export
-contents of hidden elements.
-
Return file name as a string."
(let* ((visited-file (buffer-file-name (buffer-base-buffer)))
(base-name
@@ -6006,8 +6210,8 @@ back to standard interface."
;; if any.
(entries
(sort (sort (delq nil
- (mapcar 'org-export-backend-menu
- org-export--registered-backends))
+ (mapcar #'org-export-backend-menu
+ org-export-registered-backends))
(lambda (a b)
(let ((key-a (nth 1 a))
(key-b (nth 1 b)))
diff --git a/mk/default.mk b/mk/default.mk
index eb7fac7..72068d1 100644
--- a/mk/default.mk
+++ b/mk/default.mk
@@ -22,6 +22,10 @@ infodir = $(prefix)/info
# Define if you only need info documentation, the default includes html and pdf
#ORG_MAKE_DOC = info # html pdf
+# Define which git branch to switch to during update. Does not switch
+# the branch when undefined.
+GIT_BRANCH =
+
# Define if you want to include some (or all) files from contrib/lisp
# just the filename please (no path prefix, no .el suffix), maybe with globbing
#ORG_ADD_CONTRIB = ox-* # e.g. the contributed exporter
@@ -39,8 +43,9 @@ BTEST_POST =
# -L <path-to>/ert # needed for Emacs23, Emacs24 has ert built in
# -L <path-to>/ess # needed for running R tests
# -L <path-to>/htmlize # need at least version 1.34 for source code formatting
-BTEST_OB_LANGUAGES = awk C fortran maxima lilypond octave python sh perl
+BTEST_OB_LANGUAGES = awk C fortran maxima lilypond octave perl python
# R # requires ESS to be installed and configured
+ # ruby # requires inf-ruby to be installed and configured
# extra packages to require for testing
BTEST_EXTRA =
# ess-site # load ESS for R tests
@@ -50,23 +55,41 @@ BTEST_EXTRA =
# How to run tests
req-ob-lang = --eval '(require '"'"'ob-$(ob-lang))'
+lst-ob-lang = ($(ob-lang) . t)
req-extra = --eval '(require '"'"'$(req))'
-BTEST = $(BATCH) \
- $(BTEST_PRE) \
- --eval '(add-to-list '"'"'load-path "./lisp")' \
- --eval '(add-to-list '"'"'load-path "./testing")' \
- $(BTEST_POST) \
+BTEST_RE ?= \\(org\\|ob\\)
+BTEST_LOAD = \
+ --eval '(add-to-list '"'"'load-path (concat default-directory "lisp"))' \
+ --eval '(add-to-list '"'"'load-path (concat default-directory "testing"))'
+BTEST_INIT = $(BTEST_PRE) $(BTEST_LOAD) $(BTEST_POST)
+
+BTEST = $(BATCH) $(BTEST_INIT) \
+ -l org-batch-test-init \
+ --eval '(setq \
+ org-batch-test t \
+ org-babel-load-languages \
+ (quote ($(foreach ob-lang,\
+ $(BTEST_OB_LANGUAGES) emacs-lisp shell org,\
+ $(lst-ob-lang)))) \
+ org-test-select-re "$(BTEST_RE)" \
+ )' \
-l org-loaddefs.el \
- -l testing/org-test.el \
- $(foreach ob-lang,$(BTEST_OB_LANGUAGES),$(req-ob-lang)) \
+ -l cl -l testing/org-test.el \
+ -l ert -l org -l ox \
$(foreach req,$(BTEST_EXTRA),$(req-extra)) \
- --eval '(setq org-confirm-babel-evaluate nil)' \
- -f org-test-run-batch-tests
+ --eval '(org-test-run-batch-tests org-test-select-re)'
+
+# Running a plain emacs with no config and this Org-mode loaded. This
+# should be useful for manual testing and verification of problems.
+NOBATCH = $(EMACSQ) $(BTEST_INIT) -l org -f org-version
+
+# start Emacs with no user and site configuration
+# EMACSQ = -vanilla # XEmacs
+EMACSQ = $(EMACS) -Q
# Using emacs in batch mode.
-# BATCH = $(EMACS) -batch -vanilla # XEmacs
-BATCH = $(EMACS) -batch -Q \
- --eval '(setq vc-handled-backends nil)'
+BATCH = $(EMACSQ) -batch \
+ --eval '(setq vc-handled-backends nil org-startup-folded nil)'
# Emacs must be started in toplevel directory
BATCHO = $(BATCH) \
@@ -103,7 +126,7 @@ ELC = $(BATCHL) \
--eval '(batch-byte-compile)'
# How to make a pdf file from a texinfo file
-TEXI2PDF = texi2pdf --batch --clean
+TEXI2PDF = texi2pdf --batch --clean --expand
# How to make a pdf file from a tex file
PDFTEX = pdftex
diff --git a/mk/targets.mk b/mk/targets.mk
index 7f26d86..d390fdb 100644
--- a/mk/targets.mk
+++ b/mk/targets.mk
@@ -31,13 +31,14 @@ endif
clean-install cleanelc cleandirs cleanaddcontrib \
cleanlisp cleandoc cleandocs cleantest \
compile compile-dirty uncompiled \
- config config-test config-exe config-all config-eol config-version
+ config config-test config-exe config-all config-eol config-version \
+ vanilla
CONF_BASE = EMACS DESTDIR ORGCM ORG_MAKE_DOC
CONF_DEST = lispdir infodir datadir testdir
-CONF_TEST = BTEST_PRE BTEST_POST BTEST_OB_LANGUAGES BTEST_EXTRA
+CONF_TEST = BTEST_PRE BTEST_POST BTEST_OB_LANGUAGES BTEST_EXTRA BTEST_RE
CONF_EXEC = CP MKDIR RM RMR FIND SUDO PDFTEX TEXI2PDF TEXI2HTML MAKEINFO INSTALL_INFO
-CONF_CALL = BATCH BATCHL ELC ELCDIR BTEST MAKE_LOCAL_MK MAKE_ORG_INSTALL MAKE_ORG_VERSION
+CONF_CALL = BATCH BATCHL ELC ELCDIR NOBATCH BTEST MAKE_LOCAL_MK MAKE_ORG_INSTALL MAKE_ORG_VERSION
config-eol:: EOL = \#
config-eol:: config-all
config config-all::
@@ -94,6 +95,9 @@ compile compile-dirty::
all clean-install::
$(foreach dir, $(SUBDIRS), $(MAKE) -C $(dir) $@;)
+vanilla:
+ -@$(NOBATCH) &
+
check test:: compile
check test test-dirty::
-$(MKDIR) $(testdir)
@@ -104,6 +108,7 @@ endif
up0:: cleanaddcontrib
up0 up1 up2::
+ git checkout $(GIT_BRANCH)
git remote update
git pull
up1 up2:: all
diff --git a/mk/version.mk b/mk/version.mk
index d33d8e4..877cfee 100644
--- a/mk/version.mk
+++ b/mk/version.mk
@@ -1,2 +1,2 @@
-ORGVERSION ?= 8.2.10
-GITVERSION ?= 8.2.10-dist
+ORGVERSION ?= 8.3.1
+GITVERSION ?= 8.3.1-dist