From 4ede41abf73867d4af990ec9d444d50d21ff79c7 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Sun, 18 Mar 2012 21:02:41 +0100 Subject: [PATCH] Master fixup --- EXPERIMENTAL/org-e-latex.el | 1317 +++++++---- Makefile | 4 +- contrib/babel/langs/ob-fomus.el | 2 +- contrib/babel/langs/ob-oz.el | 2 +- contrib/lisp/htmlize.el | 8 +- contrib/lisp/org-bookmark.el | 4 +- contrib/lisp/org-checklist.el | 3 - contrib/lisp/org-choose.el | 76 +- contrib/lisp/org-collector.el | 4 +- contrib/lisp/org-drill.el | 1 - contrib/lisp/org-element.el | 2546 +++++++++++---------- contrib/lisp/org-eval-light.el | 4 +- contrib/lisp/org-eval.el | 7 +- contrib/lisp/org-expiry.el | 26 +- contrib/lisp/org-export-generic.el | 60 +- contrib/lisp/org-export.el | 3420 ++++++++++++++++++----------- contrib/lisp/org-interactive-query.el | 8 +- contrib/lisp/org-invoice.el | 18 +- contrib/lisp/org-mac-iCal.el | 6 +- contrib/lisp/org-mac-link-grabber.el | 10 +- contrib/lisp/org-mairix.el | 6 +- contrib/lisp/org-mime.el | 4 +- contrib/lisp/org-mtags.el | 1 - contrib/lisp/org-notmuch.el | 10 +- contrib/lisp/org-panel.el | 2 - contrib/lisp/org-registry.el | 8 +- contrib/lisp/org-screen.el | 8 +- contrib/lisp/org-static-mathjax.el | 12 +- contrib/lisp/org-sudoku.el | 6 +- contrib/lisp/org-toc.el | 8 +- contrib/lisp/org-wikinodes.el | 6 +- contrib/lisp/org2rem.el | 6 +- contrib/lisp/test-org-export-preproc.el | 1 - contrib/scripts/StartOzServer.oz | 2 +- contrib/scripts/org2hpda | 2 +- doc/org.texi | 295 ++- doc/orgcard.tex | 2 +- doc/orgguide.texi | 37 +- doc/pdflayout.sty | 2 +- doc/texinfo.tex | 4 +- lisp/ob-awk.el | 4 +- lisp/ob-ditaa.el | 19 +- lisp/ob-exp.el | 130 +- lisp/ob-gnuplot.el | 2 +- lisp/ob-haskell.el | 2 +- lisp/ob-js.el | 1 + lisp/ob-lilypond.el | 96 +- lisp/ob-lisp.el | 1 + lisp/ob-lob.el | 5 +- lisp/ob-ocaml.el | 2 +- lisp/ob-picolisp.el | 9 +- lisp/ob-plantuml.el | 1 + lisp/ob-ref.el | 2 +- lisp/ob-ruby.el | 4 +- lisp/ob-scheme.el | 1 + lisp/ob-sh.el | 46 +- lisp/ob-sql.el | 6 +- lisp/ob-tangle.el | 15 +- lisp/ob.el | 110 +- lisp/org-agenda.el | 49 +- lisp/org-archive.el | 2 + lisp/org-ascii.el | 2 +- lisp/org-attach.el | 1 + lisp/org-bbdb.el | 1 + lisp/org-beamer.el | 10 + lisp/org-bibtex.el | 9 + lisp/org-capture.el | 14 +- lisp/org-clock.el | 18 +- lisp/org-crypt.el | 7 +- lisp/org-ctags.el | 3 + lisp/org-docbook.el | 2 + lisp/org-entities.el | 2 + lisp/org-eshell.el | 2 +- lisp/org-exp-blocks.el | 7 +- lisp/org-exp.el | 6 + lisp/org-faces.el | 3 + lisp/org-feed.el | 2 +- lisp/org-footnote.el | 1 + lisp/org-freemind.el | 1 + lisp/org-gnus.el | 3 +- lisp/org-habit.el | 2 + lisp/org-html.el | 9 + lisp/org-icalendar.el | 4 + lisp/org-id.el | 6 +- lisp/org-indent.el | 7 +- lisp/org-inlinetask.el | 21 +- lisp/org-irc.el | 2 +- lisp/org-latex.el | 21 +- lisp/org-list.el | 66 +- lisp/org-mks.el | 2 +- lisp/org-mobile.el | 16 +- lisp/org-pcomplete.el | 34 +- lisp/org-publish.el | 11 +- lisp/org-remember.el | 3 +- lisp/org-special-blocks.el | 2 +- lisp/org-src.el | 40 +- lisp/org-table.el | 11 +- lisp/org-taskjuggler.el | 16 +- lisp/org-timer.el | 1 + lisp/org-vm.el | 89 +- lisp/org-wl.el | 5 + lisp/org.el | 381 +++- testing/examples/babel.org | 180 +- testing/examples/normal.org | 10 + testing/lisp/test-ob-C.el | 14 +- testing/lisp/test-ob-R.el | 14 +- testing/lisp/test-ob-awk.el | 14 +- testing/lisp/test-ob-emacs-lisp.el | 12 - testing/lisp/test-ob-exp.el | 250 ++- testing/lisp/test-ob-fortran.el | 34 +- testing/lisp/test-ob-lilypond.el | 35 +- testing/lisp/test-ob-lob.el | 2 +- testing/lisp/test-ob-maxima.el | 28 +- testing/lisp/test-ob-octave.el | 14 +- testing/lisp/test-ob-python.el | 14 +- testing/lisp/test-ob-sh.el | 15 +- testing/lisp/test-ob-table.el | 12 +- testing/lisp/test-ob-tangle.el | 11 +- testing/lisp/test-ob.el | 373 +++- testing/lisp/test-org-exp.el | 11 +- testing/lisp/test-org-html.el | 13 +- testing/lisp/test-org-table.el | 38 +- testing/lisp/test-org.el | 57 +- testing/lisp/test-property-inheritance.el | 11 +- testing/org-test-ob-consts.el | 4 +- testing/org-test.el | 30 +- 126 files changed, 6557 insertions(+), 3937 deletions(-) diff --git a/EXPERIMENTAL/org-e-latex.el b/EXPERIMENTAL/org-e-latex.el index f9bf00d..0f52bec 100644 --- a/EXPERIMENTAL/org-e-latex.el +++ b/EXPERIMENTAL/org-e-latex.el @@ -1,6 +1,6 @@ ;;; org-e-latex.el --- LaTeX Back-End For Org Export Engine -;; Copyright (C) 2011 Free Software Foundation, Inc. +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp @@ -36,8 +36,54 @@ ;;; Code: (eval-when-compile (require 'cl)) -(require 'org-element) -(require 'org-export) + +(defvar org-export-latex-default-packages-alist) +(defvar org-export-latex-packages-alist) + +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-normalize-string "org-element" (s)) +(declare-function org-element-parse-secondary-string + "org-element" (string restriction &optional buffer)) +(defvar org-element-string-restrictions) +(defvar org-element-object-restrictions) + +(declare-function org-export-clean-table "org-export" (table specialp)) +(declare-function org-export-data "org-export" (data backend info)) +(declare-function org-export-directory "org-export" (type plist)) +(declare-function org-export-expand-macro "org-export" (macro info)) +(declare-function org-export-first-sibling-p "org-export" (headline info)) +(declare-function org-export-footnote-first-reference-p "org-export" + (footnote-reference info)) +(declare-function org-export-format-code "org-export" + (code fun &optional num-lines ref-alist)) +(declare-function org-export-format-code-default "org-export" (element info)) +(declare-function org-export-get-coderef-format "org-export" (path desc)) +(declare-function org-export-get-footnote-definition "org-export" + (footnote-reference info)) +(declare-function org-export-get-footnote-number "org-export" (footnote info)) +(declare-function org-export-get-previous-element "org-export" (blob info)) +(declare-function org-export-get-relative-level "org-export" (headline info)) +(declare-function org-export-unravel-code + "org-export" (element info &optional num-fmt ref-fmt delayed)) +(declare-function org-export-included-file "org-export" (keyword backend info)) +(declare-function org-export-inline-image-p "org-export" + (link &optional extensions)) +(declare-function org-export-last-sibling-p "org-export" (headline info)) +(declare-function org-export-low-level-p "org-export" (headline info)) +(declare-function org-export-output-file-name + "org-export" (extension &optional subtreep pub-dir)) +(declare-function org-export-resolve-coderef "org-export" (ref info)) +(declare-function org-export-resolve-fuzzy-link "org-export" (link info)) +(declare-function org-export-secondary-string "org-export" + (secondary backend info)) +(declare-function org-export-solidify-link-text "org-export" (s)) +(declare-function org-export-table-format-info "org-export" (table)) +(declare-function + org-export-to-buffer "org-export" + (backend buffer &optional subtreep visible-only body-only ext-plist)) +(declare-function + org-export-to-file "org-export" + (backend file &optional subtreep visible-only body-only ext-plist)) @@ -56,7 +102,7 @@ (defconst org-e-latex-option-alist ;;; User Configurable Variables -(defgroup org-export-latex nil +(defgroup org-export-e-latex nil "Options for exporting Org mode files to LaTeX." :tag "Org Export LaTeX" :group 'org-export) @@ -66,7 +112,7 @@ (defgroup org-export-latex nil (defcustom org-e-latex-default-class "article" "The default LaTeX class." - :group 'org-export-latex + :group 'org-export-e-latex :type '(string :tag "LaTeX class")) (defcustom org-e-latex-classes @@ -103,20 +149,22 @@ (defcustom org-e-latex-classes The header string ----------------- -The HEADER-STRING is the header that will be inserted into the LaTeX file. -It should contain the \\documentclass macro, and anything else that is needed -for this setup. To this header, the following commands will be added: +The HEADER-STRING is the header that will be inserted into the +LaTeX file. It should contain the \\documentclass macro, and +anything else that is needed for this setup. To this header, the +following commands will be added: -- Calls to \\usepackage for all packages mentioned in the variables - `org-e-latex-default-packages-alist' and - `org-e-latex-packages-alist'. Thus, your header definitions should - avoid to also request these packages. +- Calls to \\usepackage for all packages mentioned in the + variables `org-export-latex-default-packages-alist' and + `org-export-latex-packages-alist'. Thus, your header + definitions should avoid to also request these packages. - Lines specified via \"#+LaTeX_HEADER:\" -If you need more control about the sequence in which the header is built -up, or if you want to exclude one of these building blocks for a particular -class, you can use the following macro-like placeholders. +If you need more control about the sequence in which the header +is built up, or if you want to exclude one of these building +blocks for a particular class, you can use the following +macro-like placeholders. [DEFAULT-PACKAGES] \\usepackage statements for default packages [NO-DEFAULT-PACKAGES] do not include any of the default packages @@ -134,23 +182,26 @@ (defcustom org-e-latex-classes \\providecommand{\\alert}[1]{\\textbf{#1}} [PACKAGES] -will omit the default packages, and will include the #+LaTeX_HEADER lines, -then have a call to \\providecommand, and then place \\usepackage commands -based on the content of `org-e-latex-packages-alist'. - -If your header or `org-e-latex-default-packages-alist' inserts -\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be replaced with -a coding system derived from `buffer-file-coding-system'. See also the -variable `org-e-latex-inputenc-alist' for a way to influence this +will omit the default packages, and will include the +#+LaTeX_HEADER lines, then have a call to \\providecommand, and +then place \\usepackage commands based on the content of +`org-export-latex-packages-alist'. + +If your header, `org-export-latex-default-packages-alist' or +`org-export-latex-packages-alist' inserts +\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be +replaced with a coding system derived from +`buffer-file-coding-system'. See also the variable +`org-e-latex-inputenc-alist' for a way to influence this mechanism. The sectioning structure ------------------------ -The sectioning structure of the class is given by the elements following -the header string. For each sectioning level, a number of strings is -specified. A %s formatter is mandatory in each section string and will -be replaced by the title of the section. +The sectioning structure of the class is given by the elements +following the header string. For each sectioning level, a number +of strings is specified. A %s formatter is mandatory in each +section string and will be replaced by the title of the section. Instead of a cons cell \(numbered . unnumbered\), you can also provide a list of 2 or 4 elements, @@ -161,16 +212,16 @@ (defcustom org-e-latex-classes \(numbered-open numbered-close unnumbered-open unnumbered-close\) -providing opening and closing strings for a LaTeX environment that should -represent the document section. The opening clause should have a %s -to represent the section title. +providing opening and closing strings for a LaTeX environment +that should represent the document section. The opening clause +should have a %s to represent the section title. -Instead of a list of sectioning commands, you can also specify a -function name. That function will be called with two parameters, -the (reduced) level of the headline, and a predicate non-nil when -the headline should be numbered. It must return a format string in -which the section title will be added." - :group 'org-export-latex +Instead of a list of sectioning commands, you can also specify +a function name. That function will be called with two +parameters, the \(reduced) level of the headline, and a predicate +non-nil when the headline should be numbered. It must return +a format string in which the section title will be added." + :group 'org-export-e-latex :type '(repeat (list (string :tag "LaTeX class") (string :tag "LaTeX header") @@ -194,7 +245,7 @@ (defcustom org-e-latex-inputenc-alist nil will cause \\usepackage[utf8x]{inputenc} to be used for buffers that are written as utf8 files." - :group 'org-export-latex + :group 'org-export-e-latex :type '(repeat (cons (string :tag "Derived from buffer") @@ -203,7 +254,7 @@ (defcustom org-e-latex-inputenc-alist nil (defcustom org-e-latex-date-format "\\today" "Format string for \\date{...}." - :group 'org-export-latex + :group 'org-export-e-latex :type 'boolean) (defcustom org-e-latex-title-command "\\maketitle" @@ -211,7 +262,7 @@ (defcustom org-e-latex-title-command "\\maketitle" If this string contains the formatting specification \"%s\" then it will be used as a formatting string, passing the title as an argument." - :group 'org-export-latex + :group 'org-export-e-latex :type 'string) @@ -232,13 +283,15 @@ (defcustom org-e-latex-format-headline-function nil As an example, one could set the variable to the following, in order to reproduce the default set-up: -\(defun org-e-latex-format-headline-default \(todo todo-type priority text tags\) +\(defun org-e-latex-format-headline \(todo todo-type priority text tags\) \"Default format function for an headline.\" - \(concat \(when todo \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo\)\) - \(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\) + \(concat \(when todo + \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo\)\) + \(when priority + \(format \"\\\\framebox{\\\\#%c} \" priority\)\) text \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)" - :group 'org-export-latex + :group 'org-export-e-latex :type 'function) @@ -261,7 +314,7 @@ (defcustom org-e-latex-emphasis-alist create a format string and select a delimiter character that isn't in the string. For the latter, Org will use \"\\texttt\" to typeset and try to protect special characters." - :group 'org-export-latex + :group 'org-export-e-latex :type 'alist) @@ -269,7 +322,7 @@ (defcustom org-e-latex-emphasis-alist (defcustom org-e-latex-footnote-separator "\\textsuperscript{,}\\," "Text used to separate footnotes." - :group 'org-export-latex + :group 'org-export-e-latex :type 'string) @@ -277,17 +330,17 @@ (defcustom org-e-latex-footnote-separator "\\textsuperscript{,}\\," (defcustom org-e-latex-active-timestamp-format "\\textit{%s}" "A printf format string to be applied to active time-stamps." - :group 'org-export-latex + :group 'org-export-e-latex :type 'string) (defcustom org-e-latex-inactive-timestamp-format "\\textit{%s}" "A printf format string to be applied to inactive time-stamps." - :group 'org-export-latex + :group 'org-export-e-latex :type 'string) (defcustom org-e-latex-diary-timestamp-format "\\textit{%s}" "A printf format string to be applied to diary time-stamps." - :group 'org-export-latex + :group 'org-export-e-latex :type 'string) @@ -295,48 +348,62 @@ (defcustom org-e-latex-diary-timestamp-format "\\textit{%s}" (defcustom org-e-latex-image-default-option "width=.9\\linewidth" "Default option for images." - :group 'org-export-latex + :group 'org-export-e-latex :type 'string) (defcustom org-e-latex-default-figure-position "htb" "Default position for latex figures." - :group 'org-export-latex + :group 'org-export-e-latex :type 'string) -(defcustom org-e-latex-inline-image-extensions - '("pdf" "jpeg" "jpg" "png" "ps" "eps") - "Extensions of image files that can be inlined into LaTeX. +(defcustom org-e-latex-inline-image-rules + '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\)\\'")) + "Rules characterizing image files that can be inlined into LaTeX. -Note that the image extension *actually* allowed depend on the -way the LaTeX file is processed. When used with pdflatex, pdf, -jpg and png images are OK. When processing through dvi to -Postscript, only ps and eps are allowed. The default we use here -encompasses both." - :group 'org-export-latex - :type '(repeat (string :tag "Extension"))) +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. + +Note that, by default, the image extension *actually* allowed +depend on the way the LaTeX file is processed. When used with +pdflatex, pdf, jpg and png images are OK. When processing +through dvi to Postscript, only ps and eps are allowed. The +default we use here encompasses both." + :group 'org-export-e-latex + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) ;;;; Tables (defcustom org-e-latex-default-table-environment "tabular" "Default environment used to build tables." - :group 'org-export-latex + :group 'org-export-e-latex :type 'string) (defcustom org-e-latex-tables-centered t "When non-nil, tables are exported in a center environment." - :group 'org-export-latex + :group 'org-export-e-latex :type 'boolean) (defcustom org-e-latex-tables-verbatim nil "When non-nil, tables are exported verbatim." - :group 'org-export-latex + :group 'org-export-e-latex + :type 'boolean) + +(defcustom org-e-latex-tables-booktabs nil + "When non-nil, display tables in a formal \"booktabs\" style. +This option assumes that the \"booktabs\" package is properly +loaded in the header of the document. This value can be ignored +locally with \"booktabs=yes\" and \"booktabs=no\" LaTeX +attributes." + :group 'org-export-e-latex :type 'boolean) (defcustom org-e-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 + :group 'org-export-e-latex :type 'boolean) @@ -357,7 +424,7 @@ (defcustom org-e-latex-format-drawer-function nil \(defun org-e-latex-format-drawer-default \(name contents\) \"Format a drawer element for LaTeX export.\" contents\)" - :group 'org-export-latex + :group 'org-export-e-latex :type 'function) @@ -379,11 +446,12 @@ (defcustom org-e-latex-format-inlinetask-function nil For example, the variable could be set to the following function in order to mimic default behaviour: -\(defun org-e-latex-format-inlinetask-default \(todo type priority name tags contents\) +\(defun org-e-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 todo + \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo\)\) \(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\) title \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)\) @@ -396,7 +464,7 @@ (defcustom org-e-latex-format-inlinetask-function nil \"\\\\end{minipage}}\" \"\\\\end{center}\"\) full-title contents\)\)" - :group 'org-export-latex + :group 'org-export-e-latex :type 'function) @@ -407,30 +475,30 @@ (defcustom org-e-latex-listings nil This package will fontify source code, possibly even with color. If you want to use this, you also need to make LaTeX use the listings package, and if you want to have color, the color -package. Just add these to `org-e-latex-packages-alist', -for example using customize, or with something like +package. Just add these to `org-export-latex-packages-alist', +for example using customize, or with something like: - (require 'org-e-latex) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\")) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\")) + \(require 'org-e-latex) + \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"listings\")) + \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"color\")) Alternatively, - (setq org-e-latex-listings 'minted) + \(setq org-e-latex-listings 'minted) causes source code to be exported using the minted package as opposed to listings. If you want to use minted, you need to add -the minted package to `org-e-latex-packages-alist', for +the minted package to `org-export-latex-packages-alist', for example using customize, or with - (require 'org-e-latex) - (add-to-list 'org-e-latex-packages-alist '(\"\" \"minted\")) + \(require 'org-e-latex) + \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"minted\")) -In addition, it is necessary to install -pygments (http://pygments.org), and to configure the variable -`org-e-latex-to-pdf-process' so that the -shell-escape option is +In addition, it is necessary to install pygments +\(http://pygments.org), and to configure the variable +`org-e-latex-pdf-process' so that the -shell-escape option is passed to pdflatex." - :group 'org-export-latex + :group 'org-export-e-latex :type '(choice (const :tag "Use listings" t) (const :tag "Use minted" 'minted) @@ -449,11 +517,11 @@ (defcustom org-e-latex-listings-langs (sql "SQL") (sqlite "sql")) "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 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 +The value is the string that should be inserted as the language +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-e-latex :type '(repeat (list (symbol :tag "Major mode ") @@ -463,11 +531,11 @@ (defcustom org-e-latex-listings-options nil "Association list of options for the latex listings package. These options are supplied as a comma-separated list to the -\\lstset command. Each element of the association list should be +\\lstset command. Each element of the association list should be a list containing two strings: the name of the option, and the -value. For example, +value. For example, - (setq org-export-latex-listings-options + (setq org-e-latex-listings-options '((\"basicstyle\" \"\\small\") (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) @@ -476,7 +544,7 @@ (defcustom org-e-latex-listings-options nil Note that the same options will be applied to blocks of all languages." - :group 'org-export-latex + :group 'org-export-e-latex :type '(repeat (list (string :tag "Listings option name ") @@ -490,16 +558,17 @@ (defcustom org-e-latex-minted-langs (caml "ocaml")) "Alist mapping languages to their minted 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 parameter -for the minted 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. +The value is the string that should be inserted as the language +parameter for the minted 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. Note that minted uses all lower case for language identifiers, and that the full list of language identifiers can be obtained with: -pygmentize -L lexers" - :group 'org-export-latex + + pygmentize -L lexers" + :group 'org-export-e-latex :type '(repeat (list (symbol :tag "Major mode ") @@ -509,12 +578,12 @@ (defcustom org-e-latex-minted-options nil "Association list of options for the latex minted package. These options are supplied within square brackets in -\\begin{minted} environments. Each element of the alist should be -a list containing two strings: the name of the option, and the -value. For example, +\\begin{minted} environments. Each element of the alist should +be a list containing two strings: the name of the option, and the +value. For example, - (setq org-export-latex-minted-options - '((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) + \(setq org-e-latex-minted-options + '\((\"bgcolor\" \"bg\") \(\"frame\" \"lines\"))) will result in src blocks being exported with @@ -522,19 +591,20 @@ (defcustom org-e-latex-minted-options nil as the start of the minted environment. Note that the same options will be applied to blocks of all languages." - :group 'org-export-latex + :group 'org-export-e-latex :type '(repeat (list (string :tag "Minted option name ") (string :tag "Minted option value")))) (defvar org-e-latex-custom-lang-environments nil - "Association list mapping languages to language-specific latex -environments used during export of src blocks by the listings and -minted latex packages. For example, + "Alist mapping languages to language-specific LaTeX environments. - (setq org-export-latex-custom-lang-environments - '((python \"pythoncode\"))) +It is used during export of src blocks by the listings and minted +latex packages. For example, + + \(setq org-e-latex-custom-lang-environments + '\(\(python \"pythoncode\"\)\)\) would have the effect that if org encounters begin_src python during latex export it will output @@ -560,7 +630,7 @@ (defcustom org-e-latex-quotes For each item in a CONS, the first string is a regexp for allowed characters before/after the quote, the second string defines the replacement string for this quote." - :group 'org-export-latex + :group 'org-export-e-latex :type '(list (cons :tag "Opening quote" (string :tag "Regexp for char before") @@ -573,34 +643,100 @@ (defcustom org-e-latex-quotes (string :tag "Replacement quote ")))) +;;;; Compilation + +(defcustom org-e-latex-pdf-process + '("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f") + "Commands to process a LaTeX file to a PDF file. +This is a list of strings, each of them will be given to the +shell as a command. %f in the command will be replaced by the +full file name, %b by the file base name \(i.e. without +extension) and %o by the base directory of the file. + +The reason why this is a list is that it usually takes several +runs of `pdflatex', maybe mixed with a call to `bibtex'. Org +does not have a clever mechanism to detect which of these +commands have to be run to get to a stable result, and it also +does not do any error checking. + +By default, Org uses 3 runs of `pdflatex' to do the processing. +If you have texi2dvi on your system and if that does not cause +the infamous egrep/locale bug: + + http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html + +then `texi2dvi' is the superior choice. Org does offer it as one +of the customize options. + +Alternatively, this may be a Lisp function that does the +processing, so you could use this to apply the machinery of +AUCTeX or the Emacs LaTeX mode. This function should accept the +file name as its single argument." + :group 'org-export-pdf + :type '(choice + (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (const :tag "2 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "pdflatex,bibtex,pdflatex,pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "texi2dvi" + ("texi2dvi -p -b -c -V %f")) + (const :tag "rubber" + ("rubber -d --into %o %f")) + (function))) + +(defcustom org-e-latex-logfiles-extensions + '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") + "The list of file extensions to consider as LaTeX logfiles." + :group 'org-export-e-latex + :type '(repeat (string :tag "Extension"))) + +(defcustom org-e-latex-remove-logfiles t + "Non-nil means remove the logfiles produced by PDF production. +These are the .aux, .log, .out, and .toc files." + :group 'org-export-e-latex + :type 'boolean) + + ;;; Internal Functions (defun org-e-latex--caption/label-string (caption label info) "Return caption and label LaTeX string for floats. -CAPTION is a secondary string \(a list of strings and Org -objects\) and LABEL a string representing the label. INFO is -a plist holding contextual information. +CAPTION is a cons cell of secondary strings, the car being the +standard caption and the cdr its short form. LABEL is a string +representing the label. INFO is a plist holding contextual +information. If there's no caption nor label, return the empty string. For non-floats, see `org-e-latex--wrap-label'." - (let ((caption-str (and caption - (org-export-secondary-string - caption 'e-latex info))) - (label-str (if label (format "\\label{%s}" label) ""))) + (let ((label-str (if label (format "\\label{%s}" label) ""))) (cond - ((and (not caption-str) (not label)) "") - ((not caption-str) (format "\\label{%s}\n" label)) + ((and (not caption) (not label)) "") + ((not caption) (format "\\label{%s}\n" label)) ;; Option caption format with short name. - ((string-match "\\[\\([^][]*\\)\\]{\\([^{}]*\\)}" caption-str) + ((cdr caption) (format "\\caption[%s]{%s%s}\n" - (org-match-string-no-properties 1 caption-str) + (org-export-secondary-string (cdr caption) 'e-latex info) label-str - (org-match-string-no-properties 2 caption-str))) + (org-export-secondary-string (car caption) 'e-latex info))) ;; Standard caption format. - (t (format "\\caption{%s%s}\n" label-str caption-str))))) + (t (format "\\caption{%s%s}\n" + label-str + (org-export-secondary-string (car caption) 'e-latex info)))))) (defun org-e-latex--guess-inputenc (header) "Set the coding system in inputenc to what the buffer is. @@ -612,8 +748,7 @@ (defun org-e-latex--guess-inputenc (header) (latexenc-coding-system-to-inputenc buffer-file-coding-system)) "utf8"))) - (if (not cs) - header + (if (not cs) header ;; First translate if that is requested. (setq cs (or (cdr (assoc cs org-e-latex-inputenc-alist)) cs)) ;; Then find the \usepackage statement and replace the option. @@ -641,7 +776,9 @@ (defun org-e-latex--make-option-string (options) ",")) (defun org-e-latex--quotation-marks (text info) - "Export quotation marks depending on language conventions." + "Export quotation marks depending on language conventions. +TEXT is a string containing quotation marks to be replaced. INFO +is a plist used as a communication channel." (mapc (lambda(l) (let ((start 0)) (while (setq start (string-match (car l) text start)) @@ -654,9 +791,9 @@ (defun org-e-latex--quotation-marks (text info) (defun org-e-latex--wrap-label (element output) "Wrap label associated to ELEMENT around OUTPUT, if appropriate. -This function shouldn't be used for floats. See +This function shouldn't be used for floats. See `org-e-latex--caption/label-string'." - (let ((label (org-element-get-property :name element))) + (let ((label (org-element-property :name element))) (if (or (not output) (not label) (string= output "") (string= label "")) output (concat (format "\\label{%s}\n" label) output)))) @@ -667,7 +804,7 @@ (defun org-e-latex--wrap-label (element output) (defun org-e-latex-template (contents info) "Return complete document string after LaTeX conversion. -CONTENTS is the transcoded contents string. INFO is a plist +CONTENTS is the transcoded contents string. INFO is a plist holding export options." (let ((title (org-export-secondary-string (plist-get info :title) 'e-latex info))) @@ -695,7 +832,11 @@ (defun org-e-latex-template (contents info) (plist-get info :latex-header-extra)))))) ;; 3. Define alert if not yet defined. "\\providecommand{\\alert}[1]{\\textbf{#1}}\n" - ;; 4. Author. + ;; 4. Possibly limit depth for headline numbering. + (let ((sec-num (plist-get info :section-numbers))) + (when (integerp sec-num) + (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) + ;; 5. Author. (let ((author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) (and auth (org-export-secondary-string @@ -707,23 +848,20 @@ (defun org-e-latex-template (contents info) (format "\\author{%s\\thanks{%s}}\n" author email)) (author (format "\\author{%s}\n" author)) (t "\\author{}\n"))) - ;; 5. Date. + ;; 6. Date. (let ((date (plist-get info :date))) (and date (format "\\date{%s}\n" date))) - ;; 6. Title + ;; 7. Title (format "\\title{%s}\n" title) - ;; 7. Hyperref options. + ;; 8. Hyperref options. (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" (or (plist-get info :keywords) "") (or (plist-get info :description) "") - (let ((creator-info (plist-get info :with-creator))) - (cond - ((not creator-info) "") - ((eq creator-info 'comment) "") - (t (plist-get info :creator))))) - ;; 7. Document start. + (if (not (plist-get info :with-creator)) "" + (plist-get info :creator))) + ;; 9. Document start. "\\begin{document}\n\n" - ;; 8. Title command. + ;; 10. Title command. (org-element-normalize-string (cond ((string= "" title) nil) ((not (stringp org-e-latex-title-command)) nil) @@ -731,22 +869,22 @@ (defun org-e-latex-template (contents info) org-e-latex-title-command) (format org-e-latex-title-command title)) (t org-e-latex-title-command))) - ;; 9. Table of contents. + ;; 11. Table of contents. (let ((depth (plist-get info :with-toc))) (when depth (concat (when (wholenump depth) (format "\\setcounter{tocdepth}{%d}\n" depth)) "\\tableofcontents\n\\vspace*{1cm}\n\n"))) - ;; 10. Document's body. + ;; 12. Document's body. contents - ;; 11. Creator. + ;; 13. Creator. (let ((creator-info (plist-get info :with-creator))) (cond - ((not creator-info)) + ((not creator-info) "") ((eq creator-info 'comment) (format "%% %s\n" (plist-get info :creator))) (t (concat (plist-get info :creator) "\n")))) - ;; 12. Document end. + ;; 14. Document end. "\\end{document}"))) @@ -780,7 +918,7 @@ (defun org-e-latex-drawer (drawer contents info) "Transcode a DRAWER element from Org to LaTeX. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (let* ((name (org-element-get-property :drawer-name drawer)) + (let* ((name (org-element-property :drawer-name drawer)) (output (if (functionp org-e-latex-format-drawer-function) (funcall org-e-latex-format-drawer-function name contents) @@ -806,7 +944,7 @@ (defun org-e-latex-emphasis (emphasis contents info) "Transcode EMPHASIS from Org to LaTeX. CONTENTS is the contents of the emphasized text. INFO is a plist holding contextual information.." - (format (cdr (assoc (org-element-get-property :marker emphasis) + (format (cdr (assoc (org-element-property :marker emphasis) org-e-latex-emphasis-alist)) contents)) @@ -817,21 +955,20 @@ (defun org-e-latex-entity (entity contents info) "Transcode an ENTITY object from Org to LaTeX. CONTENTS are the definition itself. INFO is a plist holding contextual information." - (let ((ent (org-element-get-property :latex entity))) - (if (org-element-get-property :latex-math-p entity) - (format "$%s$" ent) - ent))) + (let ((ent (org-element-property :latex entity))) + (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent))) ;;;; Example Block (defun org-e-latex-example-block (example-block contents info) - "Transcode a EXAMPLE-BLOCK element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let* ((options (or (org-element-get-property :options example-block) "")) - (value (org-export-handle-code - (org-element-get-property :value example-block) options info))) - (org-e-latex--wrap-label example-block value))) + "Transcode an EXAMPLE-BLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (org-e-latex--wrap-label + example-block + (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-export-format-code-default example-block info)))) ;;;; Export Snippet @@ -839,7 +976,8 @@ (defun org-e-latex-example-block (example-block contents info) (defun org-e-latex-export-snippet (export-snippet contents info) "Transcode a EXPORT-SNIPPET object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." - (org-element-get-property :value export-snippet)) + (when (eq (org-export-snippet-backend export-snippet) 'e-latex) + (org-element-property :value export-snippet))) ;;;; Export Block @@ -847,8 +985,8 @@ (defun org-e-latex-export-snippet (export-snippet contents info) (defun org-e-latex-export-block (export-block contents info) "Transcode a EXPORT-BLOCK element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-get-property :type export-block) "latex") - (org-remove-indentation (org-element-get-property :value export-block)))) + (when (string= (org-element-property :type export-block) "latex") + (org-remove-indentation (org-element-property :value export-block)))) ;;;; Fixed Width @@ -859,10 +997,9 @@ (defun org-e-latex-fixed-width (fixed-width contents info) (let* ((value (org-element-normalize-string (replace-regexp-in-string "^[ \t]*: ?" "" - (org-element-get-property :value fixed-width))))) + (org-element-property :value fixed-width))))) (org-e-latex--wrap-label - fixed-width - (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) + fixed-width (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) ;;;; Footnote Definition @@ -874,31 +1011,61 @@ (defun org-e-latex-fixed-width (fixed-width contents info) (defun org-e-latex-footnote-reference (footnote-reference contents info) "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." +CONTENTS is nil. INFO is a plist holding contextual information." (concat ;; Insert separator between two footnotes in a row. - (when (eq (plist-get info :previous-object) 'footnote-reference) - org-e-latex-footnote-separator) - ;; Use \footnotemark if the footnote has already been defined. - ;; Otherwise, define it with \footnote command. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (when (eq (org-element-type prev) 'footnote-reference) + org-e-latex-footnote-separator)) (cond + ;; Use \footnotemark if the footnote has already been defined. ((not (org-export-footnote-first-reference-p footnote-reference info)) - (format "\\footnotemark[%s]" + (format "\\footnotemark[%s]{}" (org-export-get-footnote-number footnote-reference info))) - ;; Inline definitions are secondary strings. - ((eq (org-element-get-property :type footnote-reference) 'inline) - (format "\\footnote{%s}" - (org-trim - (org-export-secondary-string - (org-export-get-footnote-definition footnote-reference info) - 'e-latex info)))) - ;; Non-inline footnotes definitions are full Org data. + ;; Use also \footnotemark if reference is within another footnote + ;; reference or footnote definition. + ((loop for parent in (org-export-get-genealogy footnote-reference info) + thereis (memq (org-element-type parent) + '(footnote-reference footnote-definition))) + (let ((num (org-export-get-footnote-number footnote-reference info))) + (format "\\footnotemark[%s]{}\\setcounter{footnote}{%s}" num num))) + ;; Otherwise, define it with \footnote command. (t - (format "\\footnote{%s}" - (org-trim - (org-export-data - (org-export-get-footnote-definition footnote-reference info) - 'e-latex info))))))) + (let ((def (org-export-get-footnote-definition footnote-reference info))) + (unless (eq (org-element-type def) 'org-data) + (setq def (cons 'org-data (cons nil def)))) + (concat + (format "\\footnote{%s}" (org-trim (org-export-data def 'e-latex info))) + ;; Retrieve all footnote references within the footnote and + ;; add their definition after it, since LaTeX doesn't support + ;; them inside. + (let (all-refs + (search-refs + (function + (lambda (data) + ;; Return a list of all footnote references in DATA. + (org-element-map + data 'footnote-reference + (lambda (ref) + (when (org-export-footnote-first-reference-p ref info) + (push ref all-refs) + (when (eq (org-element-property :type ref) 'standard) + (funcall + search-refs + (org-export-get-footnote-definition ref info))))) + info) (reverse all-refs))))) + (mapconcat + (lambda (ref) + (format + "\\footnotetext[%s]{%s}" + (org-export-get-footnote-number ref info) + (org-trim + (funcall + (if (eq (org-element-property :type ref) 'inline) + 'org-export-secondary-string + 'org-export-data) + (org-export-get-footnote-definition ref info) 'e-latex info)))) + (funcall search-refs def) "")))))))) ;;;; Headline @@ -908,10 +1075,8 @@ (defun org-e-latex-headline (headline contents info) CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." (let* ((class (plist-get info :latex-class)) - (numberedp (plist-get info :section-numbers)) - ;; Get level relative to current parsed data. - (level (+ (org-element-get-property :level headline) - (plist-get info :headline-offset))) + (level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) (class-sectionning (assoc class org-e-latex-classes)) ;; Section formatting will set two placeholders: one for the ;; title and the other for the contents. @@ -933,21 +1098,19 @@ (defun org-e-latex-headline (headline contents info) (when numberedp (concat (car sec) "\n%s" (nth 1 sec)))) ;; (num-in num-out no-num-in no-num-out) ((= (length sec) 4) - (if numberedp - (concat (car sec) "\n%s" (nth 1 sec)) + (if numberedp (concat (car sec) "\n%s" (nth 1 sec)) (concat (nth 2 sec) "\n%s" (nth 3 sec))))))) (text (org-export-secondary-string - (org-element-get-property :title headline) 'e-latex info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-get-property - :todo-keyword headline))) - (and todo - (org-export-secondary-string todo 'e-latex info))))) - (todo-type (and todo (org-element-get-property :todo-type headline))) + (org-element-property :title headline) 'e-latex info)) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-secondary-string todo 'e-latex info))))) + (todo-type (and todo (org-element-property :todo-type headline))) (tags (and (plist-get info :with-tags) - (org-element-get-property :tags headline))) + (org-element-property :tags headline))) (priority (and (plist-get info :with-priority) - (org-element-get-property :priority headline))) + (org-element-property :priority headline))) ;; Create the headline text. (full-text (if (functionp org-e-latex-format-headline-function) ;; User-defined formatting function. @@ -961,25 +1124,20 @@ (defun org-e-latex-headline (headline contents info) text (when tags (format "\\hfill{}\\textsc{%s}" tags))))) ;; Associate some \label to the headline for internal links. - (headline-labels (mapconcat - (lambda (p) - (let ((val (org-element-get-property p headline))) - (when val (format "\\label{%s}\n" - (if (eq p :begin) - (format "headline-%s" val) - val))))) - '(:custom-id :id :begin) "")) - (pre-blanks (make-string (org-element-get-property :pre-blank headline) - 10))) + (headline-label + (format "\\label{sec-%s}\n" + (mapconcat 'number-to-string + (org-export-get-headline-number headline info) + "-"))) + (pre-blanks + (make-string (org-element-property :pre-blank headline) 10))) (cond ;; Case 1: This is a footnote section: ignore it. - ((org-element-get-property :footnote-section-p headline) nil) + ((org-element-property :footnote-section-p headline) nil) ;; Case 2. This is a deep sub-tree: export it as a list item. ;; Also export as items headlines for which no section ;; format has been found. - ((or (not section-fmt) - (and (wholenump (plist-get info :headline-levels)) - (> level (plist-get info :headline-levels)))) + ((or (not section-fmt) (org-export-low-level-p headline info)) ;; Build the real contents of the sub-tree. (let ((low-level-body (concat @@ -987,18 +1145,18 @@ (defun org-e-latex-headline (headline contents info) (when (org-export-first-sibling-p headline info) (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) ;; Itemize headline - "\\item " full-text "\n" headline-labels pre-blanks contents))) - ;; If headline in the last sibling, close the list, before any - ;; blank line. Otherwise, simply return LOW-LEVEL-BODY. - (if (org-export-last-sibling-p headline info) - (replace-regexp-in-string - "[ \t\n]*\\'" - (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) - low-level-body) - low-level-body))) + "\\item " full-text "\n" headline-label pre-blanks contents))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any + ;; blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" + (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) + low-level-body)))) ;; Case 3. Standard headline. Export it as a section. (t (format section-fmt full-text - (concat headline-labels pre-blanks contents)))))) + (concat headline-label pre-blanks contents)))))) ;;;; Horizontal Rule @@ -1007,7 +1165,7 @@ (defun org-e-latex-horizontal-rule (horizontal-rule contents info) "Transcode an HORIZONTAL-RULE object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (let ((attr (mapconcat #'identity - (org-element-get-property :attr_latex horizontal-rule) + (org-element-property :attr_latex horizontal-rule) " "))) (org-e-latex--wrap-label horizontal-rule (concat "\\hrule " attr)))) @@ -1023,7 +1181,7 @@ (defun org-e-latex-inline-src-block (inline-src-block contents info) "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((code (org-element-get-property :value inline-src-block)) + (let* ((code (org-element-property :value inline-src-block)) (separator (org-e-latex--find-verb-separator code))) (cond ;; Do not use a special package: transcode it verbatim. @@ -1031,7 +1189,7 @@ (defun org-e-latex-inline-src-block (inline-src-block contents info) (concat "\\verb" separator code separator)) ;; Use minted package. ((eq org-e-latex-listings 'minted) - (let* ((org-lang (org-element-get-property :language inline-src-block)) + (let* ((org-lang (org-element-property :language inline-src-block)) (mint-lang (or (cadr (assq (intern org-lang) org-e-latex-minted-langs)) org-lang)) @@ -1044,7 +1202,7 @@ (defun org-e-latex-inline-src-block (inline-src-block contents info) ;; Use listings package. (t ;; Maybe translate language's name. - (let* ((org-lang (org-element-get-property :language inline-src-block)) + (let* ((org-lang (org-element-property :language inline-src-block)) (lst-lang (or (cadr (assq (intern org-lang) org-e-latex-listings-langs)) org-lang)) @@ -1062,17 +1220,17 @@ (defun org-e-latex-inlinetask (inlinetask contents info) CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let ((title (org-export-secondary-string - (org-element-get-property :title inlinetask) 'e-latex info)) + (org-element-property :title inlinetask) 'e-latex info)) (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-get-property + (let ((todo (org-element-property :todo-keyword inlinetask))) (and todo (org-export-secondary-string todo 'e-latex info))))) - (todo-type (org-element-get-property :todo-type inlinetask)) + (todo-type (org-element-property :todo-type inlinetask)) (tags (and (plist-get info :with-tags) - (org-element-get-property :tags inlinetask))) + (org-element-property :tags inlinetask))) (priority (and (plist-get info :with-priority) - (org-element-get-property :priority inlinetask)))) + (org-element-property :priority inlinetask)))) ;; If `org-e-latex-format-inlinetask-function' is provided, call it ;; with appropriate arguments. (if (functionp org-e-latex-format-inlinetask-function) @@ -1105,18 +1263,20 @@ (defun org-e-latex-item (item contents info) "Transcode an ITEM element from Org to LaTeX. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((level (plist-get (plist-get info :parent-properties) :level)) - (counter (let ((count (org-element-get-property :counter item))) + ;; Grab `:level' from plain-list properties, which is always the + ;; first element above current item. + (let* ((level (org-element-property :level (org-export-get-parent item info))) + (counter (let ((count (org-element-property :counter item))) (and count (< level 4) (format "\\setcounter{enum%s}{%s}\n" (nth level '("i" "ii" "iii" "iv")) (1- count))))) - (checkbox (let ((checkbox (org-element-get-property :checkbox item))) + (checkbox (let ((checkbox (org-element-property :checkbox item))) (cond ((eq checkbox 'on) "$\\boxtimes$ ") ((eq checkbox 'off) "$\\Box$ ") ((eq checkbox 'trans) "$\\boxminus$ ")))) - (tag (let ((tag (org-element-get-property :tag item))) + (tag (let ((tag (org-element-property :tag item))) (and tag (format "[%s]" (org-export-secondary-string tag 'e-latex info)))))) @@ -1128,13 +1288,13 @@ (defun org-e-latex-item (item contents info) (defun org-e-latex-keyword (keyword contents info) "Transcode a KEYWORD element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (downcase (org-element-get-property :key keyword))) - (value (org-element-get-property :value keyword))) + (let ((key (downcase (org-element-property :key keyword))) + (value (org-element-property :value keyword))) (cond ((string= key "latex") value) ((string= key "index") (format "\\index{%s}" value)) - ((string= key "target") - (format "\\label{%s}" (org-export-solidify-link-text value))) + ;; Invisible targets. + ((string= key "target") nil) ((string= key "toc") (let ((value (downcase value))) (cond @@ -1148,9 +1308,13 @@ (defun org-e-latex-keyword (keyword contents info) "\\tableofcontents"))) ((string= "tables" value) "\\listoftables") ((string= "figures" value) "\\listoffigures") - ((string= "listings" value) "\\listoflistings")))) - ((string= key "include") - (org-export-included-file keyword 'e-latex info))))) + ((string= "listings" value) + (cond + ((eq org-e-latex-listings 'minted) "\\listoflistings") + (org-e-latex-listings "\\lstlistoflistings") + ;; At the moment, src blocks with a caption are wrapped + ;; into a figure environment. + (t "\\listoffigures"))))))))) ;;;; Latex Environment @@ -1158,9 +1322,19 @@ (defun org-e-latex-keyword (keyword contents info) (defun org-e-latex-latex-environment (latex-environment contents info) "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-latex--wrap-label - latex-environment - (org-remove-indentation (org-element-get-property :value latex-environment)))) + (let ((label (org-element-property :name latex-environment)) + (value (org-remove-indentation + (org-element-property :value latex-environment)))) + (if (not (org-string-nw-p label)) value + ;; Environment is labelled: label must be within the environment + ;; (otherwise, a reference pointing to that element will count + ;; the section instead). + (with-temp-buffer + (insert value) + (goto-char (point-min)) + (forward-line) + (insert (format "\\label{%s}\n" label)) + (buffer-string))))) ;;;; Latex Fragment @@ -1168,7 +1342,7 @@ (defun org-e-latex-latex-environment (latex-environment contents info) (defun org-e-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." - (org-element-get-property :value latex-fragment)) + (org-element-property :value latex-fragment)) ;;;; Line Break @@ -1181,18 +1355,23 @@ (defun org-e-latex-line-break (line-break contents info) ;;;; Link -(defun org-e-latex-link--inline-image (path info) - "Return LaTeX code for an image at PATH. -INFO is a plist containing export options." - (let* ((parent-props (plist-get info :parent-properties)) +(defun org-e-latex-link--inline-image (link info) + "Return LaTeX code for an inline image. +LINK is the link pointing to the inline image. INFO is a plist +used as a communication channel." + (let* ((parent (org-export-get-parent-paragraph link info)) + (path (let ((raw-path (org-element-property :path link))) + (if (not (file-name-absolute-p raw-path)) raw-path + (expand-file-name raw-path)))) (caption (org-e-latex--caption/label-string - (plist-get parent-props :caption) - (plist-get parent-props :name) + (org-element-property :caption parent) + (org-element-property :name parent) info)) ;; Retrieve latex attributes from the element around. (attr (let ((raw-attr (mapconcat #'identity - (plist-get parent-props :attr_latex) " "))) + (org-element-property :attr_latex parent) + " "))) (unless (string= raw-attr "") raw-attr))) (disposition (cond @@ -1211,27 +1390,26 @@ (defun org-e-latex-link--inline-image (path info) (t "")))) ;; Now clear ATTR from any special keyword and set a default ;; value if nothing is left. - (if (not attr) - (setq attr "") - (while (string-match "\\(wrap\\|multicolumn\\|float\\|placement=\\S-+\\)" - attr) - (replace-match "" nil nil attr)) - (setq attr (org-trim attr))) + (setq attr + (if (not attr) "" + (org-trim + (replace-regexp-in-string + "\\(wrap\\|multicolumn\\|float\\|placement=\\S-+\\)" "" attr)))) (setq attr (cond ((not (string= attr "")) attr) ((eq disposition 'float) "width=0.7\\textwidth") ((eq disposition 'wrap) "width=0.48\\textwidth") (t (or org-e-latex-image-default-option "")))) ;; Return proper string, depending on DISPOSITION. (case disposition - ('wrap (format "\\begin{wrapfigure}%s + (wrap (format "\\begin{wrapfigure}%s \\centering \\includegraphics[%s]{%s} %s\\end{wrapfigure}" placement attr path caption)) - ('mulicolumn (format "\\begin{figure*}%s + (mulicolumn (format "\\begin{figure*}%s \\centering \\includegraphics[%s]{%s} %s\\end{figure*}" placement attr path caption)) - ('float (format "\\begin{figure}%s + (float (format "\\begin{figure}%s \\centering \\includegraphics[%s]{%s} %s\\end{figure}" placement attr path caption)) @@ -1241,18 +1419,18 @@ (defun org-e-latex-link (link desc info) "Transcode a LINK object from Org to LaTeX. DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. See +INFO is a plist holding contextual information. See `org-export-data'." - (let* ((type (org-element-get-property :type link)) - (raw-path (org-element-get-property :path link)) + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) ;; Ensure DESC really exists, or set it to nil. (desc (and (not (string= desc "")) desc)) (imagep (org-export-inline-image-p - link org-e-latex-inline-image-extensions)) + link org-e-latex-inline-image-rules)) (path (cond ((member type '("http" "https" "ftp" "mailto")) (concat type ":" raw-path)) - ((and (not imagep) (string= type "file")) + ((string= type "file") (when (string-match "\\(.+\\)::.+" raw-path) (setq raw-path (match-string 1 raw-path))) (if (file-name-absolute-p raw-path) @@ -1264,47 +1442,61 @@ (defun org-e-latex-link (link desc info) protocol) (cond ;; Image file. - (imagep (org-e-latex-link--inline-image path info)) - ;; Id: for now, assume it's an internal link. TODO: do something - ;; to check if it isn't in the current file. - ((string= type "id") - (format "\\hyperref[%s]{%s}" path (or desc path))) - ;; Custom-id, target or radioed target: replace link with the - ;; normalized custom-id/target name. - ((member type '("custom-id" "target" "radio")) + (imagep (org-e-latex-link--inline-image link info)) + ;; Radioed target: Target's name is obtained from original raw + ;; link. Path is parsed and transcoded in order to have a proper + ;; display of the contents. + ((string= type "radio") (format "\\hyperref[%s]{%s}" (org-export-solidify-link-text path) - (or desc (org-export-secondary-string path 'e-latex info)))) - ;; Fuzzy: With the help of `org-export-resolve-fuzzy-link', find - ;; the destination of the link. - ((string= type "fuzzy") - (let ((destination (org-export-resolve-fuzzy-link link info))) - (cond - ;; Target match. - ((stringp destination) - (format "\\hyperref[%s]{%s}" - (org-export-solidify-link-text destination) - (or desc - (org-export-secondary-string - (org-element-get-property :raw-link link) 'e-latex info)))) - ;; Headline match. - ((integerp destination) - (format "\\hyperref[headline-%d]{%s}" - destination - (or desc - (org-export-secondary-string - (org-element-get-property :raw-link link) 'e-latex info)))) - ;; No match. - (t (format "\\texttt{%s}" - (or desc - (org-export-secondary-string - (org-element-get-property :raw-link link) - 'e-latex info))))))) + (org-export-secondary-string + (org-element-parse-secondary-string + path (cdr (assq 'radio-target org-element-object-restrictions))) + 'e-latex info))) + ;; Links pointing to an headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ;; Fuzzy link points nowhere. + ('nil + (format "\\texttt{%s}" + (or desc + (org-export-secondary-string + (org-element-property :raw-link link) + 'e-latex info)))) + ;; Fuzzy link points to an invisible target. + (keyword nil) + ;; LINK points to an headline. If headlines are numbered + ;; and the link has no description, display headline's + ;; 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) + "-")))) + (if (and (plist-get info :section-numbers) (not desc)) + (format "\\ref{%s}" label) + (format "\\hyperref[%s]{%s}" label + (or desc + (org-export-secondary-string + (org-element-property :title destination) + 'e-latex 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))))))) ;; Coderef: replace link with the reference name or the ;; equivalent line number. ((string= type "coderef") (format (org-export-get-coderef-format path (or desc "")) - (cdr (assoc path (plist-get info :code-refs))))) + (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)) @@ -1345,7 +1537,7 @@ (defun org-e-latex-plain-list (plain-list contents info) "Transcode a PLAIN-LIST element from Org to LaTeX. CONTENTS is the contents of the list. INFO is a plist holding contextual information." - (let* ((type (org-element-get-property :type plain-list)) + (let* ((type (org-element-property :type plain-list)) (paralist-types '("inparaenum" "asparaenum" "inparaitem" "asparaitem" "inparadesc" "asparadesc")) (paralist-regexp (concat @@ -1353,7 +1545,7 @@ (defun org-e-latex-plain-list (plain-list contents info) (mapconcat 'identity paralist-types "\\|") "\\)")) (attr (mapconcat #'identity - (org-element-get-property :attr_latex plain-list) + (org-element-property :attr_latex plain-list) " ")) (latex-type (cond ((and attr @@ -1442,10 +1634,19 @@ (defun org-e-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-get-property :value quote-section)))) + (org-element-property :value quote-section)))) (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) +;;;; Section + +(defun org-e-latex-section (section contents info) + "Transcode a SECTION element from Org to LaTeX. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + + ;;;; Radio Target (defun org-e-latex-radio-target (radio-target text info) @@ -1454,7 +1655,7 @@ (defun org-e-latex-radio-target (radio-target text info) contextual information." (format "\\label{%s}%s" (org-export-solidify-link-text - (org-element-get-property :raw-value radio-target)) + (org-element-property :raw-value radio-target)) text)) @@ -1464,7 +1665,7 @@ (defun org-e-latex-special-block (special-block contents info) "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-get-property :type special-block)))) + (let ((type (downcase (org-element-property :type special-block)))) (org-e-latex--wrap-label special-block (format "\\begin{%s}\n%s\\end{%s}" type contents type)))) @@ -1476,58 +1677,114 @@ (defun org-e-latex-src-block (src-block contents info) "Transcode a SRC-BLOCK element from Org to LaTeX. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((lang (org-element-get-property :language src-block)) - (code (org-export-handle-code - (org-element-get-property :value src-block) - (org-element-get-property :switches src-block) - info lang)) - (caption (org-element-get-property :caption src-block)) - (label (org-element-get-property :name src-block)) + (let* ((lang (org-element-property :language src-block)) + (caption (org-element-property :caption src-block)) + (label (org-element-property :name src-block)) (custom-env (and lang (cadr (assq (intern lang) - org-e-latex-custom-lang-environments))))) + org-e-latex-custom-lang-environments)))) + (num-start (case (org-element-property :number-lines src-block) + (continued (org-export-get-loc src-block info)) + (new 0))) + (retain-labels (org-element-property :retain-labels src-block))) (cond - ;; No source fontification. + ;; Case 1. No source fontification. ((not org-e-latex-listings) - (let ((caption-str (org-e-latex--caption/label-string - caption label info)) + (let ((caption-str (org-e-latex--caption/label-string caption label info)) (float-env (when caption "\\begin{figure}[H]\n%s\n\\end{figure}"))) - (format (or float-env "%s") - (concat - caption-str - (format "\\begin{verbatim}\n%s\\end{verbatim}" code))))) - ;; Custom environment. - (custom-env - (format "\\begin{%s}\n%s\\end{%s}\n" custom-env code custom-env)) - ;; Use minted package. + (format + (or float-env "%s") + (concat caption-str + (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)) + ;; Case 3. Use minted package. ((eq org-e-latex-listings 'minted) - (let* ((mint-lang (or (cadr (assq (intern lang) org-e-latex-minted-langs)) - lang)) - (float-env (when (or label caption) - (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" - (org-e-latex--caption/label-string - caption label info)))) - (body (format "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - (org-e-latex--make-option-string - org-e-latex-minted-options) - mint-lang code))) + (let ((float-env (when (or label caption) + (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" + (org-e-latex--caption/label-string + caption label info)))) + (body + (format + "\\begin{minted}[%s]{%s}\n%s\\end{minted}" + ;; Options. + (org-e-latex--make-option-string + (if (not num-start) org-e-latex-minted-options + (append `(("linenos") + ("firstnumber" ,(number-to-string (1+ num-start)))) + org-e-latex-minted-options))) + ;; Language. + (or (cadr (assq (intern lang) org-e-latex-minted-langs)) lang) + ;; Source code. + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line + ;; of code. + (concat (make-string (+ (- max-width (length loc)) 6) ? ) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info))))))) + ;; Return value. (if float-env (format float-env body) body))) - ;; Use listings package. + ;; Case 4. Use listings package. (t - (let ((lst-lang (or (cadr (assq (intern lang) org-e-latex-listings-langs)) - lang)) - (caption-str (and caption - (org-export-secondary-string - (org-element-get-property :caption src-block) - 'e-latex info)))) - (concat (format "\\lstset{%s}\n" - (org-e-latex--make-option-string - (append org-e-latex-listings-options - `(("language" ,lst-lang)) - (when label `(("label" ,label))) - (when caption-str - `(("caption" ,caption-str)))))) - (format "\\begin{lstlisting}\n%s\\end{lstlisting}" code))))))) + (let ((lst-lang + (or (cadr (assq (intern lang) org-e-latex-listings-langs)) lang)) + (caption-str + (when caption + (let ((main (org-export-secondary-string + (car caption) 'e-latex info))) + (if (not (cdr caption)) (format "{%s}" main) + (format + "{[%s]%s}" + (org-export-secondary-string (cdr caption) 'e-latex info) + main)))))) + (concat + ;; Options. + (format "\\lstset{%s}\n" + (org-e-latex--make-option-string + (append org-e-latex-listings-options + `(("language" ,lst-lang)) + (when label `(("label" ,label))) + (when caption-str `(("caption" ,caption-str))) + (cond ((not num-start) '(("numbers" "none"))) + ((zerop num-start) '(("numbers" "left"))) + (t `(("numbers" "left") + ("firstnumber" + ,(number-to-string (1+ num-start))))))))) + ;; Source code. + (format + "\\begin{lstlisting}\n%s\\end{lstlisting}" + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line of + ;; code + (concat (make-string (+ (- max-width (length loc)) 6) ? ) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info))))))))))) ;;;; Statistics Cookie @@ -1535,7 +1792,7 @@ (defun org-e-latex-src-block (src-block contents info) (defun org-e-latex-statistics-cookie (statistics-cookie contents info) "Transcode a STATISTICS-COOKIE object from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." - (org-element-get-property :value statistics-cookie)) + (org-element-property :value statistics-cookie)) ;;;; Subscript @@ -1558,27 +1815,29 @@ (defun org-e-latex-superscript (superscript contents info) ;;;; Table -(defun org-e-latex-table--format-string (table info) +(defun org-e-latex-table--format-string (table table-info info) "Return an appropriate format string for TABLE. -INFO is the plist containing format info about the table, as -returned by `org-export-table-format-info'. +TABLE-INFO is the plist containing format info about the table, +as returned by `org-export-table-format-info'. INFO is a plist +used as a communication channel. -The format string one placeholder for the body of the table." - (let* ((label (org-element-get-property :name table)) +The format string leaves one placeholder for the body of the +table." + (let* ((label (org-element-property :name table)) (caption (org-e-latex--caption/label-string - (org-element-get-property :caption table) label info)) - (attr (mapconcat #'identity - (org-element-get-property :attr_latex table) + (org-element-property :caption table) label info)) + (attr (mapconcat 'identity + (org-element-property :attr_latex table) " ")) ;; Determine alignment string. - (alignment (org-e-latex-table--align-string attr info)) + (alignment (org-e-latex-table--align-string attr table-info)) ;; Determine environment for the table: longtable, tabular... (table-env (cond ((not attr) org-e-latex-default-table-environment) ((string-match "\\" attr) "longtable") - ((string-match "\\(tabular.\\)" attr) - (org-match-string-no-properties 1 attr)) + ((string-match "\\" attr) + (org-match-string-no-properties 0 attr)) (t org-e-latex-default-table-environment))) ;; If table is a float, determine environment: table or table*. (float-env (cond @@ -1589,29 +1848,23 @@ (defun org-e-latex-table--format-string (table info) "table*") ((or (not (string= caption "")) label) "table"))) ;; Extract others display options. - (width (and attr - (string-match "\\" attr))) + (booktabsp + (or (and attr (string-match "\\" attr)) + org-e-latex-tables-booktabs)) + ;; CLEAN-TABLE is a table turned into a list, much like + ;; `org-table-to-lisp', with special column and + ;; formatting cookies removed, and cells already + ;; transcoded. + (clean-table + (mapcar + (lambda (row) + (if (string-match org-table-hline-regexp row) 'hline + (mapcar + (lambda (cell) + (org-export-secondary-string + (org-element-parse-secondary-string + cell + (cdr (assq 'table org-element-string-restrictions))) + 'e-latex info)) + (org-split-string row "[ \t]*|[ \t]*")))) + (org-split-string + (org-export-clean-table + raw-table (plist-get table-info :special-column-p)) + "\n")))) + ;; If BOOKTABSP is non-nil, remove any rule at the beginning + ;; and the end of the table, since booktabs' special rules + ;; will be inserted instead. + (when booktabsp + (when (eq (car clean-table) 'hline) + (setq clean-table (cdr clean-table))) + (when (eq (car (last clean-table)) 'hline) + (setq clean-table (butlast clean-table)))) ;; Convert ROWS to send them to `orgtbl-to-latex'. In ;; particular, send each cell to ;; `org-element-parse-secondary-string' to expand any Org - ;; object within. Eventually, flesh the format string out with - ;; the table. - (format (org-e-latex-table--format-string table table-info) - (orgtbl-to-latex - (mapcar - (lambda (row) - (if (string-match org-table-hline-regexp row) - 'hline - (mapcar - (lambda (cell) - (org-export-secondary-string - (org-element-parse-secondary-string - cell - (cdr (assq 'table org-element-string-restrictions))) - 'e-latex info)) - (org-split-string row "[ \t]*|[ \t]*")))) - (org-split-string clean-table "\n")) - `(:tstart nil :tend nil - ;; Longtable environment requires specific - ;; header line end. - :hlend ,(and attr - (string-match "\\" attr) - (format "\\\\ -\\hline + ;; object within. Eventually, flesh the format string out + ;; with the table. + (format + (org-e-latex-table--format-string table table-info info) + (orgtbl-to-latex + clean-table + ;; Parameters passed to `orgtbl-to-latex'. + `(:tstart ,(and booktabsp "\\toprule") + :tend ,(and booktabsp "\\bottomrule") + :hline ,(if booktabsp "\\midrule" "\\hline") + ;; Longtable environment requires specific header + ;; lines end string. + :hlend ,(and longtablep + (format "\\\\ +%s \\endhead -\\hline\\multicolumn{%d}{r}{Continued on next page}\\\\ +%s\\multicolumn{%d}{r}{Continued on next page}\\\\ \\endfoot \\endlastfoot" - columns-number)))))))))) + (if booktabsp "\\midrule" "\\hline") + (if booktabsp "\\midrule" "\\hline") + columns-number)))))))))) ;;;; Target -(defun org-e-latex-target (target text info) +(defun org-e-latex-target (target contents info) "Transcode a 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-get-property :raw-value target)) - text)) +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\label{%s}" + (org-export-solidify-link-text (org-element-property :value target)))) ;;;; Time-stamp (defun org-e-latex-time-stamp (time-stamp contents info) "Transcode a TIME-STAMP object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-element-get-property :value time-stamp)) - (type (org-element-get-property :type time-stamp)) - (appt-type (org-element-get-property :appt-type time-stamp))) +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-element-property :value time-stamp)) + (type (org-element-property :type time-stamp)) + (appt-type (org-element-property :appt-type time-stamp))) (concat (cond ((eq appt-type 'scheduled) (format "\\textbf{\\textsc{%s}} " org-scheduled-string)) ((eq appt-type 'deadline) @@ -1778,11 +2051,13 @@ (defun org-e-latex-time-stamp (time-stamp contents info) ;;;; Verbatim -(defun org-e-latex-verbatim (element contents info) - "Return verbatim text in LaTeX." - (let ((fmt (cdr (assoc (org-element-get-property :marker element) +(defun org-e-latex-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to LaTeX. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((fmt (cdr (assoc (org-element-property :marker verbatim) org-e-latex-emphasis-alist))) - (value (org-element-get-property :value element))) + (value (org-element-property :value verbatim))) (cond ;; Handle the `verb' special case. ((eq 'verb fmt) @@ -1816,7 +2091,7 @@ (defun org-e-latex-verbatim (element contents info) (defun org-e-latex-verse-block (verse-block contents info) "Transcode a VERSE-BLOCK element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." +CONTENTS is nil. INFO is a plist holding contextual information." (org-e-latex--wrap-label verse-block ;; In a verse environment, add a line break to each newline @@ -1830,7 +2105,7 @@ (defun org-e-latex-verse-block (verse-block contents info) "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" (org-remove-indentation (org-export-secondary-string - (org-element-get-property :value verse-block) + (org-element-property :value verse-block) 'e-latex info))))) (while (string-match "^[ \t]+" contents) (let ((new-str (format "\\hspace*{%dem}" @@ -1839,5 +2114,161 @@ (defun org-e-latex-verse-block (verse-block contents info) (format "\\begin{verse}\n%s\\end{verse}" contents)))) + +;;; Interactive functions + +(defun org-e-latex-export-to-latex + (&optional subtreep visible-only body-only ext-plist pub-dir) + "Export current buffer to a LaTeX file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +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. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".tex" subtreep pub-dir))) + (org-export-to-file + 'e-latex outfile subtreep visible-only body-only ext-plist))) + +(defun org-e-latex-export-to-pdf + (&optional subtreep visible-only body-only ext-plist pub-dir) + "Export current buffer to LaTeX then process through to PDF. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +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. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +Return PDF file's name." + (interactive) + (org-e-latex-compile + (org-e-latex-export-to-latex + subtreep visible-only body-only ext-plist pub-dir))) + +(defun org-e-latex-compile (texfile) + "Compile a TeX file. + +TEXFILE is the name of the file being compiled. Processing is +done through the command specified in `org-e-latex-pdf-process'. + +Return PDF file name or an error if it couldn't be produced." + (let* ((wconfig (current-window-configuration)) + (texfile (file-truename texfile)) + (base (file-name-sans-extension texfile)) + errors) + (message (format "Processing LaTeX file %s ..." texfile)) + (unwind-protect + (progn + (cond + ;; A function is provided: Apply it. + ((functionp org-e-latex-pdf-process) + (funcall org-e-latex-pdf-process (shell-quote-argument texfile))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org PDF LaTeX Output*" buffer. + ((consp org-e-latex-pdf-process) + (let* ((out-dir (or (file-name-directory texfile) "./")) + (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base) + (replace-regexp-in-string + "%f" (shell-quote-argument texfile) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-e-latex-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (org-e-latex-collect-errors outbuf)))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat base ".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)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when org-e-latex-remove-logfiles + (dolist (ext org-e-latex-logfiles-extensions) + (let ((file (concat base "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + pdffile)) + (set-window-configuration wconfig)))) + +(defun org-e-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." + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + ;; Find final "pdflatex" run. + (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t) + (let ((case-fold-search t) + (errors "")) + (when (save-excursion + (re-search-forward "Reference.*?undefined" nil t)) + (setq errors (concat errors " [undefined reference]"))) + (when (save-excursion + (re-search-forward "Citation.*?undefined" nil t)) + (setq errors (concat errors " [undefined citation]"))) + (when (save-excursion + (re-search-forward "Undefined control sequence" nil t)) + (setq errors (concat errors " [undefined control sequence]"))) + (when (save-excursion + (re-search-forward "^! LaTeX.*?Error" nil t)) + (setq errors (concat errors " [LaTeX error]"))) + (when (save-excursion + (re-search-forward "^! Package.*?Error" nil t)) + (setq errors (concat errors " [package error]"))) + (and (org-string-nw-p errors) (org-trim errors))))))) + + (provide 'org-e-latex) ;;; org-e-latex.el ends here diff --git a/Makefile b/Makefile index 1753dd8..1022cdc 100644 --- a/Makefile +++ b/Makefile @@ -170,7 +170,9 @@ LISPF = org.el \ ob-shen.el \ ob-fortran.el \ ob-picolisp.el \ - ob-maxima.el + ob-maxima.el \ + ob-io.el \ + ob-scala.el LISPFILES0 = $(LISPF:%=lisp/%) LISPFILES = $(LISPFILES0) lisp/org-install.el diff --git a/contrib/babel/langs/ob-fomus.el b/contrib/babel/langs/ob-fomus.el index ba25715..f7c6ca8 100644 --- a/contrib/babel/langs/ob-fomus.el +++ b/contrib/babel/langs/ob-fomus.el @@ -1,6 +1,6 @@ ;;; ob-fomus.el --- org-babel functions for fomus evaluation -;; Copyright (C) 2011, 2012 Torsten Anders +;; Copyright (C) 2011-2012 Torsten Anders ;; Author: Torsten Anders ;; Keywords: literate programming, reproducible research diff --git a/contrib/babel/langs/ob-oz.el b/contrib/babel/langs/ob-oz.el index e906c73..2482ed6 100644 --- a/contrib/babel/langs/ob-oz.el +++ b/contrib/babel/langs/ob-oz.el @@ -1,6 +1,6 @@ ;;; ob-oz.el --- org-babel functions for Oz evaluation -;; Copyright (C) 2009, 2012 Torsten Anders and Eric Schulte +;; Copyright (C) 2009-2012 Torsten Anders and Eric Schulte ;; Author: Torsten Anders and Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/contrib/lisp/htmlize.el b/contrib/lisp/htmlize.el index 8952e99..516fb1d 100644 --- a/contrib/lisp/htmlize.el +++ b/contrib/lisp/htmlize.el @@ -633,7 +633,7 @@ (defun htmlize-defang-local-variables () (goto-char (point-min)) (while (search-forward "Local Variables:" nil t) (replace-match "Local Variables:" nil t))) - + ;;; Color handling. @@ -796,7 +796,7 @@ (defun htmlize-color-to-rgb (color) (t ;; We're getting the RGB components from Emacs. (let ((rgb - ;; Here I cannot conditionalize on (fboundp ...) + ;; Here I cannot conditionalize on (fboundp ...) ;; because ps-print under some versions of GNU Emacs ;; defines its own dummy version of ;; `color-instance-rgb-components'. @@ -1211,7 +1211,7 @@ (defun htmlize-faces-in-buffer () ;; used methods are `doctype', `insert-head', `body-tag', and ;; `insert-text'. Not all output types define all methods. ;; -;; Methods are called either with (htmlize-method METHOD ARGS...) +;; Methods are called either with (htmlize-method METHOD ARGS...) ;; special form, or by accessing the function with ;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION). ;; The latter form is useful in tight loops because `htmlize-method' @@ -1389,7 +1389,7 @@ (defun htmlize-font-body-tag (face-map) (format "" (htmlize-fstruct-foreground fstruct) (htmlize-fstruct-background fstruct)))) - + (defun htmlize-font-insert-text (text fstruct-list buffer) ;; In `font' mode, we use the traditional HTML means of altering ;; presentation: tag for colors, for bold, for diff --git a/contrib/lisp/org-bookmark.el b/contrib/lisp/org-bookmark.el index e57b2e6..586597a 100644 --- a/contrib/lisp/org-bookmark.el +++ b/contrib/lisp/org-bookmark.el @@ -67,7 +67,7 @@ (defun org-bookmark-store-link () (if (not file) (when (eq major-mode 'bookmark-bmenu-mode) (setq bookmark (bookmark-bmenu-bookmark))) - (when (and (setq bmks + (when (and (setq bmks (mapcar (lambda (name) (if (equal file (abbreviate-file-name @@ -75,7 +75,7 @@ (defun org-bookmark-store-link () name)) (bookmark-all-names))) (setq bmks (delete nil bmks))) - (setq bookmark + (setq bookmark (if (or (eq 1 (length bmks)) org-bookmark-use-first-bookmark) (car bmks) (completing-read "Bookmark: " bmks nil t nil nil (car bmks)))))) diff --git a/contrib/lisp/org-checklist.el b/contrib/lisp/org-checklist.el index 05ad99d..a974874 100644 --- a/contrib/lisp/org-checklist.el +++ b/contrib/lisp/org-checklist.el @@ -138,6 +138,3 @@ (defun org-checklist () (provide 'org-checklist) ;;; org-checklist.el ends here - - - diff --git a/contrib/lisp/org-choose.el b/contrib/lisp/org-choose.el index 77478c5..3513fe9 100644 --- a/contrib/lisp/org-choose.el +++ b/contrib/lisp/org-choose.el @@ -46,13 +46,13 @@ ;; * Use C-S-right to change the keyword set. Use this to change to ;; the "choose" keyword set that you just defined. -;; * Use S-right to advance the TODO mark to the next setting. +;; * Use S-right to advance the TODO mark to the next setting. ;; For "choose", that means you like this alternative more than ;; before. Other alternatives will be automatically demoted to ;; keep your settings consistent. -;; * Use S-left to demote TODO to the previous setting. +;; * Use S-left to demote TODO to the previous setting. ;; For "choose", that means you don't like this alternative as much ;; as before. Other alternatives will be automatically promoted, @@ -83,7 +83,7 @@ (defstruct (org-choose-mark-data. (:type list)) static-default all-keywords) -(defvar org-choose-mark-data +(defvar org-choose-mark-data () "Alist of information for choose marks. @@ -101,7 +101,7 @@ (defun org-choose-filter-one (i) (not (string-match "(.*)" i)) (list i i) - (let* + (let* ( (end-text (match-beginning 0)) (vanilla-text (substring i 0 end-text)) @@ -116,7 +116,7 @@ (defun org-choose-filter-one (i) ;;When string starts with "," `split-string' doesn't ;;make a first arg, so in that case make one ;;manually. - (if + (if (string-match "^," args) (cons nil arglist-x) arglist-x))) @@ -157,11 +157,11 @@ (defun org-choose-setup-vars (bot-lower-range top-upper-range ;;item. (top-upper-range (or top-upper-range (1- num-items))) - (lower-range-length + (lower-range-length (1+ (- static-default bot-lower-range))) - (upper-range-length + (upper-range-length (- top-upper-range static-default)) - (range-length + (range-length (min upper-range-length lower-range-length))) @@ -194,7 +194,7 @@ (defun org-choose-setup-vars (bot-lower-range top-upper-range ;;;_ . org-choose-filter-tail (defun org-choose-filter-tail (raw) "Return a translation of RAW to vanilla and set appropriate -buffer-local variables. +buffer-local variables. RAW is a list of strings representing the input text of a choose interpretation." @@ -219,7 +219,7 @@ (defun org-choose-filter-tail (raw) (push vanilla-mark vanilla-list))) (org-choose-setup-vars bot-lower-range top-upper-range - static-default index (reverse all-mark-texts)) + static-default index (reverse all-mark-texts)) (nreverse vanilla-list))) ;;;_ . org-choose-setup-filter @@ -234,35 +234,35 @@ (defun org-choose-setup-filter (raw) ;;;_ . org-choose-conform-after-promotion (defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix) "Conform the current item after another item was promoted" - + (unless ;;Skip the entry that triggered this by skipping any entry with ;;the same starting position. plist uses the start of the ;;header line as the position, but map no longer does, so we ;;have to go back to the heading. - (= + (= (save-excursion (org-back-to-heading) - (point)) + (point)) entry-pos) (let ((ix (org-choose-get-entry-index keywords))) ;;If the index of the entry exceeds the highest allowable ;;index, change it to that. - (when (and ix + (when (and ix (> ix highest-ok-ix)) - (org-todo + (org-todo (nth highest-ok-ix keywords)))))) ;;;_ . org-choose-conform-after-demotion (defun org-choose-conform-after-demotion (entry-pos keywords raise-to-ix - old-highest-ok-ix) + old-highest-ok-ix) "Conform the current item after another item was demoted." (unless ;;Skip the entry that triggered this. - (= + (= (save-excursion (org-back-to-heading) (point)) @@ -273,11 +273,11 @@ (defun org-choose-conform-after-demotion (entry-pos keywords ;;If the index of the entry was at or above the old allowable ;;position, change it to the new mirror position if there is ;;one. - (when (and - ix + (when (and + ix raise-to-ix (>= ix old-highest-ok-ix)) - (org-todo + (org-todo (nth raise-to-ix keywords)))))) ;;;_ , org-choose-keep-sensible (the org-trigger-hook function) @@ -287,7 +287,7 @@ (defun org-choose-keep-sensible (change-plist) (let* ( (from (plist-get change-plist :from)) (to (plist-get change-plist :to)) - (entry-pos + (entry-pos (set-marker (make-marker) (plist-get change-plist :position))) @@ -303,11 +303,11 @@ (defun org-choose-keep-sensible (change-plist) (org-choose-mark-data.-all-keywords data)) (old-index (org-choose-get-index-in-keywords - from + from keywords)) (new-index (org-choose-get-index-in-keywords - to + to keywords)) (highest-ok-ix (org-choose-highest-other-ok @@ -324,7 +324,7 @@ (defun org-choose-keep-sensible (change-plist) (> new-index old-index)) (list #'org-choose-conform-after-promotion - entry-pos keywords + entry-pos keywords highest-ok-ix)) (t ;;Otherwise the entry was demoted. (let @@ -338,14 +338,14 @@ (defun org-choose-keep-sensible (change-plist) (org-choose-highest-other-ok old-index data))) - + (list - #'org-choose-conform-after-demotion - entry-pos + #'org-choose-conform-after-demotion + entry-pos keywords raise-to-ix old-highest-ok-ix)))))) - + (if funcdata ;;The funny-looking names are to make variable capture ;;unlikely. (Poor-man's lexical bindings). @@ -356,8 +356,8 @@ (defun org-choose-keep-sensible (change-plist) ;;We may call `org-todo', so let various hooks ;;`nil' so we don't cause loops. org-after-todo-state-change-hook - org-trigger-hook - org-blocker-hook + org-trigger-hook + org-blocker-hook org-todo-get-default-hook ;;Also let this alist `nil' so we don't log ;;secondary transitions. @@ -366,7 +366,7 @@ (defun org-choose-keep-sensible (change-plist) (funcall map-over-entries #'(lambda () (apply func-d473 args-46k)))))))) - + ;;Remove the marker (set-marker entry-pos nil))) @@ -393,7 +393,7 @@ (defun org-choose-get-entry-index (all-keywords) (defun org-choose-get-fn-map-group () "Return a function to map over the group" - + #'(lambda (fn) (require 'org-agenda) ;; `org-map-entries' seems to need it. (save-excursion @@ -402,7 +402,7 @@ (defun org-choose-get-fn-map-group () (let ((level (org-reduced-level (org-outline-level)))) (save-restriction - (org-map-entries + (org-map-entries fn (format "LEVEL=%d" level) 'tree)))))) @@ -418,10 +418,10 @@ (defun org-choose-get-highest-mark-index (keywords) ;;Func maps over applicable entries. (map-over-entries (org-choose-get-fn-map-group)) - + (indexes-list (remove nil - (funcall map-over-entries + (funcall map-over-entries #'(lambda () (org-choose-get-entry-index keywords)))))) (if @@ -438,7 +438,7 @@ (defun org-choose-highest-other-ok (ix data) DATA must be a `org-choose-mark-data.'." (let - ( + ( (bot-lower-range (org-choose-mark-data.-bot-lower-range data)) (top-upper-range @@ -455,7 +455,7 @@ (defun org-choose-highest-other-ok (ix data) ;;;_ . org-choose-get-default-mark-index -(defun org-choose-get-default-mark-index (data) +(defun org-choose-get-default-mark-index (data) "Return the index of the default mark in a choose interpretation. DATA must be a `org-choose-mark-data.'." @@ -475,7 +475,7 @@ (defun org-choose-get-default-mark-index (data) ;;;_ . org-choose-get-mark-N (defun org-choose-get-mark-N (n data) "Get the text of the nth mark in a choose interpretation." - + (let* ((l (org-choose-mark-data.-all-keywords data))) (nth n l))) diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el index da612e9..ad198ed 100644 --- a/contrib/lisp/org-collector.el +++ b/contrib/lisp/org-collector.el @@ -87,7 +87,7 @@ ;; | run (50) | 0.116446 | ;; | run (100) | 0.118863 | ;; #+END: -;; +;; ;;; Code: (require 'org) @@ -134,7 +134,7 @@ (defun org-dblock-write:propview (params) (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 + (org-propview-collect cols stringformat conds match scope inherit (if colnames colnames cols)) stringformat)) (widen)) (setq pos (point)) diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el index b022359..4adaf58 100644 --- a/contrib/lisp/org-drill.el +++ b/contrib/lisp/org-drill.el @@ -2915,4 +2915,3 @@ (defun org-drill-present-spanish-verb () (provide 'org-drill) - diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el index 3db8e36..3c6e396 100644 --- a/contrib/lisp/org-element.el +++ b/contrib/lisp/org-element.el @@ -1,6 +1,6 @@ ;;; org-element.el --- Parser And Applications for Org syntax -;; Copyright (C) 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp @@ -43,15 +43,15 @@ ;; Elements containing paragraphs are called greater elements. ;; Concerned types are: `center-block', `drawer', `dynamic-block', ;; `footnote-definition', `headline', `inlinetask', `item', -;; `plain-list', `quote-block' and `special-block'. +;; `plain-list', `quote-block', `section' and `special-block'. -;; Greater elements (excepted `headline' and `item' types) and -;; elements (excepted `keyword', `babel-call', and `property-drawer' -;; types) can have a fixed set of keywords as attributes. Those are -;; called "affiliated keywords", to distinguish them from others -;; keywords, which are full-fledged elements. In particular, the -;; "name" affiliated keyword allows to label almost any element in an -;; Org buffer. +;; Greater elements (excepted `headline', `item' and `section' types) +;; and elements (excepted `keyword', `babel-call', and +;; `property-drawer' types) can have a fixed set of keywords as +;; attributes. Those are called "affiliated keywords", to distinguish +;; them from others keywords, which are full-fledged elements. In +;; particular, the "name" affiliated keyword allows to label almost +;; any element in an Org buffer. ;; Notwithstanding affiliated keywords, each greater element, element ;; and object has a fixed set of properties attached to it. Among @@ -79,10 +79,10 @@ ;; The first part of this file implements a parser and an interpreter ;; for each type of Org syntax. -;; The next two parts introduce two accessors and a function -;; retrieving the smallest element containing point (respectively -;; `org-element-get-property', `org-element-get-contents' and -;; `org-element-at-point'). +;; The next two parts introduce three accessors and a function +;; retrieving the smallest element starting at point (respectively +;; `org-element-type', `org-element-property', `org-element-contents' +;; and `org-element-current-element'). ;; The following part creates a fully recursive buffer parser. It ;; also provides a tool to map a function to elements or objects @@ -95,7 +95,8 @@ ;; relative, `org-element-interpret-secondary'). ;; The library ends by furnishing a set of interactive tools for -;; element's navigation and manipulation. +;; element's navigation and manipulation, mostly based on +;; `org-element-at-point' function. ;;; Code: @@ -128,12 +129,13 @@ ;; cannot contain other greater elements of their own type. ;; Beside implementing a parser and an interpreter, adding a new -;; greater element requires to tweak `org-element-guess-type'. +;; greater element requires to tweak `org-element-current-element'. ;; Moreover, the newly defined type must be added to both ;; `org-element-all-elements' and `org-element-greater-elements'. ;;;; Center Block + (defun org-element-center-block-parser () "Parse a center block. @@ -158,21 +160,23 @@ (defun org-element-center-block-parser () (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'center-block - `(:begin ,begin - :end ,end - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(center-block + (:begin ,begin + :end ,end + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-center-block-interpreter (center-block contents) "Interpret CENTER-BLOCK element as Org syntax. CONTENTS is the contents of the element." (format "#+begin_center\n%s#+end_center" contents)) + ;;;; Drawer + (defun org-element-drawer-parser () "Parse a drawer. @@ -194,24 +198,26 @@ (defun org-element-drawer-parser () (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'drawer - `(: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) - ,@(cadr keywords)))))) + `(drawer + (: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) + ,@(cadr keywords)))))) (defun org-element-drawer-interpreter (drawer contents) "Interpret DRAWER element as Org syntax. CONTENTS is the contents of the element." (format ":%s:\n%s:END:" - (org-element-get-property :drawer-name drawer) + (org-element-property :drawer-name drawer) contents)) + ;;;; Dynamic Block + (defun org-element-dynamic-block-parser () "Parse a dynamic block. @@ -250,11 +256,12 @@ (defun org-element-dynamic-block-interpreter (dynamic-block contents) "Interpret DYNAMIC-BLOCK element as Org syntax. CONTENTS is the contents of the element." (format "#+BEGIN: %s%s\n%s#+END:" - (org-element-get-property :block-name dynamic-block) - (let ((args (org-element-get-property :arguments dynamic-block))) + (org-element-property :block-name dynamic-block) + (let ((args (org-element-property :arguments dynamic-block))) (and arg (concat " " args))) contents)) + ;;;; Footnote Definition (defun org-element-footnote-definition-parser () @@ -277,24 +284,25 @@ (defun org-element-footnote-definition-parser () (contents-end (progn (skip-chars-backward " \r\t\n") (forward-line) (point)))) - (list 'footnote-definition - `(:label ,label - :begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines contents-end end) - ,@(cadr keywords)))))) + `(footnote-definition + (:label ,label + :begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines contents-end end) + ,@(cadr keywords)))))) (defun org-element-footnote-definition-interpreter (footnote-definition contents) "Interpret FOOTNOTE-DEFINITION element as Org syntax. CONTENTS is the contents of the footnote-definition." - (concat (format "[%s]" (org-element-get-property :label footnote-definition)) + (concat (format "[%s]" (org-element-property :label footnote-definition)) " " contents)) ;;;; Headline + (defun org-element-headline-parser () "Parse an headline. @@ -315,15 +323,20 @@ (defun org-element-headline-parser () (let* ((components (org-heading-components)) (level (nth 1 components)) (todo (nth 2 components)) - (todo-type (and todo - (if (member todo org-done-keywords) 'done 'todo))) + (todo-type + (and todo (if (member todo org-done-keywords) 'done 'todo))) (tags (nth 5 components)) (raw-value (nth 4 components)) - (quotedp (string-match (format "^%s +" org-quote-string) raw-value)) - (commentedp (string-match - (format "^%s +" org-comment-string) raw-value)) - (archivedp (and tags - (string-match (format ":%s:" org-archive-tag) tags))) + (quotedp + (let ((case-fold-search nil)) + (string-match (format "^%s +" org-quote-string) raw-value))) + (commentedp + (let ((case-fold-search nil)) + (string-match (format "^%s +" org-comment-string) raw-value))) + (archivedp + (and tags + (let ((case-fold-search nil)) + (string-match (format ":%s:" org-archive-tag) tags)))) (footnote-section-p (and org-footnote-section (string= org-footnote-section raw-value))) (standard-props (let (plist) @@ -372,55 +385,55 @@ (defun org-element-headline-parser () (setq title (org-element-parse-secondary-string raw-value (cdr (assq 'headline org-element-string-restrictions)))) - (list 'headline - `(:raw-value ,raw-value - :title ,title - :begin ,begin - :end ,end - :pre-blank ,(count-lines pos-after-head contents-begin) - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :level ,level - :priority ,(nth 3 components) - :tags ,tags - :todo-keyword ,todo - :todo-type ,todo-type - :scheduled ,scheduled - :deadline ,deadline - :timestamp ,timestamp - :clock ,clock - :post-blank ,(count-lines contents-end end) - :footnote-section-p ,footnote-section-p - :archivedp ,archivedp - :commentedp ,commentedp - :quotedp ,quotedp - ,@standard-props))))) + `(headline + (:raw-value ,raw-value + :title ,title + :begin ,begin + :end ,end + :pre-blank ,(count-lines pos-after-head contents-begin) + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :level ,level + :priority ,(nth 3 components) + :tags ,tags + :todo-keyword ,todo + :todo-type ,todo-type + :scheduled ,scheduled + :deadline ,deadline + :timestamp ,timestamp + :clock ,clock + :post-blank ,(count-lines contents-end end) + :footnote-section-p ,footnote-section-p + :archivedp ,archivedp + :commentedp ,commentedp + :quotedp ,quotedp + ,@standard-props))))) (defun org-element-headline-interpreter (headline contents) "Interpret HEADLINE element as Org syntax. CONTENTS is the contents of the element." - (let* ((level (org-element-get-property :level headline)) - (todo (org-element-get-property :todo-keyword headline)) - (priority (org-element-get-property :priority headline)) - (title (org-element-get-property :raw-value headline)) - (tags (let ((tag-string (org-element-get-property :tags headline)) - (archivedp (org-element-get-property :archivedp headline))) + (let* ((level (org-element-property :level headline)) + (todo (org-element-property :todo-keyword headline)) + (priority (org-element-property :priority headline)) + (title (org-element-property :raw-value headline)) + (tags (let ((tag-string (org-element-property :tags headline)) + (archivedp (org-element-property :archivedp headline))) (cond ((and (not tag-string) archivedp) (format ":%s:" org-archive-tag)) (archivedp (concat ":" org-archive-tag tag-string)) (t tag-string)))) - (commentedp (org-element-get-property :commentedp headline)) - (quotedp (org-element-get-property :quotedp headline)) - (pre-blank (org-element-get-property :pre-blank headline)) + (commentedp (org-element-property :commentedp headline)) + (quotedp (org-element-property :quotedp headline)) + (pre-blank (org-element-property :pre-blank headline)) (heading (concat (make-string level ?*) (and todo (concat " " todo)) (and quotedp (concat " " org-quote-string)) (and commentedp (concat " " org-comment-string)) (and priority (concat " " priority)) (cond ((and org-footnote-section - (org-element-get-property + (org-element-property :footnote-section-p headline)) (concat " " org-footnote-section)) (title (concat " " title))))) @@ -440,7 +453,9 @@ (defun org-element-headline-interpreter (headline contents) (make-string (1+ pre-blank) 10) contents))) + ;;;; Inlinetask + (defun org-element-inlinetask-parser () "Parse an inline task. @@ -493,35 +508,35 @@ (defun org-element-inlinetask-parser () (save-excursion (forward-line -1) (point)))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'inlinetask - `(:raw-value ,raw-value - :title ,title - :begin ,begin - :end ,end - :hiddenp ,(and (> contents-end contents-begin) hidden) - :contents-begin ,contents-begin - :contents-end ,contents-end - :level ,(nth 1 components) - :priority ,(nth 3 components) - :tags ,(nth 5 components) - :todo-keyword ,todo - :todo-type ,todo-type - :scheduled ,scheduled - :deadline ,deadline - :timestamp ,timestamp - :clock ,clock - :post-blank ,(count-lines pos-before-blank end) - ,@standard-props - ,@(cadr keywords)))))) + `(inlinetask + (:raw-value ,raw-value + :title ,title + :begin ,begin + :end ,end + :hiddenp ,(and (> contents-end contents-begin) hidden) + :contents-begin ,contents-begin + :contents-end ,contents-end + :level ,(nth 1 components) + :priority ,(nth 3 components) + :tags ,(nth 5 components) + :todo-keyword ,todo + :todo-type ,todo-type + :scheduled ,scheduled + :deadline ,deadline + :timestamp ,timestamp + :clock ,clock + :post-blank ,(count-lines pos-before-blank end) + ,@standard-props + ,@(cadr keywords)))))) (defun org-element-inlinetask-interpreter (inlinetask contents) "Interpret INLINETASK element as Org syntax. CONTENTS is the contents of inlinetask." - (let* ((level (org-element-get-property :level inlinetask)) - (todo (org-element-get-property :todo-keyword inlinetask)) - (priority (org-element-get-property :priority inlinetask)) - (title (org-element-get-property :raw-value inlinetask)) - (tags (org-element-get-property :tags inlinetask)) + (let* ((level (org-element-property :level inlinetask)) + (todo (org-element-property :todo-keyword inlinetask)) + (priority (org-element-property :priority inlinetask)) + (title (org-element-property :raw-value inlinetask)) + (tags (org-element-property :tags inlinetask)) (task (concat (make-string level ?*) (and todo (concat " " todo)) (and priority (concat " " priority)) @@ -540,7 +555,9 @@ (defun org-element-inlinetask-interpreter (inlinetask contents) 1))))))) (concat inlinetask (and tags (format tags-fmt tags) "\n" contents)))) + ;;;; Item + (defun org-element-item-parser (struct) "Parse an item. @@ -577,9 +594,11 @@ (defun org-element-item-parser (struct) (contents-begin (progn (looking-at org-list-full-item-re) (goto-char (match-end 0)) (org-skip-whitespace) - (if (>= (point) end) - (point-at-bol) - (point)))) + ;; 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-truely-invisible-p)))) @@ -587,39 +606,51 @@ (defun org-element-item-parser (struct) (skip-chars-backward " \r\t\n") (forward-line) (point)))) - (list 'item - `(: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 of two. - :contents-begin ,(min contents-begin contents-end) - :contents-end ,(max contents-begin contents-end) - :checkbox ,checkbox - :counter ,counter - :raw-tag ,raw-tag - :tag ,tag - :hiddenp ,hidden - :structure ,struct - :post-blank ,(count-lines contents-end end)))))) + `(item + (: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 of two. + :contents-begin ,(min contents-begin contents-end) + :contents-end ,(max contents-begin contents-end) + :checkbox ,checkbox + :counter ,counter + :raw-tag ,raw-tag + :tag ,tag + :hiddenp ,hidden + :structure ,struct + :post-blank ,(count-lines contents-end end)))))) (defun org-element-item-interpreter (item contents) "Interpret ITEM element as Org syntax. CONTENTS is the contents of the element." - (let* ((bullet (org-element-get-property :bullet item)) - (checkbox (org-element-get-property :checkbox item)) - (counter (org-element-get-property :counter item)) - (tag (org-element-get-property :raw-tag item)) + (let* ((bullet + (let* ((beg (org-element-property :begin item)) + (struct (org-element-property :structure item)) + (pre (org-list-prevs-alist struct)) + (bul (org-element-property :bullet item))) + (org-list-bullet-string + (if (not (eq (org-list-get-list-type beg struct pre) 'ordered)) "-" + (let ((num + (car + (last + (org-list-get-item-number + beg struct pre (org-list-parents-alist struct)))))) + (format "%d%s" + num + (if (eq org-plain-list-ordered-item-terminator ?\)) ")" + "."))))))) + (checkbox (org-element-property :checkbox item)) + (counter (org-element-property :counter item)) + (tag (org-element-property :raw-tag item)) ;; Compute indentation. (ind (make-string (length bullet) 32))) ;; Indent contents. (concat bullet - (when (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp bullet)) - " ") (and counter (format "[@%d] " counter)) (cond ((eq checkbox 'on) "[X] ") @@ -627,13 +658,17 @@ (defun org-element-item-interpreter (item contents) ((eq checkbox 'trans) "[-] ")) (and tag (format "%s :: " tag)) (org-trim - (replace-regexp-in-string - "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))))) + (replace-regexp-in-string "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))))) + ;;;; Plain List + (defun org-element-plain-list-parser (&optional structure) "Parse a plain list. +Optional argument STRUCTURE, when non-nil, is the structure of +the plain list being parsed. + Return a list whose car is `plain-list' and cdr is a plist containing `:type', `:begin', `:end', `:contents-begin' and `:contents-end', `:level', `:structure' and `:post-blank' @@ -667,23 +702,25 @@ (defun org-element-plain-list-parser (&optional structure) (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol)))))) ;; Return value. - (list 'plain-list - `(:type ,type - :begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :level ,level - :structure ,struct - :post-blank ,(count-lines contents-end end) - ,@(cadr keywords)))))) + `(plain-list + (:type ,type + :begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :level ,level + :structure ,struct + :post-blank ,(count-lines contents-end end) + ,@(cadr keywords)))))) (defun org-element-plain-list-interpreter (plain-list contents) "Interpret PLAIN-LIST element as Org syntax. CONTENTS is the contents of the element." contents) + ;;;; Quote Block + (defun org-element-quote-block-parser () "Parse a quote block. @@ -708,22 +745,57 @@ (defun org-element-quote-block-parser () (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'quote-block - `(:begin ,begin - :end ,end - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) - + `(quote-block + (:begin ,begin + :end ,end + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-quote-block-interpreter (quote-block contents) "Interpret QUOTE-BLOCK element as Org syntax. CONTENTS is the contents of the element." (format "#+begin_quote\n%s#+end_quote" contents)) + +;;;; Section + +(defun org-element-section-parser () + "Parse a section. + +Return a list whose car is `section' and cdr is a plist +containing `:begin', `:end', `:contents-begin', `contents-end' +and `:post-blank' keywords." + (save-excursion + ;; Beginning of section is the beginning of the first non-blank + ;; line after previous headline. + (org-with-limited-levels + (let ((begin + (save-excursion + (outline-previous-heading) + (if (not (org-at-heading-p)) (point) + (forward-line) (org-skip-whitespace) (point-at-bol)))) + (end (progn (outline-next-heading) (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point)))) + `(section + (:begin ,begin + :end ,end + :contents-begin ,begin + :contents-end ,pos-before-blank + :post-blank ,(count-lines pos-before-blank end))))))) + +(defun org-element-section-interpreter (section contents) + "Interpret SECTION element as Org syntax. +CONTENTS is the contents of the element." + contents) + + ;;;; Special Block + (defun org-element-special-block-parser () "Parse a special block. @@ -751,20 +823,20 @@ (defun org-element-special-block-parser () (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'special-block - `(:type ,type - :begin ,begin - :end ,end - :hiddenp ,hidden - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(special-block + (:type ,type + :begin ,begin + :end ,end + :hiddenp ,hidden + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-special-block-interpreter (special-block contents) "Interpret SPECIAL-BLOCK element as Org syntax. CONTENTS is the contents of the element." - (let ((block-type (org-element-get-property :type special-block))) + (let ((block-type (org-element-property :type special-block))) (format "#+begin_%s\n%s#+end_%s" block-type contents block-type))) @@ -776,8 +848,8 @@ (defun org-element-special-block-interpreter (special-block contents) ;; Also, as for greater elements, adding a new element type is done ;; through the following steps: implement a parser and an interpreter, -;; tweak `org-element-guess-type' so that it recognizes the new type -;; and add that new type to `org-element-all-elements'. +;; tweak `org-element-current-element' so that it recognizes the new +;; type and add that new type to `org-element-all-elements'. ;; As a special case, when the newly defined type is a block type, ;; `org-element-non-recursive-block-alist' has to be modified @@ -785,6 +857,7 @@ (defun org-element-special-block-interpreter (special-block contents) ;;;; Babel Call + (defun org-element-babel-call-parser () "Parse a babel call. @@ -798,16 +871,16 @@ (defun org-element-babel-call-parser () (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'babel-call - `(:beg ,beg - :end ,end - :info ,info - :post-blank ,(count-lines pos-before-blank end)))))) + `(babel-call + (:beg ,beg + :end ,end + :info ,info + :post-blank ,(count-lines pos-before-blank end)))))) (defun org-element-babel-call-interpreter (inline-babel-call contents) "Interpret INLINE-BABEL-CALL object as Org syntax. CONTENTS is nil." - (let* ((babel-info (org-element-get-property :info inline-babel-call)) + (let* ((babel-info (org-element-property :info inline-babel-call)) (main-source (car babel-info)) (post-options (nth 1 babel-info))) (concat "#+call: " @@ -818,54 +891,62 @@ (defun org-element-babel-call-interpreter (inline-babel-call contents) main-source) (and post-options (format "[%s]" post-options))))) + ;;;; Comment + (defun org-element-comment-parser () "Parse a comment. Return a list whose car is `comment' and cdr is a plist containing `:begin', `:end', `:value' and `:post-blank' keywords." - (let ((comment-re "\\(#\\|[ \t]*#\\+\\( \\|$\\)\\)") - beg-coms begin end value pos-before-blank keywords) + (let (beg-coms begin end end-coms keywords) (save-excursion - ;; Move to the beginning of comments. - (unless (bobp) - (while (and (not (bobp)) (looking-at comment-re)) - (forward-line -1)) - (unless (looking-at comment-re) (forward-line 1))) - (setq beg-coms (point)) - ;; Get affiliated keywords, if any. - (setq keywords (org-element-collect-affiliated-keywords)) - ;; Store true beginning of element. - (setq begin (car keywords)) - ;; Get ending of comments. If point is in a list, ensure to not - ;; get outside of it. - (let* ((itemp (org-in-item-p)) - (max-pos (if itemp - (org-list-get-bottom-point - (save-excursion (goto-char itemp) (org-list-struct))) - (point-max)))) - (while (and (looking-at comment-re) (< (point) max-pos)) - (forward-line))) - (setq pos-before-blank (point)) + (if (looking-at "#") + ;; First type of comment: comments at column 0. + (let ((comment-re "^\\([^#]\\|#\\+[a-z]\\)")) + (save-excursion + (re-search-backward comment-re nil 'move) + (if (bobp) (setq keywords nil beg-coms (point)) + (forward-line) + (setq keywords (org-element-collect-affiliated-keywords) + beg-coms (point)))) + (re-search-forward comment-re nil 'move) + (setq end-coms (if (eobp) (point) (match-beginning 0)))) + ;; Second type of comment: indented comments. + (let ((comment-re "[ \t]*#\\+\\(?: \\|$\\)")) + (unless (bobp) + (while (and (not (bobp)) (looking-at comment-re)) + (forward-line -1)) + (unless (looking-at comment-re) (forward-line))) + (setq beg-coms (point)) + (setq keywords (org-element-collect-affiliated-keywords)) + ;; Get comments ending. This may not be accurate if + ;; commented lines within an item are followed by commented + ;; lines outside of the list. Though, parser will always + ;; get it right as it already knows surrounding element and + ;; has narrowed buffer to its contents. + (while (looking-at comment-re) (forward-line)) + (setq end-coms (point)))) ;; Find position after blank. + (goto-char end-coms) (org-skip-whitespace) - (setq end (if (eobp) (point) (point-at-bol))) - ;; Extract value. - (setq value (buffer-substring-no-properties beg-coms pos-before-blank))) - (list 'comment - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords))))) + (setq end (if (eobp) (point) (point-at-bol)))) + `(comment + (:begin ,(or (car keywords) beg-coms) + :end ,end + :value ,(buffer-substring-no-properties beg-coms end-coms) + :post-blank ,(count-lines end-coms end) + ,@(cadr keywords))))) (defun org-element-comment-interpreter (comment contents) "Interpret COMMENT element as Org syntax. CONTENTS is nil." - (org-element-get-property :value comment)) + (org-element-property :value comment)) + ;;;; Comment Block + (defun org-element-comment-block-parser () "Parse an export block. @@ -888,66 +969,96 @@ (defun org-element-comment-block-parser () (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol)))) (value (buffer-substring-no-properties contents-begin contents-end))) - (list 'comment-block - `(:begin ,begin - :end ,end - :value ,value - :hiddenp ,hidden - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(comment-block + (:begin ,begin + :end ,end + :value ,value + :hiddenp ,hidden + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-comment-block-interpreter (comment-block contents) "Interpret COMMENT-BLOCK element as Org syntax. CONTENTS is nil." (concat "#+begin_comment\n" (org-remove-indentation - (org-element-get-property :value comment-block)) + (org-element-property :value comment-block)) "#+begin_comment")) + ;;;; Example Block + (defun org-element-example-block-parser () "Parse an example block. -Return a list whose car is `example' and cdr is a plist -containing `:begin', `:end', `:options', `:hiddenp', `:value' and -`:post-blank' keywords." +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' and `:post-blank' keywords." (save-excursion (end-of-line) (let* ((case-fold-search t) - (options (progn - (re-search-backward - "^[ \t]*#\\+begin_example\\(?: +\\(.*\\)\\)?" nil t) - (org-match-string-no-properties 1))) + (switches (progn + (re-search-backward + "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?" nil t) + (org-match-string-no-properties 1))) + ;; Switches analysis + (number-lines (cond ((not switches) nil) + ((string-match "-n\\>" switches) 'new) + ((string-match "+n\\>" switches) 'continued))) + (preserve-indent (and switches (string-match "-i\\>" switches))) + ;; Should labels be retained in (or stripped from) example + ;; blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels (not (string-match "-k\\>" switches))))) + (label-fmt (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Standard block parsing. (keywords (org-element-collect-affiliated-keywords)) (begin (car keywords)) (contents-begin (progn (forward-line) (point))) (hidden (org-truely-invisible-p)) (contents-end (progn - (re-search-forward "^[ \t]*#\\+end_example" nil t) + (re-search-forward "^[ \t]*#\\+END_EXAMPLE" nil t) (point-at-bol))) (value (buffer-substring-no-properties contents-begin contents-end)) (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'example-block - `(:begin ,begin - :end ,end - :value ,value - :options ,options - :hiddenp ,hidden - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(example-block + (:begin ,begin + :end ,end + :value ,value + :switches ,switches + :number-lines ,number-lines + :preserve-indent ,preserve-indent + :retain-labels ,retain-labels + :use-labels ,use-labels + :label-fmt ,label-fmt + :hiddenp ,hidden + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-example-block-interpreter (example-block contents) "Interpret EXAMPLE-BLOCK element as Org syntax. CONTENTS is nil." - (let ((options (org-element-get-property :options example-block))) + (let ((options (org-element-property :options example-block))) (concat "#+begin_example" (and options (concat " " options)) "\n" (org-remove-indentation - (org-element-get-property :value example-block)) + (org-element-property :value example-block)) "#+end_example"))) + ;;;; Export Block + (defun org-element-export-block-parser () "Parse an export block. @@ -973,24 +1084,26 @@ (defun org-element-export-block-parser () (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol)))) (value (buffer-substring-no-properties contents-begin contents-end))) - (list 'export-block - `(:begin ,begin - :end ,end - :type ,type - :value ,value - :hiddenp ,hidden - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(export-block + (:begin ,begin + :end ,end + :type ,type + :value ,value + :hiddenp ,hidden + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-export-block-interpreter (export-block contents) "Interpret EXPORT-BLOCK element as Org syntax. CONTENTS is nil." - (let ((type (org-element-get-property :type export-block))) + (let ((type (org-element-property :type export-block))) (concat (format "#+begin_%s\n" type) - (org-element-get-property :value export-block) + (org-element-property :value export-block) (format "#+end_%s" type)))) + ;;;; Fixed-width + (defun org-element-fixed-width-parser () "Parse a fixed-width section. @@ -1025,19 +1138,21 @@ (defun org-element-fixed-width-parser () (setq end (if (eobp) (point) (point-at-bol))) ;; Extract value. (setq value (buffer-substring-no-properties beg-area pos-before-blank))) - (list 'fixed-width - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords))))) + `(fixed-width + (:begin ,begin + :end ,end + :value ,value + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords))))) (defun org-element-fixed-width-interpreter (fixed-width contents) "Interpret FIXED-WIDTH element as Org syntax. CONTENTS is nil." - (org-remove-indentation (org-element-get-property :value fixed-width))) + (org-remove-indentation (org-element-property :value fixed-width))) + ;;;; Horizontal Rule + (defun org-element-horizontal-rule-parser () "Parse an horizontal rule. @@ -1050,18 +1165,20 @@ (defun org-element-horizontal-rule-parser () (post-hr (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'horizontal-rule - `(:begin ,begin - :end ,end - :post-blank ,(count-lines post-hr end) - ,@(cadr keywords)))))) + `(horizontal-rule + (:begin ,begin + :end ,end + :post-blank ,(count-lines post-hr end) + ,@(cadr keywords)))))) (defun org-element-horizontal-rule-interpreter (horizontal-rule contents) "Interpret HORIZONTAL-RULE element as Org syntax. CONTENTS is nil." "-----") + ;;;; Keyword + (defun org-element-keyword-parser () "Parse a keyword at point. @@ -1078,21 +1195,23 @@ (defun org-element-keyword-parser () (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'keyword - `(:key ,key - :value ,value - :begin ,begin - :end ,end - :post-blank ,(count-lines pos-before-blank end)))))) + `(keyword + (:key ,key + :value ,value + :begin ,begin + :end ,end + :post-blank ,(count-lines pos-before-blank end)))))) (defun org-element-keyword-interpreter (keyword contents) "Interpret KEYWORD element as Org syntax. CONTENTS is nil." (format "#+%s: %s" - (org-element-get-property :key keyword) - (org-element-get-property :value keyword))) + (org-element-property :key keyword) + (org-element-property :value keyword))) + ;;;; Latex Environment + (defun org-element-latex-environment-parser () "Parse a LaTeX environment. @@ -1110,19 +1229,21 @@ (defun org-element-latex-environment-parser () (value (buffer-substring-no-properties contents-begin contents-end)) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'latex-environment - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,(count-lines contents-end end) - ,@(cadr keywords)))))) + `(latex-environment + (:begin ,begin + :end ,end + :value ,value + :post-blank ,(count-lines contents-end end) + ,@(cadr keywords)))))) (defun org-element-latex-environment-interpreter (latex-environment contents) "Interpret LATEX-ENVIRONMENT element as Org syntax. CONTENTS is nil." - (org-element-get-property :value latex-environment)) + (org-element-property :value latex-environment)) + ;;;; Paragraph + (defun org-element-paragraph-parser () "Parse a paragraph. @@ -1144,20 +1265,22 @@ (defun org-element-paragraph-parser () (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'paragraph - `(:begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(paragraph + (:begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-paragraph-interpreter (paragraph contents) "Interpret PARAGRAPH element as Org syntax. CONTENTS is the contents of the element." contents) + ;;;; Property Drawer + (defun org-element-property-drawer-parser () "Parse a property drawer. @@ -1188,17 +1311,17 @@ (defun org-element-property-drawer-parser () (pos-before-blank (progn (forward-line) (point))) (end (progn (org-skip-whitespace) (if (eobp) (point) (point-at-bol))))) - (list 'property-drawer - `(:begin ,begin - :end ,end - :hiddenp ,hidden - :properties ,properties - :post-blank ,(count-lines pos-before-blank end)))))) + `(property-drawer + (:begin ,begin + :end ,end + :hiddenp ,hidden + :properties ,properties + :post-blank ,(count-lines pos-before-blank end)))))) (defun org-element-property-drawer-interpreter (property-drawer contents) "Interpret PROPERTY-DRAWER element as Org syntax. CONTENTS is nil." - (let ((props (org-element-get-property :properties property-drawer))) + (let ((props (org-element-property :properties property-drawer))) (concat ":PROPERTIES:\n" (mapconcat (lambda (p) @@ -1206,69 +1329,90 @@ (defun org-element-property-drawer-interpreter (property-drawer contents) (nreverse props) "\n") "\n:END:"))) + ;;;; Quote Section + (defun org-element-quote-section-parser () "Parse a quote section. Return a list whose car is `quote-section' and cdr is a plist containing `:begin', `:end', `:value' and `:post-blank' -keywords." +keywords. + +Assume point is at beginning of the section." (save-excursion - (let* ((begin (progn (org-back-to-heading t) - (forward-line) - (org-skip-whitespace) - (point-at-bol))) + (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 (unless (= begin end) - (buffer-substring-no-properties begin pos-before-blank)))) - (list 'quote-section - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,(if value - (count-lines pos-before-blank end) - 0)))))) + (value (buffer-substring-no-properties begin pos-before-blank))) + `(quote-section + (: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-get-property :value quote-section)) + (org-element-property :value quote-section)) + ;;;; Src Block + (defun org-element-src-block-parser () "Parse a src block. Return a list whose car is `src-block' and cdr is a plist containing `:language', `:switches', `:parameters', `:begin', -`:end', `:hiddenp', `:contents-begin', `:contents-end', `:value' -and `:post-blank' keywords." +`:end', `:hiddenp', `:contents-begin', `:contents-end', +`:number-lines', `:retain-labels', `:use-labels', `:label-fmt', +`:preserve-indent', `:value' and `:post-blank' keywords." (save-excursion (end-of-line) (let* ((case-fold-search t) ;; Get position at beginning of block. (contents-begin (re-search-backward - (concat "^[ \t]*#\\+begin_src" - "\\(?: +\\(\\S-+\\)\\)?" ; language - "\\(\\(?: +[-+][A-Za-z]\\)*\\)" ; switches - "\\(.*\\)[ \t]*$") ; arguments + (concat + "^[ \t]*#\\+BEGIN_SRC" + "\\(?: +\\(\\S-+\\)\\)?" ; language + "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)*\\)" ; switches + "\\(.*\\)[ \t]*$") ; parameters nil t)) ;; Get language as a string. (language (org-match-string-no-properties 1)) - ;; Get switches. - (switches (org-match-string-no-properties 2)) ;; Get parameters. (parameters (org-trim (org-match-string-no-properties 3))) + ;; Get switches. + (switches (org-match-string-no-properties 2)) + ;; Switches analysis + (number-lines (cond ((not switches) nil) + ((string-match "-n\\>" switches) 'new) + ((string-match "+n\\>" switches) 'continued))) + (preserve-indent (and switches (string-match "-i\\>" switches))) + (label-fmt (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Should labels be retained in (or stripped from) src + ;; blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels (not (string-match "-k\\>" switches))))) ;; Get affiliated keywords. (keywords (org-element-collect-affiliated-keywords)) ;; Get beginning position. (begin (car keywords)) ;; Get position at end of block. - (contents-end (progn (re-search-forward "^[ \t]*#\\+end_src" nil t) + (contents-end (progn (re-search-forward "^[ \t]*#\\+END_SRC" nil t) (forward-line) (point))) ;; Retrieve code. @@ -1282,26 +1426,31 @@ (defun org-element-src-block-parser () (if (eobp) (point) (point-at-bol)))) ;; Get visibility status. (hidden (progn (goto-char contents-begin) - (forward-line) - (org-truely-invisible-p)))) - (list 'src-block - `(:language ,language - :switches ,switches - :parameters ,parameters - :begin ,begin - :end ,end - :hiddenp ,hidden - :value ,value - :post-blank ,(count-lines contents-end end) - ,@(cadr keywords)))))) + (forward-line) + (org-truely-invisible-p)))) + `(src-block + (:language ,language + :switches ,switches + :parameters ,parameters + :begin ,begin + :end ,end + :number-lines ,number-lines + :preserve-indent ,preserve-indent + :retain-labels ,retain-labels + :use-labels ,use-labels + :label-fmt ,label-fmt + :hiddenp ,hidden + :value ,value + :post-blank ,(count-lines contents-end end) + ,@(cadr keywords)))))) (defun org-element-src-block-interpreter (src-block contents) "Interpret SRC-BLOCK element as Org syntax. CONTENTS is nil." - (let ((lang (org-element-get-property :language src-block)) - (switches (org-element-get-property :switches src-block)) - (params (org-element-get-property :parameters src-block)) - (value (let ((val (org-element-get-property :value src-block))) + (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-src-preserve-indentation val) ((zerop org-edit-src-content-indentation) @@ -1319,7 +1468,9 @@ (defun org-element-src-block-interpreter (src-block contents) value "#+end_src"))) + ;;;; Table + (defun org-element-table-parser () "Parse a table at point. @@ -1340,21 +1491,23 @@ (defun org-element-table-parser () (if (eobp) (point) (point-at-bol)))) (raw-table (org-remove-indentation (buffer-substring-no-properties table-begin table-end)))) - (list 'table - `(:begin ,begin - :end ,end - :type ,type - :raw-table ,raw-table - :tblfm ,tblfm - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) + `(table + (:begin ,begin + :end ,end + :type ,type + :raw-table ,raw-table + :tblfm ,tblfm + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-table-interpreter (table contents) "Interpret TABLE element as Org syntax. CONTENTS is nil." - (org-element-get-property :raw-table table)) + (org-element-property :raw-table table)) + ;;;; Verse Block + (defun org-element-verse-block-parser () "Parse a verse block. @@ -1382,23 +1535,22 @@ (defun org-element-verse-block-parser () (if (eobp) (point) (point-at-bol)))) (value (org-element-parse-secondary-string (org-remove-indentation raw-val) - (cdr (assq 'verse org-element-string-restrictions))))) - (list 'verse-block - `(:begin ,begin - :end ,end - :hiddenp ,hidden - :raw-value ,raw-val - :value ,value - :post-blank ,(count-lines pos-before-blank end) - ,@(cadr keywords)))))) - + (cdr (assq 'verse-block org-element-string-restrictions))))) + `(verse-block + (:begin ,begin + :end ,end + :hiddenp ,hidden + :raw-value ,raw-val + :value ,value + :post-blank ,(count-lines pos-before-blank end) + ,@(cadr keywords)))))) (defun org-element-verse-block-interpreter (verse-block contents) "Interpret VERSE-BLOCK element as Org syntax. CONTENTS is nil." (format "#+begin_verse\n%s#+end_verse" (org-remove-indentation - (org-element-get-property :raw-value verse-block)))) + (org-element-property :raw-value verse-block)))) @@ -1417,16 +1569,18 @@ (defun org-element-verse-block-interpreter (verse-block contents) ;; org-element-NAME-successor, where NAME is the name of the ;; successor, as defined in `org-element-all-successors'. -;; Some object types (i.e `emphasis') are recursive. Restrictions on +;; Some object types (i.e. `emphasis') 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 successor in `org-element-all-successors', -;; maybe tweak restrictions about it, and that's it. +;; convention. Register type in `org-element-all-objects' and +;; successor in `org-element-all-successors'. Maybe tweak +;; restrictions about it, and that's it. ;;;; Emphasis + (defun org-element-emphasis-parser () "Parse text markup object at point. @@ -1445,22 +1599,22 @@ (defun org-element-emphasis-parser () (post-blank (progn (goto-char (match-end 2)) (skip-chars-forward " \t"))) (end (point))) - (list 'emphasis - `(:marker ,marker - :begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,post-blank))))) + `(emphasis + (:marker ,marker + :begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :post-blank ,post-blank))))) (defun org-element-emphasis-interpreter (emphasis contents) "Interpret EMPHASIS object as Org syntax. CONTENTS is the contents of the object." - (let ((marker (org-element-get-property :marker emphasis))) + (let ((marker (org-element-property :marker emphasis))) (concat marker contents marker))) (defun org-element-text-markup-successor (limit) - "Search for the next emphasis or verbatim and return position. + "Search for the next emphasis or verbatim object. LIMIT bounds the search. @@ -1475,6 +1629,7 @@ (defun org-element-text-markup-successor (limit) (match-beginning 2))))) ;;;; Entity + (defun org-element-entity-parser () "Parse entity at point. @@ -1493,25 +1648,25 @@ (defun org-element-entity-parser () (when bracketsp (forward-char 2)) (skip-chars-forward " \t"))) (end (point))) - (list 'entity - `(: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))))) + `(entity + (: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. CONTENTS is nil." (concat "\\" - (org-element-get-property :name entity) - (when (org-element-get-property :use-brackets-p entity) "{}"))) + (org-element-property :name entity) + (when (org-element-property :use-brackets-p entity) "{}"))) (defun org-element-latex-or-entity-successor (limit) "Search for the next latex-fragment or entity object. @@ -1547,7 +1702,9 @@ (defun org-element-latex-or-entity-successor (limit) matchers) (point)))))))) + ;;;; Export Snippet + (defun org-element-export-snippet-parser () "Parse export snippet at point. @@ -1565,19 +1722,19 @@ (defun org-element-export-snippet-parser () (match-end 0) (1- before-blank))) (post-blank (skip-chars-forward " \t")) (end (point))) - (list 'export-snippet - `(:back-end ,back-end - :value ,value - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(export-snippet + (: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. CONTENTS is nil." (format "@%s{%s}" - (org-element-get-property :back-end export-snippet) - (org-element-get-property :value export-snippet))) + (org-element-property :back-end export-snippet) + (org-element-property :value export-snippet))) (defun org-element-export-snippet-successor (limit) "Search for the next export-snippet object. @@ -1593,6 +1750,7 @@ (defun org-element-export-snippet-successor (limit) (and end (eq (char-before end) ?}))) (throw 'exit (cons 'export-snippet (match-beginning 0)))))))) + ;;;; Footnote Reference (defun org-element-footnote-reference-parser () @@ -1605,35 +1763,37 @@ (defun org-element-footnote-reference-parser () (let* ((ref (org-footnote-at-reference-p)) (label (car ref)) (raw-def (nth 3 ref)) - (inline-def (and raw-def - (org-element-parse-secondary-string raw-def nil))) + (inline-def + (and raw-def + (org-element-parse-secondary-string + raw-def + (cdr (assq 'footnote-reference + org-element-string-restrictions))))) (type (if (nth 3 ref) 'inline 'standard)) (begin (nth 1 ref)) (post-blank (progn (goto-char (nth 2 ref)) (skip-chars-forward " \t"))) (end (point))) - (list 'footnote-reference - `(:label ,label - :type ,type - :inline-definition ,inline-def - :begin ,begin - :end ,end - :post-blank ,post-blank - :raw-definition ,raw-def))))) + `(footnote-reference + (:label ,label + :type ,type + :inline-definition ,inline-def + :begin ,begin + :end ,end + :post-blank ,post-blank + :raw-definition ,raw-def))))) (defun org-element-footnote-reference-interpreter (footnote-reference contents) "Interpret FOOTNOTE-REFERENCE object as Org syntax. CONTENTS is nil." - (let ((label (or (org-element-get-property :label footnote-reference) - "fn:")) - (def (let ((raw (org-element-get-property - :raw-definition footnote-reference))) - (if raw (concat ":" raw) "")))) + (let ((label (or (org-element-property :label footnote-reference) "fn:")) + (def + (let ((raw (org-element-property :raw-definition footnote-reference))) + (if raw (concat ":" raw) "")))) (format "[%s]" (concat label def)))) (defun org-element-footnote-reference-successor (limit) - "Search for the next footnote-reference and return beginning - position. + "Search for the next footnote-reference object. LIMIT bounds the search. @@ -1645,6 +1805,7 @@ (defun org-element-footnote-reference-successor (limit) ;;;; Inline Babel Call + (defun org-element-inline-babel-call-parser () "Parse inline babel call at point. @@ -1660,16 +1821,16 @@ (defun org-element-inline-babel-call-parser () (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) - (list 'inline-babel-call - `(:begin ,begin - :end ,end - :info ,info - :post-blank ,post-blank))))) + `(inline-babel-call + (:begin ,begin + :end ,end + :info ,info + :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-get-property :info inline-babel-call)) + (let* ((babel-info (org-element-property :info inline-babel-call)) (main-source (car babel-info)) (post-options (nth 1 babel-info))) (concat "call_" @@ -1681,8 +1842,7 @@ (defun org-element-inline-babel-call-interpreter (inline-babel-call contents) (and post-options (format "[%s]" post-options))))) (defun org-element-inline-babel-call-successor (limit) - "Search for the next inline-babel-call and return beginning - position. + "Search for the next inline-babel-call object. LIMIT bounds the search. @@ -1696,7 +1856,9 @@ (defun org-element-inline-babel-call-successor (limit) limit t) (cons 'inline-babel-call (match-beginning 0))))) + ;;;; Inline Src Block + (defun org-element-inline-src-block-parser () "Parse inline source block at point. @@ -1715,18 +1877,27 @@ (defun org-element-inline-src-block-parser () (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) - (list 'inline-src-block - `(:language ,language - :value ,value - :parameters ,parameters - :begin ,begin - :end ,end - :post-blank ,post-blank))))) - + `(inline-src-block + (: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. +CONTENTS is nil." + (let ((language (org-element-property :language inline-src-block)) + (arguments (org-element-property :parameters inline-src-block)) + (body (org-element-property :value inline-src-block))) + (format "src_%s%s{%s}" + language + (if arguments (format "[%s]" arguments) "") + body))) (defun org-element-inline-src-block-successor (limit) - "Search for the next inline-babel-call and return beginning position. + "Search for the next inline-babel-call element. LIMIT bounds the search. @@ -1736,7 +1907,9 @@ (defun org-element-inline-src-block-successor (limit) (when (re-search-forward org-babel-inline-src-block-regexp limit t) (cons 'inline-src-block (match-beginning 1))))) + ;;;; Latex Fragment + (defun org-element-latex-fragment-parser () "Parse latex fragment at point. @@ -1764,18 +1937,19 @@ (defun org-element-latex-fragment-parser () (post-blank (progn (goto-char (match-end substring-match)) (skip-chars-forward " \t"))) (end (point))) - (list 'latex-fragment - `(:value ,value - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(latex-fragment + (:value ,value + :begin ,begin + :end ,end + :post-blank ,post-blank))))) (defun org-element-latex-fragment-interpreter (latex-fragment contents) "Interpret LATEX-FRAGMENT object as Org syntax. CONTENTS is nil." - (org-element-get-property :value latex-fragment)) + (org-element-property :value latex-fragment)) ;;;; Line Break + (defun org-element-line-break-parser () "Parse line break at point. @@ -1783,23 +1957,17 @@ (defun org-element-line-break-parser () `:begin', `:end' and `:post-blank' keywords. Assume point is at the beginning of the line break." - (save-excursion - (let* ((begin (point)) - (end (progn (end-of-line) (point))) - (post-blank (- (skip-chars-backward " \t"))) - (end (point))) - (list 'line-break - `(:begin ,begin - :end ,end - :post-blank ,post-blank))))) + (let ((begin (point)) + (end (save-excursion (forward-line) (point)))) + `(line-break (:begin ,begin :end ,end :post-blank 0)))) (defun org-element-line-break-interpreter (line-break contents) "Interpret LINE-BREAK object as Org syntax. CONTENTS is nil." - (org-element-get-property :value line-break)) + "\\\\\n") (defun org-element-line-break-successor (limit) - "Search for the next statistics cookie and return position. + "Search for the next line-break object. LIMIT bounds the search. @@ -1812,7 +1980,9 @@ (defun org-element-line-break-successor (limit) (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. @@ -1826,13 +1996,11 @@ (defun org-element-link-parser () end contents-begin contents-end link-end post-blank path type raw-link link) (cond - ;; Type 1: text targeted from a radio target. + ;; Type 1: Text targeted from a radio target. ((and org-target-link-regexp (looking-at org-target-link-regexp)) (setq type "radio" - path (org-match-string-no-properties 0) - contents-begin (match-beginning 0) - contents-end (match-end 0) - link-end (match-end 0))) + link-end (match-end 0) + path (org-match-string-no-properties 0))) ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]] ((looking-at org-bracket-link-regexp) (setq contents-begin (match-beginning 3) @@ -1881,29 +2049,28 @@ (defun org-element-link-parser () ;; LINK-END variable. (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) end (point)) - (list 'link - `(:type ,type - :path ,path - :raw-link ,(or raw-link path) - :begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,post-blank))))) + `(link + (:type ,type + :path ,path + :raw-link ,(or raw-link path) + :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. CONTENTS is the contents of the object." - (let ((type (org-element-get-property :type link)) - (raw-link (org-element-get-property :raw-link link))) - (cond - ((string= type "radio") raw-link) - (t (format "[[%s]%s]" - raw-link - (if (string= contents "") "" (format "[%s]" contents))))))) + (let ((type (org-element-property :type link)) + (raw-link (org-element-property :raw-link link))) + (if (string= type "radio") raw-link + (format "[[%s]%s]" + raw-link + (if (string= contents "") "" (format "[%s]" contents)))))) (defun org-element-link-successor (limit) - "Search for the next link and return position. + "Search for the next link object. LIMIT bounds the search. @@ -1911,13 +2078,14 @@ (defun org-element-link-successor (limit) beginning position." (save-excursion (let ((link-regexp - (if org-target-link-regexp - (concat org-any-link-re "\\|" org-target-link-regexp) - org-any-link-re))) + (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 limit t) (cons 'link (match-beginning 0)))))) + ;;;; Macro + (defun org-element-macro-parser () "Parse macro at point. @@ -1945,21 +2113,21 @@ (defun org-element-macro-parser () (pop args)) (push (pop args) args2)) (mapcar 'org-trim (nreverse args2)))))) - (list 'macro - `(:key ,key - :value ,value - :args ,args - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(macro + (: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-get-property :value macro)) + (org-element-property :value macro)) (defun org-element-macro-successor (limit) - "Search for the next macro and return position. + "Search for the next macro object. LIMIT bounds the search. @@ -1971,7 +2139,9 @@ (defun org-element-macro-successor (limit) limit t) (cons 'macro (match-beginning 0))))) + ;;;; Radio-target + (defun org-element-radio-target-parser () "Parse radio target at point. @@ -1989,21 +2159,21 @@ (defun org-element-radio-target-parser () (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) - (list 'radio-target - `(:begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :raw-value ,raw-value - :post-blank ,post-blank))))) + `(radio-target + (:begin ,begin + :end ,end + :contents-begin ,contents-begin + :contents-end ,contents-end + :raw-value ,raw-value + :post-blank ,post-blank))))) (defun org-element-radio-target-interpreter (target contents) "Interpret TARGET object as Org syntax. CONTENTS is the contents of the object." - (concat ">")) + (concat "<<<" contents ">>>")) (defun org-element-radio-target-successor (limit) - "Search for the next radio-target and return position. + "Search for the next radio-target object. LIMIT bounds the search. @@ -2013,7 +2183,9 @@ (defun org-element-radio-target-successor (limit) (when (re-search-forward org-radio-target-regexp limit t) (cons 'radio-target (match-beginning 0))))) + ;;;; Statistics Cookie + (defun org-element-statistics-cookie-parser () "Parse statistics cookie at point. @@ -2029,19 +2201,19 @@ (defun org-element-statistics-cookie-parser () (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) - (list 'statistics-cookie - `(:begin ,begin - :end ,end - :value ,value - :post-blank ,post-blank))))) + `(statistics-cookie + (: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-get-property :value statistics-cookie)) + (org-element-property :value statistics-cookie)) (defun org-element-statistics-cookie-successor (limit) - "Search for the next statistics cookie and return position. + "Search for the next statistics cookie object. LIMIT bounds the search. @@ -2051,7 +2223,9 @@ (defun org-element-statistics-cookie-successor (limit) (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t) (cons 'statistics-cookie (match-beginning 0))))) + ;;;; Subscript + (defun org-element-subscript-parser () "Parse subscript at point. @@ -2072,24 +2246,23 @@ (defun org-element-subscript-parser () (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) - (list 'subscript - `(:begin ,begin - :end ,end - :use-brackets-p ,bracketsp - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,post-blank))))) + `(subscript + (: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. CONTENTS is the contents of the object." (format - (if (org-element-get-property :use-brackets-p subscript) "_{%s}" "_%s") + (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") contents)) (defun org-element-sub/superscript-successor (limit) - "Search for the next sub/superscript and return beginning -position. + "Search for the next sub/superscript object. LIMIT bounds the search. @@ -2100,7 +2273,9 @@ (defun org-element-sub/superscript-successor (limit) (cons (if (string= (match-string 2) "_") 'subscript 'superscript) (match-beginning 2))))) + ;;;; Superscript + (defun org-element-superscript-parser () "Parse superscript at point. @@ -2121,46 +2296,44 @@ (defun org-element-superscript-parser () (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) - (list 'superscript - `(:begin ,begin - :end ,end - :use-brackets-p ,bracketsp - :contents-begin ,contents-begin - :contents-end ,contents-end - :post-blank ,post-blank))))) + `(superscript + (: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. CONTENTS is the contents of the object." (format - (if (org-element-get-property :use-brackets-p superscript) "^{%s}" "^%s") + (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") contents)) + ;;;; Target + (defun org-element-target-parser () "Parse target at point. Return a list whose car is `target' and cdr a plist with -`:begin', `:end', `:contents-begin', `:contents-end', `raw-value' -and `:post-blank' as keywords. +`:begin', `:end', `:contents-begin', `:contents-end', `value' and +`:post-blank' as keywords. Assume point is at the target." (save-excursion (looking-at org-target-regexp) (let ((begin (point)) - (contents-begin (match-beginning 1)) - (contents-end (match-end 1)) - (raw-value (org-match-string-no-properties 1)) + (value (org-match-string-no-properties 1)) (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) - (list 'target - `(:begin ,begin - :end ,end - :contents-begin ,contents-begin - :contents-end ,contents-end - :raw-value ,raw-value - :post-blank ,post-blank))))) + `(target + (:begin ,begin + :end ,end + :value ,value + :post-blank ,post-blank))))) (defun org-element-target-interpreter (target contents) "Interpret TARGET object as Org syntax. @@ -2168,7 +2341,7 @@ (defun org-element-target-interpreter (target contents) (concat "")) (defun org-element-target-successor (limit) - "Search for the next target and return position. + "Search for the next target object. LIMIT bounds the search. @@ -2178,7 +2351,9 @@ (defun org-element-target-successor (limit) (when (re-search-forward org-target-regexp limit t) (cons 'target (match-beginning 0))))) + ;;;; Time-stamp + (defun org-element-time-stamp-parser () "Parse time stamp at point. @@ -2215,26 +2390,26 @@ (defun org-element-time-stamp-parser () (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point))) - (list 'time-stamp - `(:appt-type ,appt-type - :type ,type - :value ,value - :begin ,begin - :end ,end - :post-blank ,post-blank))))) + `(time-stamp + (:appt-type ,appt-type + :type ,type + :value ,value + :begin ,begin + :end ,end + :post-blank ,post-blank))))) (defun org-element-time-stamp-interpreter (time-stamp contents) "Interpret TIME-STAMP object as Org syntax. CONTENTS is nil." (concat - (case (org-element-get-property :appt-type time-stamp) + (case (org-element-property :appt-type time-stamp) (closed (concat org-closed-string " ")) (deadline (concat org-deadline-string " ")) (scheduled (concat org-scheduled-string " "))) - (org-element-get-property :value time-stamp))) + (org-element-property :value time-stamp))) (defun org-element-time-stamp-successor (limit) - "Search for the next time-stamp and return position. + "Search for the next time-stamp object. LIMIT bounds the search. @@ -2252,7 +2427,9 @@ (defun org-element-time-stamp-successor (limit) limit t) (cons 'time-stamp (match-beginning 0))))) + ;;;; Verbatim + (defun org-element-verbatim-parser () "Parse verbatim object at point. @@ -2269,18 +2446,18 @@ (defun org-element-verbatim-parser () (post-blank (progn (goto-char (match-end 2)) (skip-chars-forward " \t"))) (end (point))) - (list 'verbatim - `(:marker ,marker - :begin ,begin - :end ,end - :value ,value - :post-blank ,post-blank))))) + `(verbatim + (:marker ,marker + :begin ,begin + :end ,end + :value ,value + :post-blank ,post-blank))))) (defun org-element-verbatim-interpreter (verbatim contents) "Interpret VERBATIM object as Org syntax. CONTENTS is nil." - (let ((marker (org-element-get-property :marker verbatim)) - (value (org-element-get-property :value verbatim))) + (let ((marker (org-element-property :marker verbatim)) + (value (org-element-property :value verbatim))) (concat marker value marker))) @@ -2316,12 +2493,13 @@ (defconst org-element-all-elements export-block fixed-width footnote-definition headline horizontal-rule inlinetask item keyword latex-environment babel-call paragraph plain-list property-drawer quote-block - quote-section special-block src-block table verse-block) - "Complete list of elements.") + quote-section section special-block src-block table + verse-block) + "Complete list of element types.") (defconst org-element-greater-elements '(center-block drawer dynamic-block footnote-definition headline inlinetask - item plain-list quote-block special-block) + item plain-list quote-block section special-block) "List of recursive element types aka Greater Elements.") (defconst org-element-all-successors @@ -2340,8 +2518,15 @@ (defconst org-element-object-successor-alist 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 + '(emphasis entity export-snippet footnote-reference inline-babel-call + inline-src-block line-break latex-fragment link macro radio-target + statistics-cookie subscript superscript target time-stamp + verbatim) + "Complete list of object types.") + (defconst org-element-recursive-objects - '(emphasis link subscript superscript target radio-target) + '(emphasis link macro subscript superscript radio-target) "List of recursive object types.") (defconst org-element-non-recursive-block-alist @@ -2350,7 +2535,7 @@ (defconst org-element-non-recursive-block-alist ("docbook" . export-block) ("example" . example-block) ("html" . export-block) - ("latex" . latex-block) + ("latex" . export-block) ("odt" . export-block) ("src" . src-block) ("verse" . verse-block)) @@ -2389,7 +2574,7 @@ (defconst org-element-parsed-keywords '("author" "caption" "title") This list is checked after translations have been applied. See `org-element-keyword-translation-alist'.") -(defconst org-element-dual-keywords '("results") +(defconst org-element-dual-keywords '("caption" "results") "List of keywords which can have a secondary value. In Org syntax, they can be written with optional square brackets @@ -2402,19 +2587,19 @@ (defconst org-element-dual-keywords '("results") `org-element-keyword-translation-alist'.") (defconst org-element-object-restrictions - '((emphasis entity export-snippet inline-babel-call inline-src-block + '((emphasis entity export-snippet inline-babel-call inline-src-block link radio-target sub/superscript target text-markup time-stamp) (link entity export-snippet inline-babel-call inline-src-block - latex-fragment sub/superscript text-markup) + latex-fragment link sub/superscript text-markup) + (macro macro) (radio-target entity export-snippet latex-fragment sub/superscript) (subscript entity export-snippet inline-babel-call inline-src-block latex-fragment sub/superscript text-markup) (superscript entity export-snippet inline-babel-call inline-src-block - latex-fragment sub/superscript text-markup) - (target entity export-snippet latex-fragment sub/superscript text-markup)) + latex-fragment sub/superscript text-markup)) "Alist of recursive objects restrictions. -Car is a recursive object type and cdr is a list of successors +CAR is a recursive object type and CDR is a list of successors that will be called within an object of such type. For example, in a `radio-target' object, one can only find @@ -2422,239 +2607,206 @@ (defconst org-element-object-restrictions superscript.") (defconst org-element-string-restrictions - '((headline entity inline-babel-call latex-fragment link macro radio-target - statistics-cookie sub/superscript text-markup time-stamp) - (inlinetask entity inline-babel-call latex-fragment link macro radio-target - sub/superscript text-markup time-stamp) + '((footnote-reference entity export-snippet footnote-reference + inline-babel-call inline-src-block latex-fragment + line-break link macro radio-target sub/superscript + target text-markup time-stamp) + (headline entity inline-babel-call inline-src-block latex-fragment link + macro radio-target statistics-cookie sub/superscript text-markup + time-stamp) + (inlinetask entity inline-babel-call inline-src-block latex-fragment link + macro radio-target sub/superscript text-markup time-stamp) (item entity inline-babel-call latex-fragment macro radio-target - sub/superscript target verbatim) + sub/superscript target text-markup) (keyword entity latex-fragment macro sub/superscript text-markup) - (table entity latex-fragment macro text-markup) - (verse entity footnote-reference inline-babel-call inline-src-block - latex-fragment line-break link macro radio-target sub/superscript - target text-markup time-stamp)) + (table entity latex-fragment macro target text-markup) + (verse-block entity footnote-reference inline-babel-call inline-src-block + latex-fragment line-break link macro radio-target + sub/superscript target text-markup time-stamp)) "Alist of secondary strings restrictions. When parsed, some elements have a secondary string which could contain various objects (i.e. headline's name, or table's cells). -For association, the car is the element type, and the cdr a list -of successors that will be called in that secondary string. +For association, CAR is the element type, and CDR a list of +successors that will be called in that secondary string. Note: `keyword' secondary string type only applies to keywords matching `org-element-parsed-keywords'.") +(defconst org-element-secondary-value-alist + '((headline . :title) + (inlinetask . :title) + (item . :tag) + (footnote-reference . :inline-definition) + (verse-block . :value)) + "Alist between element types and location of secondary value. +Only elements with a secondary value available at parse time are +considered here. This is used internally by `org-element-map', +which will look into the secondary strings of an element only if +its type is listed here.") + ;;; Accessors ;; -;; Provide two accessors: `org-element-get-property' and -;; `org-element-get-contents'. -(defun org-element-get-property (property element) +;; Provide three accessors: `org-element-type', `org-element-property' +;; and `org-element-contents'. + +(defun org-element-type (element) + "Return type of element ELEMENT. + +The function returns the type of the element or object provided. +It can also return the following special value: + `plain-text' for a string + `org-data' for a complete document + nil in any other case." + (cond + ((not (consp element)) (and (stringp element) 'plain-text)) + ((symbolp (car element)) (car element)))) + +(defun org-element-property (property element) "Extract the value from the PROPERTY of an ELEMENT." (plist-get (nth 1 element) property)) -(defun org-element-get-contents (element) +(defun org-element-contents (element) "Extract contents from an ELEMENT." (nthcdr 2 element)) -;; Obtaining The Smallest Element Containing Point - -;; `org-element-at-point' is the core function of this section. It -;; returns the Lisp representation of the element at point. It uses -;; `org-element-guess-type' and `org-element-skip-keywords' as helper -;; functions. - -;; When point is at an item, there is no automatic way to determine if -;; the function should return the `plain-list' element, or the -;; corresponding `item' element. By default, `org-element-at-point' -;; works at the `plain-list' level. But, by providing an optional -;; argument, one can make it switch to the `item' level. -(defconst org-element--affiliated-re - (format "[ \t]*#\\+\\(%s\\):" - (mapconcat - (lambda (keyword) - (if (member keyword org-element-dual-keywords) - (format "\\(%s\\)\\(?:\\[\\(.*?\\)\\]\\)?" - (regexp-quote keyword)) - (regexp-quote keyword))) - org-element-affiliated-keywords "\\|")) - "Regexp matching any affiliated keyword. - -Keyword name is put in match group 1. Moreover, if keyword -belongs to `org-element-dual-keywords', put the dual value in -match group 2. - -Don't modify it, set `org-element--affiliated-keywords' instead.") - -(defun org-element-at-point (&optional toggle-item structure) - "Determine closest element around point. - -Return value is a list \(TYPE PROPS\) where TYPE is the type of -the element and PROPS a plist of properties associated to the +;;; Parsing Element Starting At Point + +;; `org-element-current-element' is the core function of this section. +;; It returns the Lisp representation of the element starting at +;; point. It uses `org-element--element-block-re' for quick access to +;; a common regexp. + +(defconst org-element--element-block-re + (format "[ \t]*#\\+begin_\\(%s\\)\\(?: \\|$\\)" + (mapconcat + 'regexp-quote + (mapcar 'car org-element-non-recursive-block-alist) "\\|")) + "Regexp matching the beginning of a non-recursive block type. +Used internally by `org-element-current-element'. Do not modify +it directly, set `org-element-recursive-block-alist' instead.") + +(defun org-element-current-element (&optional special structure) + "Parse the element starting at point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the element. Possible types are defined in `org-element-all-elements'. -If optional argument TOGGLE-ITEM is non-nil, parse item wise +Optional argument SPECIAL, when non-nil, can be either `item', +`section' or `quote-section'. `item' allows to parse item wise instead of plain-list wise, using STRUCTURE as the current list -structure. +structure. `section' (resp. `quote-section') will try to parse +a section (resp. a quote section) before anything else. + +If STRUCTURE isn't provided but SPECIAL is set to `item', it will +be computed. -If STRUCTURE isn't provided but TOGGLE-ITEM is non-nil, it will -be computed." +Unlike to `org-element-at-point', this function assumes point is +always at the beginning of the element it has to parse. As such, +it is quicker than its counterpart, albeit more restrictive." (save-excursion (beginning-of-line) - ;; Move before any blank line. - (when (looking-at "[ \t]*$") - (skip-chars-backward " \r\t\n") - (beginning-of-line)) + ;; If point is at an affiliated keyword, try moving to the + ;; beginning of the associated element. If none is found, the + ;; keyword is orphaned and will be treated as plain text. + (when (looking-at org-element--affiliated-re) + (let ((opoint (point))) + (while (looking-at org-element--affiliated-re) (forward-line)) + (when (looking-at "[ \t]*$") (goto-char opoint)))) (let ((case-fold-search t)) - ;; Check if point is at an affiliated keyword. In that case, - ;; try moving to the beginning of the associated element. If - ;; the keyword is orphaned, treat it as plain text. - (when (looking-at org-element--affiliated-re) - (let ((opoint (point))) - (while (looking-at org-element--affiliated-re) (forward-line)) - (when (looking-at "[ \t]*$") (goto-char opoint)))) - (let ((type (org-element-guess-type))) - (cond - ;; Guessing element type on the current line is impossible: - ;; try to find the beginning of the current element to get - ;; more information. - ((not type) - (let ((search-origin (point)) - (opoint-in-item-p (org-in-item-p)) - (par-found-p - (progn - (end-of-line) - (re-search-backward org-element-paragraph-separate nil 'm)))) - (cond - ;; Unable to find a paragraph delimiter above: we're at - ;; bob and looking at a paragraph. - ((not par-found-p) (org-element-paragraph-parser)) - ;; Trying to find element's beginning set point back to - ;; its original position. There's something peculiar on - ;; this line that prevents parsing, probably an - ;; ill-formed keyword or an undefined drawer name. Parse - ;; it as plain text anyway. - ((< search-origin (point-at-eol)) (org-element-paragraph-parser)) - ;; Original point wasn't in a list but previous paragraph - ;; is. It means that either point was inside some block, - ;; or current list was ended without using a blank line. - ;; In the last case, paragraph really starts at list end. - ((let (item) - (and (not opoint-in-item-p) - (not (looking-at "[ \t]*#\\+begin")) - (setq item (org-in-item-p)) - (let ((struct (save-excursion (goto-char item) - (org-list-struct)))) - (goto-char (org-list-get-bottom-point struct)) - (org-skip-whitespace) - (beginning-of-line) - (org-element-paragraph-parser))))) - ((org-footnote-at-definition-p) - (org-element-footnote-definition-parser)) - ((and opoint-in-item-p (org-at-item-p) (= opoint-in-item-p (point))) - (if toggle-item - (org-element-item-parser (or structure (org-list-struct))) - (org-element-plain-list-parser (or structure (org-list-struct))))) - ;; In any other case, the paragraph started the line - ;; below. - (t (forward-line) (org-element-paragraph-parser))))) - ((eq type 'plain-list) - (if toggle-item - (org-element-item-parser (or structure (org-list-struct))) - (org-element-plain-list-parser (or structure (org-list-struct))))) - ;; Straightforward case: call the appropriate parser. - (t (funcall (intern (format "org-element-%s-parser" type))))))))) - - -;; It is obvious to tell if point is in most elements, either by -;; looking for a specific regexp in the current line, or by using -;; already implemented functions. This is the goal of -;; `org-element-guess-type'. -(defconst org-element--element-block-types - (mapcar 'car org-element-non-recursive-block-alist) - "List of non-recursive block types, as strings. -Used internally by `org-element-guess-type'. Do not modify it -directly, set `org-element-non-recursive-block-alist' instead.") - -(defun org-element-guess-type () - "Return the type of element at point, or nil if undetermined. -This function may move point to an appropriate position for -parsing. Used internally by `org-element-at-point'." - ;; Beware: Order matters for some cases in that function. - (beginning-of-line) - (let ((case-fold-search t)) - (cond - ((org-with-limited-levels (org-at-heading-p)) 'headline) - ((let ((headline (ignore-errors (nth 4 (org-heading-components))))) - (and headline - (let (case-fold-search) - (string-match (format "^%s\\(?: \\|$\\)" org-quote-string) - headline)))) - 'quote-section) - ;; Non-recursive block. - ((let ((type (org-in-block-p org-element--element-block-types))) - (and type (cdr (assoc type org-element-non-recursive-block-alist))))) - ((org-at-heading-p) 'inlinetask) - ((org-between-regexps-p - "^[ \t]*\\\\begin{" "^[ \t]*\\\\end{[^}]*}[ \t]*") 'latex-environment) - ;; Property drawer. Almost `org-at-property-p', but allow drawer - ;; boundaries. - ((org-with-wide-buffer - (and (not (org-before-first-heading-p)) - (let ((pblock (org-get-property-block))) - (and pblock - (<= (point) (cdr pblock)) - (>= (point-at-eol) (1- (car pblock))))))) - 'property-drawer) - ;; Recursive block. If the block isn't complete, parse the - ;; current part as a paragraph. - ((looking-at "[ \t]*#\\+\\(begin\\|end\\)_\\([-A-Za-z0-9]+\\)\\(?:$\\|\\s-\\)") - (let ((type (downcase (match-string 2)))) - (cond - ((not (org-in-block-p (list type))) 'paragraph) - ((string= type "center") 'center-block) - ((string= type "quote") 'quote-block) - (t 'special-block)))) - ;; Regular drawers must be tested after property drawer as both - ;; elements share the same ending regexp. - ((or (looking-at org-drawer-regexp) (looking-at "[ \t]*:END:[ \t]*$")) - (let ((completep (org-between-regexps-p - org-drawer-regexp "^[ \t]*:END:[ \t]*$"))) - (if (not completep) - 'paragraph - (goto-char (car completep)) 'drawer))) - ((looking-at "[ \t]*:\\( \\|$\\)") 'fixed-width) - ;; Babel calls must be tested before general keywords as they are - ;; a subset of them. - ((looking-at org-babel-block-lob-one-liner-regexp) 'babel-call) - ((looking-at org-footnote-definition-re) 'footnote-definition) - ((looking-at "[ \t]*#\\+\\([a-z]+\\(:?_[a-z]+\\)*\\):") - (if (member (downcase (match-string 1)) org-element-affiliated-keywords) - 'paragraph - 'keyword)) - ;; Dynamic block: simplify regexp used for match. If it isn't - ;; complete, parse the current part as a paragraph. - ((looking-at "[ \t]*#\\+\\(begin\\end\\):\\(?:\\s-\\|$\\)") - (let ((completep (org-between-regexps-p - "^[ \t]*#\\+begin:\\(?:\\s-\\|$\\)" - "^[ \t]*#\\+end:\\(?:\\s-\\|$\\)"))) - (if (not completep) - 'paragraph - (goto-char (car completep)) 'dynamic-block))) - ((looking-at "\\(#\\|[ \t]*#\\+\\( \\|$\\)\\)") 'comment) - ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") 'horizontal-rule) - ((org-at-table-p t) 'table) - ((looking-at "[ \t]*#\\+tblfm:") - (forward-line -1) - ;; A TBLFM line separated from any table is just plain text. - (if (org-at-table-p) - 'table - (forward-line) 'paragraph)) - ((looking-at (org-item-re)) 'plain-list)))) + (cond + ;; Headline. + ((org-with-limited-levels (org-at-heading-p)) + (org-element-headline-parser)) + ;; Quote section. + ((eq special 'quote-section) (org-element-quote-section-parser)) + ;; Section. + ((eq special 'section) (org-element-section-parser)) + ;; Non-recursive block. + ((when (looking-at org-element--element-block-re) + (let ((type (downcase (match-string 1)))) + (if (save-excursion + (re-search-forward + (format "[ \t]*#\\+end_%s\\(?: \\|$\\)" type) nil t)) + ;; Build appropriate parser. + (funcall + (intern + (format "org-element-%s-parser" + (cdr (assoc type + org-element-non-recursive-block-alist))))) + (org-element-paragraph-parser))))) + ;; Inlinetask. + ((org-at-heading-p) (org-element-inlinetask-parser)) + ;; LaTeX Environment or paragraph if incomplete. + ((looking-at "^[ \t]*\\\\begin{") + (if (save-excursion + (re-search-forward "^[ \t]*\\\\end{[^}]*}[ \t]*" nil t)) + (org-element-latex-environment-parser) + (org-element-paragraph-parser))) + ;; Property drawer. + ((looking-at org-property-start-re) + (if (save-excursion (re-search-forward org-property-end-re nil t)) + (org-element-property-drawer-parser) + (org-element-paragraph-parser))) + ;; Recursive block, or paragraph if incomplete. + ((looking-at "[ \t]*#\\+begin_\\([-A-Za-z0-9]+\\)\\(?: \\|$\\)") + (let ((type (downcase (match-string 1)))) + (cond + ((not (save-excursion + (re-search-forward + (format "[ \t]*#\\+end_%s\\(?: \\|$\\)" type) nil t))) + (org-element-paragraph-parser)) + ((string= type "center") (org-element-center-block-parser)) + ((string= type "quote") (org-element-quote-block-parser)) + (t (org-element-special-block-parser))))) + ;; Drawer. + ((looking-at org-drawer-regexp) + (if (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)) + (org-element-drawer-parser) + (org-element-paragraph-parser))) + ((looking-at "[ \t]*:\\( \\|$\\)") (org-element-fixed-width-parser)) + ;; Babel call. + ((looking-at org-babel-block-lob-one-liner-regexp) + (org-element-babel-call-parser)) + ;; Keyword, or paragraph if at an affiliated keyword. + ((looking-at "[ \t]*#\\+\\([a-z]+\\(:?_[a-z]+\\)*\\):") + (let ((key (downcase (match-string 1)))) + (if (or (string= key "tblfm") + (member key org-element-affiliated-keywords)) + (org-element-paragraph-parser) + (org-element-keyword-parser)))) + ;; Footnote definition. + ((looking-at org-footnote-definition-re) + (org-element-footnote-definition-parser)) + ;; Dynamic block or paragraph if incomplete. + ((looking-at "[ \t]*#\\+begin:\\(?: \\|$\\)") + (if (save-excursion + (re-search-forward "^[ \t]*#\\+end:\\(?: \\|$\\)" nil t)) + (org-element-dynamic-block-parser) + (org-element-paragraph-parser))) + ;; Comment. + ((looking-at "\\(#\\|[ \t]*#\\+\\(?: \\|$\\)\\)") + (org-element-comment-parser)) + ;; Horizontal rule. + ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") + (org-element-horizontal-rule-parser)) + ;; Table. + ((org-at-table-p t) (org-element-table-parser)) + ;; List or item. + ((looking-at (org-item-re)) + (if (eq special 'item) + (org-element-item-parser (or structure (org-list-struct))) + (org-element-plain-list-parser (or structure (org-list-struct))))) + ;; Default element: Paragraph. + (t (org-element-paragraph-parser)))))) + ;; Most elements can have affiliated keywords. When looking for an ;; element beginning, we want to move before them, as they belong to @@ -2683,6 +2835,24 @@ (defun org-element-guess-type () ;; optional square brackets as the secondary one. ;; A keyword may belong to more than one category. + +(defconst org-element--affiliated-re + (format "[ \t]*#\\+\\(%s\\):" + (mapconcat + (lambda (keyword) + (if (member keyword org-element-dual-keywords) + (format "\\(%s\\)\\(?:\\[\\(.*\\)\\]\\)?" + (regexp-quote keyword)) + (regexp-quote keyword))) + org-element-affiliated-keywords "\\|")) + "Regexp matching any affiliated keyword. + +Keyword name is put in match group 1. Moreover, if keyword +belongs to `org-element-dual-keywords', put the dual value in +match group 2. + +Don't modify it, set `org-element-affiliated-keywords' instead.") + (defun org-element-collect-affiliated-keywords (&optional key-re trans-list consed parsed duals) "Collect affiliated keywords before point. @@ -2708,8 +2878,8 @@ (defun org-element-collect-affiliated-keywords (&optional key-re trans-list DUALS is a list of strings. Any keyword member of this list can have two parts: one mandatory and one optional. Its value is a cons cell whose car is the former, and the cdr the latter. If -a keyword is a member of both PARSED and DUALS, only the primary -part will be parsed. It defaults to `org-element-dual-keywords'. +a keyword is a member of both PARSED and DUALS, both values will +be parsed. It defaults to `org-element-dual-keywords'. Return a list whose car is the position at the first of them and cdr a plist of keywords and values." @@ -2720,6 +2890,9 @@ (defun org-element-collect-affiliated-keywords (&optional key-re trans-list (consed (or consed org-element-multiple-keywords)) (parsed (or parsed org-element-parsed-keywords)) (duals (or duals org-element-dual-keywords)) + ;; RESTRICT is the list of objects allowed in parsed + ;; keywords value. + (restrict (cdr (assq 'keyword org-element-string-restrictions))) output) (unless (bobp) (while (and (not (bobp)) @@ -2728,21 +2901,27 @@ (defun org-element-collect-affiliated-keywords (&optional key-re trans-list ;; Apply translation to RAW-KWD. From there, KWD is ;; the official keyword. (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd)) - ;; If KWD is a dual keyword, find it secondary value. - (dual-value (and (member kwd duals) - (org-match-string-no-properties 3))) ;; Find main value for any keyword. - (value (org-trim (buffer-substring-no-properties - (match-end 0) (point-at-eol)))) + (value + (save-match-data + (org-trim + (buffer-substring-no-properties + (match-end 0) (point-at-eol))))) + ;; If KWD is a dual keyword, find its secondary + ;; value. Maybe parse it. + (dual-value + (and (member kwd duals) + (let ((sec (org-match-string-no-properties 3))) + (if (or (not sec) (not (member kwd parsed))) sec + (org-element-parse-secondary-string sec restrict))))) ;; Attribute a property name to KWD. (kwd-sym (and kwd (intern (concat ":" kwd))))) ;; Now set final shape for VALUE. (when (member kwd parsed) - (setq value - (org-element-parse-secondary-string - value - (cdr (assq 'keyword org-element-string-restrictions))))) - (when (member kwd duals) (setq value (cons value dual-value))) + (setq value (org-element-parse-secondary-string value restrict))) + (when (member kwd duals) + ;; VALUE is mandatory. Set it to nil if there is none. + (setq value (and value (cons value dual-value)))) (when (member kwd consed) (setq value (cons value (plist-get output kwd-sym)))) ;; Eventually store the new value in OUTPUT. @@ -2763,9 +2942,8 @@ (defun org-element-collect-affiliated-keywords (&optional key-re trans-list ;; The (almost) almighty `org-element-map' allows to apply a function ;; on elements or objects matching some type, and accumulate the ;; resulting values. In an export situation, it also skips unneeded -;; parts of the parse tree, transparently walks into included files, -;; and maintain a list of local properties (i.e. those inherited from -;; parent headlines) for function's consumption. +;; parts of the parse tree. + (defun org-element-parse-buffer (&optional granularity visible-only) "Recursively parse the buffer and return structure. If narrowing is in effect, only parse the visible part of the @@ -2790,7 +2968,9 @@ (defun org-element-parse-buffer (&optional granularity visible-only) (nconc (list 'org-data nil) (org-element-parse-elements (point-at-bol) (point-max) - nil nil granularity visible-only nil)))) + ;; Start is section mode so text before the first headline + ;; belongs to a section. + 'section nil granularity visible-only nil)))) (defun org-element-parse-secondary-string (string restriction &optional buffer) "Recursively parse objects in STRING and return structure. @@ -2807,27 +2987,31 @@ (defun org-element-parse-secondary-string (string restriction &optional buffer) (insert string) (org-element-parse-objects (point-min) (point-max) nil restriction))) -(defun org-element-map (data types fun &optional info first-match) +(defun org-element-map (data types fun &optional info first-match no-recursion) "Map a function on selected elements or objects. DATA is the parsed tree, as returned by, i.e, `org-element-parse-buffer'. TYPES is a symbol or list of symbols of elements or objects types. FUN is the function called on the -matching element or object. It must accept two arguments: the -element or object itself and a plist holding contextual -information. +matching element or object. It must accept one arguments: the +element or object itself. When optional argument INFO is non-nil, it should be a plist holding export options. In that case, parts of the parse tree -not exportable according to that property list will be skipped -and files included through a keyword will be visited. +not exportable according to that property list will be skipped. When optional argument FIRST-MATCH is non-nil, stop at the first match for which FUN doesn't return nil, and return that value. -Nil values returned from FUN are ignored in the result." - ;; Ensure TYPES is a list, even of one element. +Optional argument NO-RECURSION is a symbol or a list of symbols +representing elements or objects types. `org-element-map' won't +enter any recursive element or object whose type belongs to that +list. Though, FUN can still be applied on them. + +Nil values returned from FUN do not appear in the results." + ;; 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 (cond @@ -2838,117 +3022,89 @@ (defun org-element-map (data types fun &optional info first-match) always (memq type org-element-all-elements)) 'elements) (t 'objects))) - walk-tree ; For byte-compiler + ;; --RESTRICTS is a list of element types whose secondary + ;; string could possibly contain an object with a type among + ;; TYPES. + (--restricts + (and (eq --category 'objects) + (loop for el in org-element-secondary-value-alist + when + (loop for o in types + thereis + (memq o (cdr + (assq (car el) + org-element-string-restrictions)))) + collect (car el)))) --acc - (accumulate-maybe - (function - (lambda (--type types fun --blob --local) - ;; Check if TYPE is matching among TYPES. If so, apply - ;; FUN to --BLOB and accumulate return value - ;; into --ACC. --LOCAL is the communication channel. - (when (memq --type types) - (let ((result (funcall fun --blob --local))) - (cond ((not result)) - (first-match (throw 'first-match result)) - (t (push result --acc)))))))) - (walk-tree + (--walk-tree (function - (lambda (--data --local) - ;; Recursively walk DATA. --LOCAL, if non-nil, is + (lambda (--data) + ;; Recursively walk DATA. INFO, if non-nil, is ;; a plist holding contextual information. (mapc (lambda (--blob) - (let ((--type (if (stringp --blob) 'plain-text (car --blob)))) - ;; Determine if a recursion into --BLOB is - ;; possible and allowed. - (cond - ;; Element or object not exportable. - ((and info (org-export-skip-p --blob info))) - ;; Archived headline: Maybe apply fun on it, but - ;; skip contents. - ((and info - (eq --type 'headline) - (eq (plist-get info :with-archived-trees) 'headline) - (org-element-get-property :archivedp --blob)) - (funcall accumulate-maybe --type types fun --blob --local)) - ;; At an include keyword: apply mapping to its - ;; contents. - ((and --local - (eq --type 'keyword) - (string= - (downcase (org-element-get-property :key --blob)) - "include")) - (funcall accumulate-maybe --type types fun --blob --local) - (let* ((--data - (org-export-parse-included-file --blob --local)) - (--value (org-element-get-property :value --blob)) - (--file - (and (string-match "^\"\\(\\S-+\\)\"" --value) - (match-string 1 --value)))) + (unless (and info (member --blob (plist-get info :ignore-list))) + (let ((--type (org-element-type --blob))) + ;; Check if TYPE is matching among TYPES. If so, + ;; apply FUN to --BLOB and accumulate return value + ;; into --ACC (or exit if FIRST-MATCH is non-nil). + (when (memq --type types) + (let ((result (funcall fun --blob))) + (cond ((not result)) + (first-match (throw 'first-match result)) + (t (push result --acc))))) + ;; If --BLOB has a secondary string that can + ;; contain objects with their type among TYPES, + ;; look into that string. + (when (memq --type --restricts) (funcall - walk-tree --data - (org-combine-plists - --local - ;; Store full path of already included files - ;; to avoid recursive file inclusion. - `(:included-files - ,(cons (expand-file-name --file) - (plist-get --local :included-files)) - ;; Ensure that a top-level headline in the - ;; included file becomes a direct child of - ;; the current headline in the buffer. - :headline-offset - ,(- (+ (plist-get - (plist-get --local :inherited-properties) - :level) - (or (plist-get --local :headline-offset) 0)) - (1- (org-export-get-min-level - --data --local)))))))) - ;; Limiting recursion to greater elements, and --BLOB - ;; isn't one. - ((and (eq --category 'greater-elements) - (not (memq --type org-element-greater-elements))) - (funcall accumulate-maybe --type types fun --blob --local)) - ;; Limiting recursion to elements, and --BLOB only - ;; contains objects. - ((and (eq --category 'elements) (eq --type 'paragraph))) - ;; No limitation on recursion, but --BLOB hasn't - ;; got a recursive type. - ((and (eq --category 'objects) - (not (or (eq --type 'paragraph) - (memq --type org-element-greater-elements) - (memq --type org-element-recursive-objects)))) - (funcall accumulate-maybe --type types fun --blob --local)) - ;; Recursion is possible and allowed: Update local - ;; information and move into --BLOB. - (t (funcall accumulate-maybe --type types fun --blob --local) - (funcall - walk-tree --blob - (and info (org-export-update-info --blob --local t))))))) - (org-element-get-contents --data)))))) + --walk-tree + `(org-data + nil + ,@(org-element-property + (cdr (assq --type org-element-secondary-value-alist)) + --blob)))) + ;; Now determine if a recursion into --BLOB is + ;; possible. If so, do it. + (unless (memq --type no-recursion) + (when (or (and (memq --type org-element-greater-elements) + (not (eq --category 'greater-elements))) + (and (memq --type org-element-all-elements) + (not (eq --category 'elements))) + (memq --type org-element-recursive-objects)) + (funcall --walk-tree --blob)))))) + (org-element-contents --data)))))) (catch 'first-match - (funcall walk-tree data info) + (funcall --walk-tree data) ;; Return value in a proper order. (reverse --acc)))) -;; The following functions are internal parts of the parser. The -;; first one, `org-element-parse-elements' acts at the element's -;; level. The second one, `org-element-parse-objects' applies on all -;; objects of a paragraph or a secondary string. It uses +;; The following functions are internal parts of the parser. + +;; The first one, `org-element-parse-elements' acts at the element's +;; level. + +;; The second one, `org-element-parse-objects' applies on all objects +;; of a paragraph or a secondary string. It uses ;; `org-element-get-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). -(defun org-element-parse-elements (beg end item structure granularity visible-only acc) - "Parse ELEMENT with point at its beginning. -If ITEM is non-nil, parse item wise instead of plain-list wise, -using STRUCTURE as the current list structure. +(defun org-element-parse-elements + (beg end special structure granularity visible-only acc) + "Parse elements between BEG and END positions. + +SPECIAL prioritize some elements over the others. It can set to +`quote-section', `section' or `item', which will focus search, +respectively, on quote sections, sections and items. Moreover, +when value is `item', STRUCTURE will be used as the current list +structure. GRANULARITY determines the depth of the recursion. It can be set to the following symbols: @@ -2960,85 +3116,70 @@ (defun org-element-parse-elements (beg end item structure granularity visible-on `object' or nil Parse the complete buffer. When VISIBLE-ONLY is non-nil, don't parse contents of hidden -greater elements. +elements. Elements are accumulated into ACC." (save-excursion - (goto-char beg) - ;; Shortcut when parsing only headlines. + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + ;; When parsing only headlines, skip any text before first one. (when (and (eq granularity 'headline) (not (org-at-heading-p))) (org-with-limited-levels (outline-next-heading))) ;; Main loop start. - (while (and (< (point) end) (not (eobp))) + (while (not (eobp)) (push - ;; 1. If ITEM is toggled, point is at an item. Knowing that, - ;; there's no need to go through `org-element-at-point'. - (if item - (let* ((element (org-element-item-parser structure)) - (cbeg (org-element-get-property :contents-begin element)) - (cend (org-element-get-property :contents-end element))) - (goto-char (org-element-get-property :end element)) - ;; Narrow region to contents, so that item bullet don't - ;; interfere with paragraph parsing. - (save-restriction - (narrow-to-region cbeg cend) - (org-element-parse-elements - cbeg cend nil structure granularity visible-only - (reverse element)))) + ;; 1. Item mode is active: point must be at an item. Parse it + ;; directly, skipping `org-element-current-element'. + (if (eq special 'item) + (let ((element (org-element-item-parser structure))) + (goto-char (org-element-property :end element)) + (org-element-parse-elements + (org-element-property :contents-begin element) + (org-element-property :contents-end element) + nil structure granularity visible-only (reverse element))) ;; 2. When ITEM is nil, find current element's type and parse ;; it accordingly to its category. - (let ((element (org-element-at-point nil structure))) - (goto-char (org-element-get-property :end element)) + (let* ((element (org-element-current-element special structure)) + (type (org-element-type element))) + (goto-char (org-element-property :end element)) (cond - ;; Case 1: ELEMENT is a footnote-definition. If - ;; GRANURALITY allows parsing, use narrowing so that - ;; footnote label don't interfere with paragraph - ;; recognition. - ((and (eq (car element) 'footnote-definition) - (not (memq granularity '(headline greater-element)))) - (let ((cbeg (org-element-get-property :contents-begin element)) - (cend (org-element-get-property :contents-end element))) - (save-restriction - (narrow-to-region cbeg cend) - (org-element-parse-elements - cbeg cend nil structure granularity visible-only - (reverse element))))) - ;; Case 1: ELEMENT is a paragraph. Parse objects inside, - ;; if GRANULARITY allows it. - ((and (eq (car element) 'paragraph) + ;; Case 1. ELEMENT is a paragraph. Parse objects inside, + ;; if GRANULARITY allows it. + ((and (eq type 'paragraph) (or (not granularity) (eq granularity 'object))) (org-element-parse-objects - (org-element-get-property :contents-begin element) - (org-element-get-property :contents-end element) - (reverse element) - nil)) - ;; Case 2: ELEMENT is recursive: parse it between - ;; `contents-begin' and `contents-end'. If it's - ;; a plain list, also switch to item mode. Make - ;; sure GRANULARITY allows the recursion, or - ;; ELEMENT is an headline, in which case going - ;; inside is mandatory, in order to get sub-level - ;; headings. If VISIBLE-ONLY is true and element - ;; is hidden, do not recurse into it. - ((and (memq (car element) org-element-greater-elements) + (org-element-property :contents-begin element) + (org-element-property :contents-end element) + (reverse element) nil)) + ;; Case 2. ELEMENT is recursive: parse it between + ;; `contents-begin' and `contents-end'. Make sure + ;; GRANULARITY allows the recursion, or ELEMENT is an + ;; headline, in which case going inside is mandatory, in + ;; order to get sub-level headings. If VISIBLE-ONLY is + ;; true and element is hidden, do not recurse into it. + ((and (memq type org-element-greater-elements) (or (not granularity) (memq granularity '(element object)) - (eq (car element) 'headline)) + (eq type 'headline)) (not (and visible-only - (org-element-get-property :hiddenp element)))) + (org-element-property :hiddenp element)))) (org-element-parse-elements - (org-element-get-property :contents-begin element) - (org-element-get-property :contents-end element) - (eq (car element) 'plain-list) - (org-element-get-property :structure element) - granularity - visible-only - (reverse element))) - ;; Case 3: Else, just accumulate ELEMENT, unless - ;; GRANULARITY is set to `headline'. - ((not (eq granularity 'headline)) element)))) - acc) - (org-skip-whitespace)) + (org-element-property :contents-begin element) + (org-element-property :contents-end element) + ;; At a plain list, switch to item mode. At an + ;; headline, switch to section mode. Any other + ;; element turns off special modes. + (case type + (plain-list 'item) + (headline (if (org-element-property :quotedp element) + 'quote-section + 'section))) + (org-element-property :structure element) + granularity visible-only (reverse element))) + ;; Case 3. Else, just accumulate ELEMENT. + (t element)))) + acc))) ;; Return result. (nreverse acc))) @@ -3066,13 +3207,16 @@ (defun org-element-parse-objects (beg end acc restriction) (while (setq candidates (org-element-get-next-object-candidates end restriction candidates)) (setq next-object (funcall get-next-object candidates)) - ;; 1. Text before any object. - (let ((obj-beg (org-element-get-property :begin next-object))) - (unless (= beg obj-beg) - (push (buffer-substring-no-properties (point) obj-beg) acc))) + ;; 1. Text before any object. Untabify it. + (let ((obj-beg (org-element-property :begin next-object))) + (unless (= (point) obj-beg) + (push (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) obj-beg)) + acc))) ;; 2. Object... - (let ((obj-end (org-element-get-property :end next-object)) - (cont-beg (org-element-get-property :contents-begin next-object))) + (let ((obj-end (org-element-property :end next-object)) + (cont-beg (org-element-property :contents-begin next-object))) (push (if (and (memq (car next-object) org-element-recursive-objects) cont-beg) ;; ... recursive. The CONT-BEG check is for @@ -3081,7 +3225,7 @@ (defun org-element-parse-objects (beg end acc restriction) (save-restriction (narrow-to-region cont-beg - (org-element-get-property :contents-end next-object)) + (org-element-property :contents-end next-object)) (org-element-parse-objects (point-min) (point-max) (reverse next-object) ;; Restrict allowed objects. This is the @@ -3090,19 +3234,20 @@ (defun org-element-parse-objects (beg end acc restriction) (let ((new-restr (cdr (assq (car next-object) org-element-object-restrictions)))) - (if (not restriction) - new-restr - (delq nil - (mapcar (lambda (e) - (and (memq e restriction) e)) - new-restr)))))) + (if (not restriction) new-restr + (delq nil (mapcar + (lambda (e) (and (memq e restriction) e)) + new-restr)))))) ;; ... not recursive. next-object) acc) (goto-char obj-end))) - ;; 3. Text after last object. + ;; 3. Text after last object. Untabify it. (unless (= (point) end) - (push (buffer-substring-no-properties (point) end) acc)) + (push (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) end)) + acc)) ;; Result. (nreverse acc)))) @@ -3123,13 +3268,11 @@ (defun org-element-get-next-object-candidates (limit restriction objects) ;; If no previous result, search every object type in RESTRICTION. ;; Otherwise, keep potential candidates (old objects located after ;; point) and ask to search again those which had matched before. - (if objects - (mapc (lambda (obj) - (if (< (cdr obj) (point)) - (push (car obj) types-to-search) - (push obj next-candidates))) - objects) - (setq types-to-search restriction)) + (if (not objects) (setq types-to-search restriction) + (mapc (lambda (obj) + (if (< (cdr obj) (point)) (push (car obj) types-to-search) + (push obj next-candidates))) + objects)) ;; Call the appropriate "get-next" function for each type to ;; search and accumulate matches. (mapc @@ -3160,6 +3303,7 @@ (defun org-element-get-next-object-candidates (limit restriction objects) ;; ;; Both functions rely internally on ;; `org-element-interpret--affiliated-keywords'. + (defun org-element-interpret-data (data &optional genealogy previous) "Interpret a parse tree representing Org data. @@ -3180,10 +3324,9 @@ (defun org-element-interpret-data (data &optional genealogy previous) ((equal blob "") nil) ((stringp blob) blob) (t - (let* ((type (car blob)) + (let* ((type (org-element-type blob)) (interpreter - (if (eq type 'org-data) - 'identity + (if (eq type 'org-data) 'identity (intern (format "org-element-%s-interpreter" type)))) (contents (cond @@ -3221,12 +3364,11 @@ (defun org-element-interpret-data (data &optional genealogy previous) (concat (org-element-interpret--affiliated-keywords blob) (org-element-normalize-string results) - (make-string (org-element-get-property :post-blank blob) 10))) + (make-string (org-element-property :post-blank blob) 10))) (t (concat results - (make-string - (org-element-get-property :post-blank blob) 32)))))))) - (org-element-get-contents data) "")) + (make-string (org-element-property :post-blank blob) 32)))))))) + (org-element-contents data) "")) (defun org-element-interpret-secondary (secondary) "Interpret SECONDARY string as Org syntax. @@ -3257,7 +3399,7 @@ (defun org-element-interpret--affiliated-keywords (element) "\n")))))) (mapconcat (lambda (key) - (let ((value (org-element-get-property (intern (concat ":" key)) element))) + (let ((value (org-element-property (intern (concat ":" key)) element))) (when value (if (member key org-element-multiple-keywords) (mapconcat (lambda (line) @@ -3283,6 +3425,7 @@ (defun org-element-interpret--affiliated-keywords (element) ;; ;; The second function, `org-element-normalize-contents', removes ;; global indentation from the contents of the current element. + (defun org-element-normalize-string (s) "Ensure string S ends with a single newline character. @@ -3300,63 +3443,178 @@ (defun org-element-normalize-contents (element &optional ignore-first) ELEMENT must only contain plain text and objects. -The following changes are applied to plain text: - - Remove global indentation, preserving relative one. - - Untabify it. - If optional argument IGNORE-FIRST is non-nil, ignore first line's indentation to compute maximal common indentation. -Return the normalized element." - (nconc - (list (car element) (nth 1 element)) - (let ((contents (org-element-get-contents element))) - (cond - ((and (not ignore-first) (not (stringp (car contents)))) contents) - (t - (catch 'exit - ;; 1. Remove tabs from each string in CONTENTS. Get maximal - ;; common indentation (MCI) along the way. - (let* ((ind-list (unless ignore-first - (list (org-get-string-indentation (car contents))))) - (contents - (mapcar (lambda (object) - (if (not (stringp object)) - object - (let ((start 0) - (object (org-remove-tabs object))) - (while (string-match "\n\\( *\\)" object start) - (setq start (match-end 0)) - (push (length (match-string 1 object)) - ind-list)) - object))) - contents)) - (mci (if ind-list - (apply 'min ind-list) - (throw 'exit contents)))) - ;; 2. Remove that indentation from CONTENTS. First string - ;; must be treated differently because it's the only one - ;; whose indentation doesn't happen after a newline - ;; character. - (let ((first-obj (car contents))) - (unless (or (not (stringp first-obj)) ignore-first) - (setq contents - (cons (replace-regexp-in-string - (format "\\` \\{%d\\}" mci) "" first-obj) - (cdr contents))))) - (mapcar (lambda (object) - (if (not (stringp object)) - object - (replace-regexp-in-string - (format "\n \\{%d\\}" mci) "\n" object))) - contents)))))))) +Return the normalized element that is element with global +indentation removed from its contents. The function assumes that +indentation is not done with TAB characters." + (let (ind-list + (collect-inds + (function + ;; Return list of indentations within BLOB. This is done by + ;; walking recursively BLOB and updating IND-LIST 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. + (lambda (blob first-flag) + (mapc + (lambda (object) + (when (and first-flag (stringp object)) + (setq first-flag nil) + (string-match "\\`\\( *\\)" object) + (let ((len (length (match-string 1 object)))) + ;; An indentation of zero means no string will be + ;; modified. Quit the process. + (if (zerop len) (throw 'zero (setq ind-list nil)) + (push len ind-list)))) + (cond + ((stringp object) + (let ((start 0)) + (while (string-match "\n\\( *\\)" object start) + (setq start (match-end 0)) + (push (length (match-string 1 object)) ind-list)))) + ((memq (org-element-type object) org-element-recursive-objects) + (funcall collect-inds object first-flag)))) + (org-element-contents blob)))))) + ;; Collect indentation list in ELEMENT. Possibly remove first + ;; value if IGNORE-FIRST is non-nil. + (catch 'zero (funcall collect-inds element (not ignore-first))) + (if (not ind-list) element + ;; Build ELEMENT back, replacing each string with the same + ;; string minus common indentation. + (let ((build + (function + (lambda (blob mci first-flag) + ;; Return BLOB with all its strings indentation + ;; shortened from MCI white spaces. FIRST-FLAG is + ;; non-nil when the first string hasn't been seen + ;; yet. + (nconc + (list (org-element-type blob) (nth 1 blob)) + (mapcar + (lambda (object) + (when (and first-flag (stringp object)) + (setq first-flag nil) + (setq object + (replace-regexp-in-string + (format "\\` \\{%d\\}" mci) "" object))) + (cond + ((stringp object) + (replace-regexp-in-string + (format "\n \\{%d\\}" mci) "\n" object)) + ((memq (org-element-type object) org-element-recursive-objects) + (funcall build object mci first-flag)) + (t object))) + (org-element-contents blob))))))) + (funcall build element (apply 'min ind-list) (not ignore-first)))))) ;;; The Toolbox -;; Once the structure of an Org file is well understood, it's easy to -;; implement some replacements for `forward-paragraph' +;; 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 +;; `org-element-current-element' until the container is found. + +(defun org-element-at-point (&optional keep-trail) + "Determine closest element around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. Possible types are defined in +`org-element-all-elements'. + +As a special case, if point is at the very beginning of a list or +sub-list, element returned will be that list instead of the first +item. + +If optional argument KEEP-TRAIL is non-nil, the function returns +a list of of elements leading to element at point. The list's +CAR is always the element at point. Its last item will be the +element's parent, unless element was either the first in its +section (in which case the last item in the list is the first +element of section) or an headline (in which case the list +contains that headline as its single element). Elements +in-between, if any, are siblings of the element at point." + (org-with-wide-buffer + ;; If at an headline, parse it. It is the sole element that + ;; doesn't require to know about context. + (if (org-with-limited-levels (org-at-heading-p)) + (if (not keep-trail) (org-element-headline-parser) + (list (org-element-headline-parser))) + ;; Otherwise move at the beginning of the section containing + ;; point. + (let ((origin (point)) element type item-flag trail struct prevs) + (org-with-limited-levels + (if (org-before-first-heading-p) (goto-char (point-min)) + (org-back-to-heading) + (forward-line))) + (org-skip-whitespace) + (beginning-of-line) + ;; Starting parsing successively each element with + ;; `org-element-current-element'. Skip those ending before + ;; original position. + (catch 'exit + (while t + (setq element (org-element-current-element item-flag struct) + type (car element)) + (when keep-trail (push element trail)) + (cond + ;; 1. Skip any element ending before point or at point. + ((let ((end (org-element-property :end element))) + (when (<= end origin) + (if (> (point-max) end) (goto-char end) + (throw 'exit (or trail element)))))) + ;; 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 a plain list. + ((eq type 'plain-list) + (setq struct (org-element-property :structure element) + prevs (or prevs (org-list-prevs-alist struct))) + (let ((beg (org-element-property :contents-begin element))) + (if (= beg origin) (throw 'exit (or trail element)) + ;; Find the item at this level containing ORIGIN. + (let ((items (org-list-get-all-items beg struct prevs))) + (let (parent) + (catch 'local + (mapc + (lambda (pos) + (cond + ;; Item ends before point: skip it. + ((<= (org-list-get-item-end pos struct) origin)) + ;; Item contains point: store is in PARENT. + ((<= pos origin) (setq parent pos)) + ;; We went too far: return PARENT. + (t (throw 'local nil)))) items)) + ;; No parent: no item contained point, though + ;; the plain list does. Point is in the blank + ;; lines after the list: return plain list. + (if (not parent) (throw 'exit (or trail element)) + (setq item-flag 'item) + (goto-char parent))))))) + ;; 4. At any other greater element type, if point is + ;; within contents, move into it. Otherwise, return + ;; that element. + (t + (when (eq type 'item) (setq item-flag nil)) + (let ((beg (org-element-property :contents-begin element)) + (end (org-element-property :contents-end element))) + (if (or (> beg origin) (< end origin)) + (throw 'exit (or trail element)) + ;; Reset trail, since we found a parent. + (when keep-trail (setq trail (list element))) + (narrow-to-region beg end) + (goto-char beg))))))))))) + + +;; Once the local structure around point is well understood, it's easy +;; to implement some replacements for `forward-paragraph' ;; `backward-paragraph', namely `org-element-forward' and ;; `org-element-backward'. @@ -3372,12 +3630,13 @@ (defun org-element-normalize-contents (element &optional ignore-first) ;; `org-element-nested-p' and `org-element-swap-A-B' are used ;; internally by some of the previously cited tools. + (defsubst org-element-nested-p (elem-A elem-B) "Non-nil when elements ELEM-A and ELEM-B are nested." - (let ((beg-A (org-element-get-property :begin elem-A)) - (beg-B (org-element-get-property :begin elem-B)) - (end-A (org-element-get-property :end elem-A)) - (end-B (org-element-get-property :end elem-B))) + (let ((beg-A (org-element-property :begin elem-A)) + (beg-B (org-element-property :begin elem-B)) + (end-A (org-element-property :end elem-A)) + (end-B (org-element-property :end elem-B))) (or (and (>= beg-A beg-B) (<= end-A end-B)) (and (>= beg-B beg-A) (<= end-B end-A))))) @@ -3387,16 +3646,16 @@ (defun org-element-swap-A-B (elem-A elem-B) Leave point at the end of ELEM-A. Assume ELEM-A is before ELEM-B and that they are not nested." - (goto-char (org-element-get-property :begin elem-A)) - (let* ((beg-B (org-element-get-property :begin elem-B)) + (goto-char (org-element-property :begin elem-A)) + (let* ((beg-B (org-element-property :begin elem-B)) (end-B-no-blank (save-excursion - (goto-char (org-element-get-property :end elem-B)) + (goto-char (org-element-property :end elem-B)) (skip-chars-backward " \r\t\n") (forward-line) (point))) - (beg-A (org-element-get-property :begin elem-A)) + (beg-A (org-element-property :begin elem-A)) (end-A-no-blank (save-excursion - (goto-char (org-element-get-property :end elem-A)) + (goto-char (org-element-property :end elem-A)) (skip-chars-backward " \r\t\n") (forward-line) (point))) @@ -3405,50 +3664,39 @@ (defun org-element-swap-A-B (elem-A elem-B) (between-A-B (buffer-substring end-A-no-blank beg-B))) (delete-region beg-A end-B-no-blank) (insert body-B between-A-B body-A) - (goto-char (org-element-get-property :end elem-B)))) + (goto-char (org-element-property :end elem-B)))) (defun org-element-backward () - "Move backward by one element." + "Move backward by one element. +Move to the previous element at the same level, when possible." (interactive) - (let* ((opoint (point)) - (element (org-element-at-point)) - (start-el-beg (org-element-get-property :begin element))) - ;; At an headline. The previous element is the previous sibling, - ;; or the parent if any. - (cond - ;; Already at the beginning of the current element: move to the - ;; beginning of the previous one. - ((= opoint start-el-beg) - (forward-line -1) - (skip-chars-backward " \r\t\n") - (let* ((prev-element (org-element-at-point)) - (itemp (org-in-item-p)) - (struct (and itemp - (save-excursion (goto-char itemp) - (org-list-struct))))) - ;; When moving into a new list, go directly at the - ;; beginning of the top list structure. - (if (and itemp (<= (org-list-get-bottom-point struct) opoint)) - (progn - (goto-char (org-list-get-top-point struct)) - (goto-char (org-element-get-property - :begin (org-element-at-point)))) - (goto-char (org-element-get-property :begin prev-element)))) - (while (org-truely-invisible-p) (org-element-up))) - ;; Else, move at the element beginning. One exception: if point - ;; was in the blank lines after the end of a list, move directly - ;; to the top item. - (t - (let (struct itemp) - (if (and (setq itemp (org-in-item-p)) - (<= (org-list-get-bottom-point - (save-excursion (goto-char itemp) - (setq struct (org-list-struct)))) - opoint)) - (progn (goto-char (org-list-get-top-point struct)) - (goto-char (org-element-get-property - :begin (org-element-at-point)))) - (goto-char start-el-beg))))))) + (if (save-excursion (skip-chars-backward " \r\t\n") (bobp)) + (error "Cannot move further up") + (let* ((trail (org-element-at-point 'keep-trail)) + (element (car trail)) + (beg (org-element-property :begin element))) + ;; Move to beginning of current element if point isn't there. + (if (/= (point) beg) (goto-char beg) + (let ((type (org-element-type element))) + (cond + ;; At an headline: move to previous headline at the same + ;; level, a parent, or BOB. + ((eq type 'headline) + (let ((dest (save-excursion (org-backward-same-level 1) (point)))) + (if (= (point-min) dest) (error "Cannot move further up") + (goto-char dest)))) + ;; At an item: try to move to the previous item, if any. + ((and (eq type 'item) + (let* ((struct (org-element-property :structure element)) + (prev (org-list-get-prev-item + beg struct (org-list-prevs-alist struct)))) + (when prev (goto-char prev))))) + ;; In any other case, find the previous element in the + ;; trail and move to its beginning. If no previous element + ;; can be found, move to headline. + (t (let ((prev (nth 1 trail))) + (if prev (goto-char (org-element-property :begin prev)) + (org-back-to-heading)))))))))) (defun org-element-drag-backward () "Drag backward element at point." @@ -3458,9 +3706,9 @@ (defun org-element-drag-backward () (when (= (progn (goto-char (point-min)) (org-skip-whitespace) (point-at-bol)) - (org-element-get-property :end elem)) + (org-element-property :end elem)) (error "Cannot drag element backward")) - (goto-char (org-element-get-property :begin elem)) + (goto-char (org-element-property :begin elem)) (org-element-backward) (let ((prev-elem (org-element-at-point))) (when (or (org-element-nested-p elem prev-elem) @@ -3470,8 +3718,8 @@ (defun org-element-drag-backward () (error "Cannot drag element backward")) ;; Compute new position of point: it's shifted by PREV-ELEM ;; body's length. - (let ((size-prev (- (org-element-get-property :end prev-elem) - (org-element-get-property :begin prev-elem)))) + (let ((size-prev (- (org-element-property :end prev-elem) + (org-element-property :begin prev-elem)))) (org-element-swap-A-B prev-elem elem) (goto-char (- pos size-prev)))))) @@ -3480,9 +3728,9 @@ (defun org-element-drag-forward () (interactive) (let* ((pos (point)) (elem (org-element-at-point))) - (when (= (point-max) (org-element-get-property :end elem)) + (when (= (point-max) (org-element-property :end elem)) (error "Cannot drag element forward")) - (goto-char (org-element-get-property :end elem)) + (goto-char (org-element-property :end elem)) (let ((next-elem (org-element-at-point))) (when (or (org-element-nested-p elem next-elem) (and (eq (car next-elem) 'headline) @@ -3493,14 +3741,14 @@ (defun org-element-drag-forward () ;; body's length (without final blanks) and by the length of ;; blanks between ELEM and NEXT-ELEM. (let ((size-next (- (save-excursion - (goto-char (org-element-get-property :end next-elem)) + (goto-char (org-element-property :end next-elem)) (skip-chars-backward " \r\t\n") (forward-line) (point)) - (org-element-get-property :begin next-elem))) - (size-blank (- (org-element-get-property :end elem) + (org-element-property :begin next-elem))) + (size-blank (- (org-element-property :end elem) (save-excursion - (goto-char (org-element-get-property :end elem)) + (goto-char (org-element-property :end elem)) (skip-chars-backward " \r\t\n") (forward-line) (point))))) @@ -3508,37 +3756,41 @@ (defun org-element-drag-forward () (goto-char (+ pos size-next size-blank)))))) (defun org-element-forward () - "Move forward by one element." + "Move forward by one element. +Move to the next element at the same level, when possible." (interactive) - (beginning-of-line) - (cond ((eobp) (error "Cannot move further down")) - ((looking-at "[ \t]*$") - (org-skip-whitespace) - (goto-char (if (eobp) (point) (point-at-bol)))) - (t - (let ((element (org-element-at-point t)) - (origin (point))) - (cond - ;; At an item: Either move to the next element inside, or - ;; to its end if it's hidden. - ((eq (car element) 'item) - (if (org-element-get-property :hiddenp element) - (goto-char (org-element-get-property :end element)) - (end-of-line) - (re-search-forward org-element-paragraph-separate nil t) - (org-skip-whitespace) - (beginning-of-line))) - ;; At a recursive element: Either move inside, or if it's - ;; hidden, move to its end. - ((memq (car element) org-element-greater-elements) - (let ((cbeg (org-element-get-property :contents-begin element))) - (goto-char - (if (or (org-element-get-property :hiddenp element) - (> origin cbeg)) - (org-element-get-property :end element) - cbeg)))) - ;; Else: move to the current element's end. - (t (goto-char (org-element-get-property :end element)))))))) + (if (eobp) (error "Cannot move further down") + (let* ((trail (org-element-at-point 'keep-trail)) + (element (car trail)) + (type (org-element-type element)) + (end (org-element-property :end element))) + (cond + ;; At an headline, move to next headline at the same level. + ((eq type 'headline) (goto-char end)) + ;; At an item. Move to the next item, if possible. + ((and (eq type 'item) + (let* ((struct (org-element-property :structure element)) + (prevs (org-list-prevs-alist struct)) + (beg (org-element-property :begin element)) + (next-item (org-list-get-next-item beg struct prevs))) + (when next-item (goto-char next-item))))) + ;; In any other case, move to element's end, unless this + ;; position is also the end of its parent's contents, in which + ;; case, directly jump to parent's end. + (t + (let ((parent + ;; Determine if TRAIL contains the real parent of ELEMENT. + (and (> (length trail) 1) + (let* ((parent-candidate (car (last trail)))) + (and (memq (org-element-type parent-candidate) + org-element-greater-elements) + (>= (org-element-property + :contents-end parent-candidate) end) + parent-candidate))))) + (cond ((not parent) (goto-char end)) + ((= (org-element-property :contents-end parent) end) + (goto-char (org-element-property :end parent))) + (t (goto-char end))))))))) (defun org-element-mark-element () "Put point at beginning of this element, mark at end. @@ -3553,11 +3805,11 @@ (defun org-element-mark-element () (set-mark (save-excursion (goto-char (mark)) - (goto-char (org-element-get-property :end (org-element-at-point))))) + (goto-char (org-element-property :end (org-element-at-point))))) (let ((element (org-element-at-point))) (end-of-line) - (push-mark (org-element-get-property :end element) t t) - (goto-char (org-element-get-property :begin element)))))) + (push-mark (org-element-property :end element) t t) + (goto-char (org-element-property :begin element)))))) (defun org-narrow-to-element () "Narrow buffer to current element." @@ -3566,16 +3818,16 @@ (defun org-narrow-to-element () (cond ((eq (car elem) 'headline) (narrow-to-region - (org-element-get-property :begin elem) - (org-element-get-property :end elem))) + (org-element-property :begin elem) + (org-element-property :end elem))) ((memq (car elem) org-element-greater-elements) (narrow-to-region - (org-element-get-property :contents-begin elem) - (org-element-get-property :contents-end elem))) + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem))) (t (narrow-to-region - (org-element-get-property :begin elem) - (org-element-get-property :end elem)))))) + (org-element-property :begin elem) + (org-element-property :end elem)))))) (defun org-transpose-elements () "Transpose current and previous elements, keeping blank lines between. @@ -3587,9 +3839,9 @@ (defun org-transpose-elements () (when (= (save-excursion (goto-char (point-min)) (org-skip-whitespace) (point-at-bol)) - (org-element-get-property :begin cur)) + (org-element-property :begin cur)) (error "No previous element")) - (goto-char (org-element-get-property :begin cur)) + (goto-char (org-element-property :begin cur)) (forward-line -1) (let ((prev (org-element-at-point))) (when (org-element-nested-p cur prev) @@ -3610,57 +3862,67 @@ (defun org-element-unindent-buffer () (function (lambda (contents) (mapc (lambda (element) - (if (eq (car element) 'headline) + (if (eq (org-element-type element) 'headline) (funcall unindent-tree - (org-element-get-contents element)) + (org-element-contents element)) (save-excursion (save-restriction (narrow-to-region - (org-element-get-property :begin element) - (org-element-get-property :end element)) + (org-element-property :begin element) + (org-element-property :end element)) (org-do-remove-indentation))))) (reverse contents)))))) - (funcall unindent-tree (org-element-get-contents parse-tree)))) + (funcall unindent-tree (org-element-contents parse-tree)))) (defun org-element-up () - "Move to upper element. -Return position at the beginning of the upper element." + "Move to upper element." (interactive) - (let ((opoint (point)) elem) + (cond + ((bobp) (error "No surrounding element")) + ((org-with-limited-levels (org-at-heading-p)) + (or (org-up-heading-safe) (error "No surronding element"))) + (t + (let* ((trail (org-element-at-point 'keep-trail)) + (element (car trail)) + (type (org-element-type element))) + (cond + ;; At an item, with a parent in the list: move to that parent. + ((and (eq type 'item) + (let* ((beg (org-element-property :begin element)) + (struct (org-element-property :structure element)) + (parents (org-list-parents-alist struct)) + (parentp (org-list-get-parent beg struct parents))) + (and parentp (goto-char parentp))))) + ;; Determine parent in the trail. + (t + (let ((parent + (and (> (length trail) 1) + (let ((parentp (car (last trail)))) + (and (memq (org-element-type parentp) + org-element-greater-elements) + (>= (org-element-property :contents-end parentp) + (org-element-property :end element)) + parentp))))) + (cond + ;; When parent is found move to its beginning. + (parent (goto-char (org-element-property :begin parent))) + ;; If no parent was found, move to headline above, if any + ;; or return an error. + ((org-before-first-heading-p) (error "No surrounding element")) + (t (org-back-to-heading)))))))))) + +(defun org-element-down () + "Move to inner element." + (interactive) + (let ((element (org-element-at-point))) (cond - ((bobp) (error "No surrounding element")) - ((org-with-limited-levels (org-at-heading-p)) - (or (org-up-heading-safe) (error "No surronding element"))) - ((and (org-at-item-p) - (setq elem (org-element-at-point)) - (let* ((top-list-p (zerop (org-element-get-property :level elem)))) - (unless top-list-p - ;; If parent is bound to be in the same list as the - ;; original point, move to that parent. - (let ((struct (org-element-get-property :structure elem))) - (goto-char - (org-list-get-parent - (point-at-bol) struct (org-list-parents-alist struct)))))))) - (t - (let* ((elem (or elem (org-element-at-point))) - (end (save-excursion - (goto-char (org-element-get-property :end elem)) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - prev-elem) - (goto-char (org-element-get-property :begin elem)) - (forward-line -1) - (while (and (< (org-element-get-property - :end (setq prev-elem (org-element-at-point))) - end) - (not (bobp))) - (goto-char (org-element-get-property :begin prev-elem)) - (forward-line -1)) - (if (and (bobp) (< (org-element-get-property :end prev-elem) end)) - (progn (goto-char opoint) - (error "No surrounding element")) - (goto-char (org-element-get-property :begin prev-elem)))))))) + ((eq (org-element-type element) 'plain-list) + (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)) + (goto-char (org-element-property :contents-begin element))) + (t (error "No inner element"))))) (provide 'org-element) diff --git a/contrib/lisp/org-eval-light.el b/contrib/lisp/org-eval-light.el index 5cae699..36f3c6d 100644 --- a/contrib/lisp/org-eval-light.el +++ b/contrib/lisp/org-eval-light.el @@ -67,7 +67,7 @@ (defun org-eval-light-set-interpreters (var value) (defcustom org-eval-light-interpreters '("lisp" "emacs-lisp" "ruby" "shell") "Interpreters allows for evaluation tags. This is a list of program names (as strings) that can evaluate code and -insert the output into an Org-mode buffer. Valid choices are +insert the output into an Org-mode buffer. Valid choices are lisp Interpret Emacs Lisp code and display the result shell Pass command to the shell and display the result @@ -189,7 +189,7 @@ (defun org-eval-light-run (cmd code) (with-temp-buffer (insert code) (shell-command-on-region (point-min) (point-max) cmd nil 'replace) - (buffer-string))) + (buffer-string))) (defadvice org-ctrl-c-ctrl-c (around org-cc-eval-source activate) (if (org-eval-light-inside-snippet) diff --git a/contrib/lisp/org-eval.el b/contrib/lisp/org-eval.el index 31b91c1..9968669 100644 --- a/contrib/lisp/org-eval.el +++ b/contrib/lisp/org-eval.el @@ -105,7 +105,7 @@ (defun org-eval-set-interpreters (var value) (defcustom org-eval-interpreters '("lisp") "Interpreters allows for evaluation tags. This is a list of program names (as strings) that can evaluate code and -insert the output into an Org-mode buffer. Valid choices are +insert the output into an Org-mode buffer. Valid choices are lisp Interpret Emacs Lisp code and display the result shell Pass command to the shell and display the result @@ -120,7 +120,7 @@ (defcustom org-eval-interpreters '("lisp") (const "python") (const "ruby") (const "shell"))) - + (defun org-eval-handle-snippets (limit &optional replace) "Evaluate code snippets and display the results as display property. When REPLACE is non-nil, replace the code region with the result (used @@ -212,9 +212,8 @@ (defun org-eval-run (cmd code) (with-temp-buffer (insert code) (shell-command-on-region (point-min) (point-max) cmd nil 'replace) - (buffer-string))) + (buffer-string))) (provide 'org-eval) ;;; org-eval.el ends here - diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el index 88a1ab2..9f4517d 100644 --- a/contrib/lisp/org-expiry.el +++ b/contrib/lisp/org-expiry.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; ;; This gives you a chance to get rid of old entries in your Org files -;; by expiring them. +;; by expiring them. ;; ;; By default, entries that have no EXPIRY property are considered to be ;; new (i.e. 0 day old) and only entries older than one year go to the @@ -33,7 +33,7 @@ ;; your tasks will be deleted with the default settings. ;; ;; When does an entry expires? -;; +;; ;; Consider this entry: ;; ;; * Stop watching TV @@ -41,8 +41,8 @@ ;; :CREATED: <2008-01-07 lun 08:01> ;; :EXPIRY: <2008-01-09 08:01> ;; :END: -;; -;; This entry will expire on the 9th, january 2008. +;; +;; This entry will expire on the 9th, january 2008. ;; * Stop watching TV ;; :PROPERTIES: @@ -56,19 +56,19 @@ ;; What happen when an entry is expired? Nothing until you explicitely ;; M-x org-expiry-process-entries When doing this, org-expiry will check ;; for expired entries and request permission to process them. -;; +;; ;; Processing an expired entries means calling the function associated ;; with `org-expiry-handler-function'; the default is to add the tag -;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive -;; the subtree. +;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive +;; the subtree. ;; ;; Is this useful? Well, when you're in a brainstorming session, it ;; might be useful to know about the creation date of an entry, and be ;; able to archive those entries that are more than xxx days/weeks old. -;; +;; ;; When you're in such a session, you can insinuate org-expiry like -;; this: M-x org-expiry-insinuate -;; +;; this: M-x org-expiry-insinuate +;; ;; Then, each time you're pressing M-RET to insert an item, the CREATION ;; property will be automatically added. Same when you're scheduling or ;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate @@ -218,7 +218,7 @@ (defun org-expiry-expired-p () 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 creation date, use `org-expiry-created-date'. If there is no expiry date, use `org-expiry-expiry-date'." (let* ((ex-prop org-expiry-expiry-property-name) (cr-prop org-expiry-created-property-name) @@ -292,7 +292,7 @@ (defun org-expiry-insert-created (&optional arg) d-time d-hour timestr) (when (or (null d) arg) ;; update if no date or non-nil prefix argument - ;; FIXME Use `org-time-string-to-time' + ;; FIXME Use `org-time-string-to-time' (setq d-time (if d (org-time-string-to-time d) (current-time))) (setq d-hour (format-time-string "%H:%M" d-time)) @@ -326,7 +326,7 @@ (defun org-expiry-insert-expiry (&optional today) ;; maybe transform to inactive timestamp (if org-expiry-inactive-timestamps (setq timestr (concat "[" (substring timestr 1 -1) "]"))) - + (save-excursion (org-entry-put (point) org-expiry-expiry-property-name timestr)))) diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el index 24794d2..436badc 100644 --- a/contrib/lisp/org-export-generic.el +++ b/contrib/lisp/org-export-generic.el @@ -35,7 +35,7 @@ ;; org-set-generic-type function: ;; ;; (org-set-generic-type -;; "really-basic-text" +;; "really-basic-text" ;; '(:file-suffix ".txt" ;; :key-binding ?R ;; @@ -155,10 +155,10 @@ (defvar org-generic-alist :toc-section-numbers t :toc-section-number-format "\#(%s) " - :toc-format "--%s--" + :toc-format "--%s--" :toc-format-with-todo "!!%s!!\n" - :toc-indent-char ?\ - :toc-indent-depth 4 + :toc-indent-char ?\ + :toc-indent-depth 4 :toc-tags-export t :toc-tags-prefix " " @@ -217,7 +217,7 @@ (defvar org-generic-alist :body-list-checkbox-half-end "" - + ; other body lines :body-line-format "%s" @@ -257,10 +257,10 @@ (defvar org-generic-alist :toc-export t :toc-section-numbers t :toc-section-number-format "%s " - :toc-format "%s\n" + :toc-format "%s\n" :toc-format-with-todo "%s (*)\n" - :toc-indent-char ?\ - :toc-indent-depth 4 + :toc-indent-char ?\ + :toc-indent-depth 4 :body-header-section-numbers 3 :body-section-prefix "\n" @@ -310,7 +310,7 @@ (defvar org-generic-alist :body-section-header-prefix ("= " "== " "=== " "==== " "===== " "====== ") - :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n" + :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n" " ====\n\n" " =====\n\n" " ======\n\n") :body-line-export-preformated t ;; yes/no/maybe??? @@ -390,7 +390,7 @@ (defvar org-generic-alist :body-list-format "%s\n" ) - ("trac-wiki" + ("trac-wiki" :file-suffix ".txt" :key-binding ?T @@ -409,7 +409,7 @@ (defvar org-generic-alist :body-section-header-prefix (" == " " === " " ==== " " ===== " ) - :body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n" + :body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n" " =====\n\n" " ======\n\n" " =======\n\n") :body-line-export-preformated t ;; yes/no/maybe??? @@ -426,7 +426,7 @@ (defvar org-generic-alist ;; this is ignored! [2010/02/02:rpg] :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ") ) - ("tikiwiki" + ("tikiwiki" :file-suffix ".txt" :key-binding ?U @@ -445,7 +445,7 @@ (defvar org-generic-alist :body-section-header-prefix ("! " "!! " "!!! " "!!!! " "!!!!! " "!!!!!! " "!!!!!!! ") - :body-section-header-suffix (" \n" " \n" " \n" + :body-section-header-suffix (" \n" " \n" " \n" " \n" " \n" " \n") @@ -498,12 +498,12 @@ (defvar org-export-generic-keywords nil) )) (def-org-export-generic-keyword :body-newline-paragraph - :documentation "Bound either to NIL or to a pattern to be + :documentation "Bound either to NIL or to a pattern to be inserted in the output for every blank line in the input. The intention is to handle formats where text is flowed, and newlines are interpreted as significant \(e.g., as indicating preformatted text\). A common non-nil value for this keyword -is \"\\n\". Should typically be combined with a value for +is \"\\n\". Should typically be combined with a value for :body-line-format that does NOT end with a newline." :type string) @@ -515,8 +515,8 @@ (defvar org-export-generic-keywords nil) (def-org-export-generic-keyword :code-format) (def-org-export-generic-keyword :verbatim-format) - - + + (defun org-export-generic-remember-section (type suffix &optional prefix) (setq org-export-generic-section-type type) @@ -569,7 +569,7 @@ (defun org-export-generic (arg) (org-export-add-subtree-options opt-plist rbeg) opt-plist))) - helpstart + helpstart (bogus (mapc (lambda (x) (setq helpstart (concat helpstart "\[" @@ -611,7 +611,7 @@ (defun org-export-generic (arg) (unless (setq ass (cadr (assq r2 cmds))) (error "No command associated with key %c" r1)) - (cdr (assoc + (cdr (assoc (if (equal ass "default") org-generic-export-type ass) org-generic-alist)))) @@ -732,11 +732,11 @@ (defun org-export-generic (arg) (format-code (plist-get export-plist :code-format)) (format-verbatim (plist-get export-plist :verbatim-format)) - + thetoc toctags have-headings first-heading-pos table-open table-buffer link-buffer link desc desc0 rpl wrap) - + (let ((inhibit-read-only t)) (org-unmodified (remove-text-properties (point-min) (point-max) @@ -841,7 +841,7 @@ (defun org-export-generic (arg) (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) (progn - (setq + (setq toctags (org-export-generic-header (match-string 1 txt) @@ -852,7 +852,7 @@ (defun org-export-generic (arg) txt) (setq txt (replace-match "" t t txt))) (setq toctags tocnotagsstr))) - + (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) @@ -871,7 +871,7 @@ (defun org-export-generic (arg) "") (format - (if todo tocformtodo tocformat) + (if todo tocformtodo tocformat) txt) toctags) @@ -908,7 +908,7 @@ (defun org-export-generic (arg) (substring link 8) org-export-code-refs))) t t line)) - (setq rpl (concat "[" + (setq rpl (concat "[" (or (match-string 3 line) (match-string 1 line)) "]")) (when (and desc0 (not (equal desc0 link))) @@ -1043,7 +1043,7 @@ (defun org-export-generic (arg) ;; (org-export-generic-check-section "body" bodytextpre bodytextsuf) - (setq line + (setq line (org-export-generic-fontify line)) ;; XXX: properties? list? @@ -1208,7 +1208,7 @@ (defun org-export-generic-wrap (line where) (setq result (concat result line)) (setq len 0))) (concat result indstr line))) - + (defun org-export-generic-push-links (link-buffer) "Push out links in the buffer." (when link-buffer @@ -1258,13 +1258,13 @@ (defun org-generic-level-start (level old-level title umax export-plist )) ;; same level ((= level old-level) - (insert + (insert (org-export-generic-format export-plist :body-section-suffix 0 level)) ) ) (insert (org-export-generic-format export-plist :body-section-prefix 0 level)) - + (if (and org-export-with-section-numbers secnums (or (not (numberp secnums)) @@ -1365,7 +1365,7 @@ (defvar org-export-generic-emphasis-alist Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. The second element is a variable name, set in org-export-generic. That -variable will be dereferenced to obtain a formatting string to wrap +variable will be dereferenced to obtain a formatting string to wrap fontified text with. The third element decides whether to protect converted text from other conversions.") diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el index 7219873..0d8a04f 100644 --- a/contrib/lisp/org-export.el +++ b/contrib/lisp/org-export.el @@ -1,6 +1,6 @@ ;;; org-export.el --- Generic Export Engine For Org -;; Copyright (C) 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp @@ -28,9 +28,9 @@ ;; - The communication channel consists in a property list, which is ;; created and updated during the process. Its use is to offer -;; every piece of information, would it be export options or -;; contextual data, all in a single place. The exhaustive list of -;; properties is given in "The Communication Channel" section of +;; 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. ;; - The transcoder walks the parse tree, ignores or treat as plain @@ -85,12 +85,20 @@ ;; back-end. See `org-export-option-alist' for supported defaults and ;; syntax. -;; Tools for common tasks across back-ends are implemented in the last -;; part of this file. +;; Tools for common tasks across back-ends are implemented in the +;; penultimate part of this file. A dispatcher for standard back-ends +;; is provided in the last one. ;;; Code: (eval-when-compile (require 'cl)) (require 'org-element) +;; Require major back-ends and publishing tools +(require 'org-e-ascii "../../EXPERIMENTAL/org-e-ascii.el") +(require 'org-e-html "../../EXPERIMENTAL/org-e-html.el") +(require 'org-e-latex "../../EXPERIMENTAL/org-e-latex.el") +(require 'org-e-odt "../../EXPERIMENTAL/org-e-odt.el") +(require 'org-e-publish "../../EXPERIMENTAL/org-e-publish.el") + ;;; Internal Variables @@ -120,7 +128,7 @@ (defconst org-export-option-alist (:with-archived-trees nil "arch" org-export-with-archived-trees) (:with-author nil "author" org-export-with-author) (:with-creator nil "creator" org-export-with-creator) - (:with-drawers nil "drawer" org-export-with-drawers) + (:with-drawers nil "d" org-export-with-drawers) (:with-email nil "email" org-export-with-email) (:with-emphasize nil "*" org-export-with-emphasize) (:with-entities nil "e" org-export-with-entities) @@ -168,6 +176,80 @@ (defconst org-export-special-keywords way they are handled must be hard-coded into `org-export-get-inbuffer-options' function.") +(defconst org-export-filters-alist + '((:filter-babel-call . org-export-filter-babel-call-functions) + (:filter-center-block . org-export-filter-center-block-functions) + (:filter-comment . org-export-filter-comment-functions) + (:filter-comment-block . org-export-filter-comment-block-functions) + (:filter-drawer . org-export-filter-drawer-functions) + (:filter-dynamic-block . org-export-filter-dynamic-block-functions) + (:filter-emphasis . org-export-filter-emphasis-functions) + (:filter-entity . org-export-filter-entity-functions) + (:filter-example-block . org-export-filter-example-block-functions) + (:filter-export-block . org-export-filter-export-block-functions) + (:filter-export-snippet . org-export-filter-export-snippet-functions) + (:filter-final-output . org-export-filter-final-output-functions) + (:filter-fixed-width . org-export-filter-fixed-width-functions) + (:filter-footnote-definition . org-export-filter-footnote-definition-functions) + (:filter-footnote-reference . org-export-filter-footnote-reference-functions) + (:filter-headline . org-export-filter-headline-functions) + (:filter-horizontal-rule . org-export-filter-horizontal-rule-functions) + (:filter-inline-babel-call . org-export-filter-inline-babel-call-functions) + (:filter-inline-src-block . org-export-filter-inline-src-block-functions) + (:filter-inlinetask . org-export-filter-inlinetask-functions) + (:filter-item . org-export-filter-item-functions) + (:filter-keyword . org-export-filter-keyword-functions) + (:filter-latex-environment . org-export-filter-latex-environment-functions) + (:filter-latex-fragment . org-export-filter-latex-fragment-functions) + (:filter-line-break . org-export-filter-line-break-functions) + (:filter-link . org-export-filter-link-functions) + (:filter-macro . org-export-filter-macro-functions) + (:filter-paragraph . org-export-filter-paragraph-functions) + (:filter-parse-tree . org-export-filter-parse-tree-functions) + (:filter-plain-list . org-export-filter-plain-list-functions) + (:filter-plain-text . org-export-filter-plain-text-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) + (:filter-src-block . org-export-filter-src-block-functions) + (:filter-statistics-cookie . org-export-filter-statistics-cookie-functions) + (:filter-subscript . org-export-filter-subscript-functions) + (:filter-superscript . org-export-filter-superscript-functions) + (:filter-table . org-export-filter-table-functions) + (:filter-target . org-export-filter-target-functions) + (:filter-time-stamp . org-export-filter-time-stamp-functions) + (:filter-verbatim . org-export-filter-verbatim-functions) + (:filter-verse-block . org-export-filter-verse-block-functions)) + "Alist between filters properties and initial values. + +The key of each association is a property name accessible through +the communication channel its value is a configurable global +variable defining initial filters. + +This list is meant to install user specified filters. Back-end +developers may install their own filters using +`org-BACKEND-filters-alist', where BACKEND is the name of the +considered back-end. Filters defined there will always be +prepended to the current list, so they always get applied +first.") + +(defconst org-export-default-inline-image-rule + `(("file" . + ,(format "\\.%s\\'" + (regexp-opt + '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" + "xpm" "pbm" "pgm" "ppm") t)))) + "Default rule for link matching an inline image. +This rule applies to links with no description. By default, it +will be considered as an inline image if it targets a local file +whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\", +\"tiff\", \"tif\", \"xbm\", \"xpm\", \"pbm\", \"pgm\" or \"ppm\". +See `org-export-inline-image-p' for more information about +rules.") + ;;; User-configurable Variables @@ -229,10 +311,15 @@ (defcustom org-export-creator-string :group 'org-export-general :type '(string :tag "Creator string")) -(defcustom org-export-with-drawers nil - "Non-nil means export with drawers like the property drawer. +(defcustom org-export-with-drawers t + "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." +drawer names to export. This variable doesn't apply to +properties drawers. + +This option can also be set with the #+OPTIONS line, +e.g. \"d:nil\"." :group 'org-export-general :type '(choice (const :tag "All drawers" t) @@ -260,9 +347,13 @@ (defcustom org-export-with-emphasize t (defcustom org-export-exclude-tags '("noexport") "Tags that exclude a tree from export. + All trees carrying any of these tags will be excluded from export. This is without condition, so even subtrees inside that -carry one of the `org-export-select-tags' will be removed." +carry one of the `org-export-select-tags' will be removed. + +This option can also be set with the #+EXPORT_EXCLUDE_TAGS: +keyword." :group 'org-export-general :type '(repeat (string :tag "Tag"))) @@ -332,13 +423,20 @@ (defcustom org-export-with-entities t (defcustom org-export-with-priority nil "Non-nil means include priority cookies in export. -When nil, remove priority cookies for export." + +When nil, remove priority cookies for export. + +This option can also be set with the #+OPTIONS line, +e.g. \"pri:t\"." :group 'org-export-general :type 'boolean) (defcustom org-export-with-section-numbers t "Non-nil means add section numbers to headlines when exporting. +When set to an integer n, numbering will only happen for +headlines whose relative level is higher or equal to n. + This option can also be set with the #+OPTIONS line, e.g. \"num:t\"." :group 'org-export-general @@ -346,10 +444,14 @@ (defcustom org-export-with-section-numbers t (defcustom org-export-select-tags '("export") "Tags that select a tree for export. + If any such tag is found in a buffer, all trees that do not carry -one of these tags will be deleted before export. Inside trees +one of these tags will be ignored during export. Inside trees that are selected like this, you can still deselect a subtree by -tagging it with one of the `org-export-exclude-tags'." +tagging it with one of the `org-export-exclude-tags'. + +This option can also be set with the #+EXPORT_SELECT_TAGS: +keyword." :group 'org-export-general :type '(repeat (string :tag "Tag"))) @@ -503,6 +605,44 @@ (defcustom org-export-snippet-translation-alist nil (string :tag "Shortcut") (string :tag "Back-end")))) +(defcustom org-export-coding-system nil + "Coding system for the exported file." + :group 'org-export-general + :type 'coding-system) + +(defcustom org-export-copy-to-kill-ring t + "Non-nil means exported stuff will also be pushed onto the kill ring." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-initial-scope 'buffer + "The initial scope when exporting with `org-export-dispatch'. +This variable can be either set to `buffer' or `subtree'." + :group 'org-export-general + :type '(choice + (const :tag "Export current buffer" 'buffer) + (const :tag "Export current subtree" 'subtree))) + +(defcustom org-export-show-temporary-export-buffer t + "Non-nil means show buffer after exporting to temp buffer. +When Org exports to a file, the buffer visiting that file is ever +shown, but remains buried. However, when exporting to a temporary +buffer, that buffer is popped up in a second window. When this variable +is nil, the buffer remains buried also in these cases." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-dispatch-use-expert-ui nil + "Non-nil means using a non-intrusive `org-export-dispatch'. +In that case, no help buffer is displayed. Though, an indicator +for current export scope is added to the prompt \(i.e. \"b\" when +output is restricted to body only, \"s\" when it is restricted to +the current subtree and \"v\" when only visible elements are +considered for export\). Also, \[?] allows to switch back to +standard mode." + :group 'org-export-general + :type 'boolean) + ;;; The Communication Channel @@ -510,76 +650,56 @@ (defcustom org-export-snippet-translation-alist nil ;; During export process, every function has access to a number of ;; properties. They are of three types: -;; 1. Export options are collected once at the very beginning of the -;; process, out of the original buffer and environment. The task -;; is handled by `org-export-collect-options' function. +;; 1. Environment options are collected once at the very beginning of +;; the process, out of the original buffer and configuration. +;; Associated to the parse tree, they make an Org closure. +;; Collecting them is handled by `org-export-get-environment' +;; function. ;; -;; All export options are defined through the +;; Most environment options are defined through the ;; `org-export-option-alist' variable. ;; -;; 2. Persistent properties are stored in -;; `org-export-persistent-properties' and available at every level -;; of recursion. Their value is extracted directly from the parsed -;; tree, and depends on export options (whole trees may be filtered -;; out of the export process). +;; 2. Tree properties are extracted directly from the parsed tree, +;; just before export, by `org-export-collect-tree-properties'. ;; -;; Properties belonging to that type are defined in the -;; `org-export-persistent-properties-list' variable. -;; -;; 3. Every other property is considered local, and available at -;; a precise level of recursion and below. - -;; Managing properties during transcode process is mainly done with -;; `org-export-update-info'. Even though they come from different -;; sources, the function transparently concatenates them in a single -;; property list passed as an argument to each transcode function. -;; Thus, during export, all necessary information is available through -;; that single property list, and the element or object itself. -;; Though, modifying a property will still require some special care, -;; and should be done with `org-export-set-property' instead of plain -;; `plist-put'. +;; 3. Local options are updated during parsing, and their value +;; depends on the level of recursion. For now, only `:ignore-list' +;; belongs to that category. ;; Here is the full list of properties available during transcode -;; process, with their category (option, persistent or local), their -;; value type and the function updating them, when appropriate. +;; process, with their category (option, tree or local) and their +;; value type. -;; + `author' :: Author's name. +;; + `:author' :: Author's name. ;; - category :: option ;; - type :: string -;; + `back-end' :: Current back-end used for transcoding. -;; - category :: persistent +;; + `:back-end' :: Current back-end used for transcoding. +;; - category :: tree ;; - type :: symbol -;; + `code-refs' :: Association list between reference name and real -;; labels in source code. It is used to properly -;; resolve links inside source blocks. -;; - category :: persistent -;; - type :: alist (INT-OR-STRING . STRING) -;; - update :: `org-export-handle-code' - -;; + `creator' :: String to write as creation information. +;; + `:creator' :: String to write as creation information. ;; - category :: option ;; - type :: string -;; + `date' :: String to use as date. +;; + `:date' :: String to use as date. ;; - category :: option ;; - type :: string -;; + `description' :: Description text for the current data. +;; + `:description' :: Description text for the current data. ;; - category :: option ;; - type :: string -;; + `email' :: Author's email. +;; + `:email' :: Author's email. ;; - category :: option ;; - type :: string -;; + `exclude-tags' :: Tags for exclusion of subtrees from export +;; + `:exclude-tags' :: Tags for exclusion of subtrees from export ;; process. ;; - category :: option ;; - type :: list of strings -;; + `footnote-definition-alist' :: Alist between footnote labels and +;; + `: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 @@ -591,204 +711,152 @@ (defcustom org-export-snippet-translation-alist nil ;; - category :: option ;; - type :: alist (STRING . LIST) -;; + `footnote-seen-labels' :: List of already transcoded footnote -;; labels. It is used to know when a reference appears for the -;; first time. (cf. `org-export-footnote-first-reference-p'). -;; - category :: persistent -;; - type :: list of strings -;; - update :: `org-export-update-info' - -;; + `genealogy' :: List of current element's parents types. -;; - category :: local -;; - type :: list of symbols -;; - update :: `org-export-update-info' - -;; + `headline-alist' :: Alist between headlines raw name and their -;; boundaries. It is used to resolve "fuzzy" links -;; (cf. `org-export-resolve-fuzzy-link'). -;; - category :: persistent -;; - type :: alist (STRING INTEGER INTEGER) - -;; + `headline-levels' :: Maximum level being exported as an +;; + `: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 +;; + `: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 :: persistent +;; - category :: tree ;; - type :: integer -;; + `headline-numbering' :: Alist between headlines' beginning -;; position and their numbering, as a list of numbers +;; + `:headline-numbering' :: Alist between headlines and their +;; numbering, as a list of numbers ;; (cf. `org-export-get-headline-number'). -;; - category :: persistent +;; - category :: tree ;; - type :: alist (INTEGER . LIST) -;; + `included-files' :: List of files, with full path, included in -;; the current buffer, through the "#+include:" keyword. It is -;; mainly used to verify that no infinite recursive inclusion -;; happens. +;; + `:ignore-list' :: List of elements and objects that should be +;; ignored during export. ;; - category :: local -;; - type :: list of strings +;; - type :: list of elements and objects -;; + `inherited-properties' :: Properties of the headline ancestors -;; of the current element or object. Those from the closest -;; headline have precedence over the others. -;; - category :: local -;; - type :: plist +;; + `:input-file' :: Full path to input file, if any. +;; - category :: option +;; - type :: string or nil -;; + `keywords' :: List of keywords attached to data. +;; + `:keywords' :: List of keywords attached to data. ;; - category :: option ;; - type :: string -;; + `language' :: Default language used for translations. +;; + `:language' :: Default language used for translations. ;; - category :: option ;; - type :: string -;; + `parent-properties' :: Properties of the parent element. -;; - category :: local -;; - type :: plist -;; - update :: `org-export-update-info' +;; + `:macro-input-file' :: Macro returning file name of input file, +;; or nil. +;; - category :: option +;; - type :: string or nil -;; + `parse-tree' :: Whole parse tree, available at any time during +;; + `:parse-tree' :: Whole parse tree, available at any time during ;; transcoding. ;; - category :: global ;; - type :: list (as returned by `org-element-parse-buffer') -;; + `point-max' :: Last ending position in the parse tree. -;; - category :: global -;; - type :: integer - -;; + `preserve-breaks' :: Non-nil means transcoding should preserve +;; + `:preserve-breaks' :: Non-nil means transcoding should preserve ;; all line breaks. ;; - category :: option ;; - type :: symbol (nil, t) -;; + `previous-element' :: Previous element's type at the same -;; level. -;; - category :: local -;; - type :: symbol -;; - update :: `org-export-update-info' - -;; + `previous-object' :: Previous object type (or `plain-text') at -;; the same level. -;; - category :: local -;; - type :: symbol -;; - update :: `org-export-update-info' - -;; + `section-numbers' :: Non-nil means transcoding should add +;; + `: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, +;; + `: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 -;; + `target-list' :: List of targets raw names encoutered in the -;; parse tree. This is used to partly resolve -;; "fuzzy" links +;; + `:target-list' :: List of targets encountered in the parse tree. +;; This is used to partly resolve "fuzzy" links ;; (cf. `org-export-resolve-fuzzy-link'). -;; - category :: persistent +;; - category :: tree ;; - type :: list of strings -;; + `time-stamp-file' :: Non-nil means transcoding should insert +;; + `:time-stamp-file' :: Non-nil means transcoding should insert ;; a time stamp in the output. ;; - category :: option ;; - type :: symbol (nil, t) -;; + `total-loc' :: Contains total lines of code accumulated by source -;; blocks with the "+n" option so far. -;; - category :: persistent -;; - type :: integer -;; - update :: `org-export-handle-code' - -;; + `use-select-tags' :: When non-nil, a select tags has been found -;; in the parse tree. Thus, any headline without one will be -;; filtered out. See `select-tags'. -;; - category :: persistent -;; - type :: interger or nil - -;; + `with-archived-trees' :: Non-nil when archived subtrees should +;; + `: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 +;; + `:with-author' :: Non-nil means author's name should be included ;; in the output. ;; - category :: option ;; - type :: symbol (nil, t) -;; + `with-creator' :: Non-nild means a creation sentence should be +;; + `:with-creator' :: Non-nild 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-drawers' :: Non-nil means drawers should be exported. If +;; + `: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. ;; - category :: option ;; - type :: symbol (nil, t) or list of strings -;; + `with-email' :: Non-nil means output should contain author's +;; + `: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 +;; + `: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. +;; + `: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 +;; + `:with-footnotes' :: Non-nil if transcoder should interpret ;; footnotes. ;; - category :: option ;; - type :: symbol (nil, t) -;; + `with-priority' :: Non-nil means transcoding should include +;; + `:with-priority' :: Non-nil means transcoding should include ;; priority cookies. ;; - category :: option ;; - type :: symbol (nil, t) -;; + `with-special-strings' :: Non-nil means transcoding should +;; + `: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 +;; + `: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 +;; + `: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 +;; + `: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 +;; + `: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 @@ -798,36 +866,37 @@ (defcustom org-export-snippet-translation-alist nil ;; - category :: option ;; - type :: symbol (t, todo, done, nil) or list of strings -;; + `with-timestamps' :: Non-nil means transcoding should include +;; + `:with-timestamps' :: Non-nil means transcoding should include ;; time stamps and associated keywords. Otherwise, completely ;; remove them. ;; - category :: option ;; - type :: symbol: (t, nil) -;; + `with-toc' :: Non-nil means that a table of contents has to be +;; + `: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 +;; + `:with-todo-keywords' :: Non-nil means transcoding should ;; include TODO keywords. ;; - category :: option ;; - type :: symbol (nil, t) -;;;; Export Options -;; Export options come from five sources, in increasing precedence -;; order: +;;;; Environment Options +;; Environment options encompass all parameters defined outside the +;; scope of the parsed data. They come from five sources, in +;; increasing precedence order: +;; ;; - Global variables, -;; - External options provided at export time, ;; - Options keyword symbols, ;; - Buffer keywords, ;; - Subtree properties. -;; The central internal function with regards to export options is -;; `org-export-collect-options'. It updates global variables with +;; The central internal function with regards to environment options +;; is `org-export-get-environment'. It updates global variables with ;; "#+BIND:" keywords, then retrieve and prioritize properties from ;; the different sources. @@ -837,61 +906,62 @@ (defcustom org-export-snippet-translation-alist nil ;; `org-export-get-inbuffer-options' and ;; `org-export-get-global-options'. ;; -;; Some properties do not rely on the previous sources but still -;; depend on the original buffer are taken care of in +;; Some properties, which do not rely on the previous sources but +;; still depend on the original buffer, are taken care of with ;; `org-export-initial-options'. ;; Also, `org-export-confirm-letbind' and `org-export-install-letbind' ;; take care of the part relative to "#+BIND:" keywords. -(defun org-export-collect-options (backend subtreep ext-plist) +(defun org-export-get-environment (&optional backend subtreep ext-plist) "Collect export options from the current buffer. -BACKEND is a symbol specifying the back-end to use. +Optional argument BACKEND is a symbol specifying which back-end +specific options to read, if any. -When SUBTREEP is non-nil, assume the export is done against the -current sub-tree. +When optional argument SUBTREEP is non-nil, assume the export is +done against the current sub-tree. -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings." +Third optional argument EXT-PLIST is a property list with +external parameters overriding Org default settings, but still +inferior to file-local settings." ;; First install #+BIND variables. (org-export-install-letbind-maybe) ;; Get and prioritize export options... (let ((options (org-combine-plists ;; ... from global variables... (org-export-get-global-options backend) + ;; ... from buffer's name (default title)... + `(:title + ,(or (let ((file (buffer-file-name (buffer-base-buffer)))) + (and file + (file-name-sans-extension + (file-name-nondirectory file)))) + (buffer-name (buffer-base-buffer)))) ;; ... from an external property list... ext-plist ;; ... from in-buffer settings... (org-export-get-inbuffer-options - (org-with-wide-buffer (buffer-string)) backend + backend (and buffer-file-name (org-remove-double-quotes buffer-file-name))) ;; ... and from subtree, when appropriate. - (and subtreep - (org-export-get-subtree-options))))) + (and subtreep (org-export-get-subtree-options))))) ;; Add initial options. - (setq options (append (org-export-initial-options options) - options)) - ;; Set a default title if none has been specified so far. - (unless (plist-get options :title) - (setq options (plist-put options :title - (or (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory - buffer-file-name))) - (buffer-name))))) + (setq options (append (org-export-initial-options) options)) ;; Return plist. options)) -(defun org-export-parse-option-keyword (options backend) +(defun org-export-parse-option-keyword (options &optional backend) "Parse an OPTIONS line and return values as a plist. -BACKEND is a symbol specifying the back-end to use." - (let* ((all (append org-export-option-alist - (let ((var (intern - (format "org-%s-option-alist" backend)))) - (and (boundp var) (eval var))))) +Optional argument BACKEND is a symbol specifying which back-end +specific items to read, if any." + (let* ((all + (append org-export-option-alist + (and backend + (let ((var (intern + (format "org-%s-option-alist" backend)))) + (and (boundp var) (eval var)))))) ;; Build an alist between #+OPTION: item and property-name. (alist (delq nil (mapcar (lambda (e) @@ -913,162 +983,226 @@ (defun org-export-parse-option-keyword (options backend) (defun org-export-get-subtree-options () "Get export options in subtree at point. -Return the options as a plist." - (org-with-wide-buffer - (when (ignore-errors (org-back-to-heading t)) - (let (prop plist) - (when (setq prop (progn (looking-at org-todo-line-regexp) - (or (org-entry-get (point) "EXPORT_TITLE") - (org-match-string-no-properties 3)))) - (setq plist (plist-put plist :title prop))) - (when (setq prop (org-entry-get (point) "EXPORT_TEXT")) - (setq plist (plist-put plist :text prop))) - (when (setq prop (org-entry-get (point) "EXPORT_AUTHOR")) - (setq plist (plist-put plist :author prop))) - (when (setq prop (org-entry-get (point) "EXPORT_DATE")) - (setq plist (plist-put plist :date prop))) - (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS")) - (setq plist (org-export-add-options-to-plist plist prop))) - plist)))) - -(defun org-export-get-inbuffer-options (buffer-string backend files) - "Return in-buffer options as a plist. -BUFFER-STRING is the string of the buffer. BACKEND is a symbol -specifying which back-end should be used." - (let ((case-fold-search t) plist) - ;; 1. Special keywords, as in `org-export-special-keywords'. - (let ((start 0) - (special-re (org-make-options-regexp org-export-special-keywords))) - (while (string-match special-re buffer-string start) - (setq start (match-end 0)) - (let ((key (upcase (org-match-string-no-properties 1 buffer-string))) - ;; Special keywords do not have their value expanded. - (val (org-match-string-no-properties 2 buffer-string))) - (setq plist - (org-combine-plists - (cond - ((string= key "SETUP_FILE") - (let ((file (expand-file-name - (org-remove-double-quotes (org-trim val))))) - ;; Avoid circular dependencies. - (unless (member file files) - (org-export-get-inbuffer-options - (org-file-contents file 'noerror) - backend - (cons file files))))) - ((string= key "OPTIONS") - (org-export-parse-option-keyword val backend)) - ((string= key "MACRO") - (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" - val) - (plist-put nil - (intern (concat ":macro-" - (downcase (match-string 1 val)))) - (match-string 2 val)))) - plist))))) - ;; 2. Standard options, as in `org-export-option-alist'. - (let* ((all (append org-export-option-alist - (let ((var (intern - (format "org-%s-option-alist" backend)))) - (and (boundp var) (eval var))))) - ;; Build alist between keyword name and property name. - (alist (delq nil (mapcar (lambda (e) - (when (nth 1 e) (cons (nth 1 e) (car e)))) - all))) - ;; Build regexp matching all keywords associated to export - ;; options. Note: the search is case insensitive. - (opt-re (org-make-options-regexp - (delq nil (mapcar (lambda (e) (nth 1 e)) all)))) - (start 0)) - (while (string-match opt-re buffer-string start) - (setq start (match-end 0)) - (let* ((key (upcase (org-match-string-no-properties 1 buffer-string))) - ;; Expand value, applying restrictions for keywords. - (val (org-match-string-no-properties 2 buffer-string)) - (prop (cdr (assoc key alist))) - (behaviour (nth 4 (assq prop all)))) - (setq plist - (plist-put - plist prop - ;; Handle value depending on specified BEHAVIOUR. - (case behaviour - (space (if (plist-get plist prop) - (concat (plist-get plist prop) " " (org-trim val)) - (org-trim val))) - (newline (org-trim - (concat - (plist-get plist prop) "\n" (org-trim val)))) - (split `(,@(plist-get plist prop) ,@(org-split-string val))) - ('t val) - (otherwise (plist-get plist prop))))))) - ;; Parse keywords specified in `org-element-parsed-keywords'. - (mapc - (lambda (key) - (let* ((prop (cdr (assoc (upcase key) alist))) - (value (and prop (plist-get plist prop)))) - (when (stringp value) - (setq plist - (plist-put - plist prop - (org-element-parse-secondary-string - value - (cdr (assq 'keyword org-element-string-restrictions)))))))) - org-element-parsed-keywords)) - ;; Return final value. + +Assume point is at subtree's beginning. + +Return options as a plist." + (let (prop plist) + (when (setq prop (progn (looking-at org-todo-line-regexp) + (or (save-match-data + (org-entry-get (point) "EXPORT_TITLE")) + (org-match-string-no-properties 3)))) + (setq plist + (plist-put + plist :title + (org-element-parse-secondary-string + prop + (cdr (assq 'keyword org-element-string-restrictions)))))) + (when (setq prop (org-entry-get (point) "EXPORT_TEXT")) + (setq plist (plist-put plist :text prop))) + (when (setq prop (org-entry-get (point) "EXPORT_AUTHOR")) + (setq plist (plist-put plist :author prop))) + (when (setq prop (org-entry-get (point) "EXPORT_DATE")) + (setq plist (plist-put plist :date prop))) + (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS")) + (setq plist (org-export-add-options-to-plist plist prop))) plist)) -(defun org-export-get-global-options (backend) +(defun org-export-get-inbuffer-options (&optional backend files) + "Return current buffer export options, as a plist. + +Optional argument BACKEND, when non-nil, is a symbol specifying +which back-end specific options should also be read in the +process. + +Optional argument FILES is a list of setup files names read so +far, used to avoid circular dependencies. + +Assume buffer is in Org mode. Narrowing, if any, is ignored." + (org-with-wide-buffer + (goto-char (point-min)) + (let ((case-fold-search t) plist) + ;; 1. Special keywords, as in `org-export-special-keywords'. + (let ((special-re (org-make-options-regexp org-export-special-keywords))) + (while (re-search-forward special-re nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let* ((key (upcase (org-element-property :key element))) + (val (org-element-property :value element)) + (prop + (cond + ((string= key "SETUP_FILE") + (let ((file + (expand-file-name + (org-remove-double-quotes (org-trim val))))) + ;; Avoid circular dependencies. + (unless (member file files) + (with-temp-buffer + (insert (org-file-contents file 'noerror)) + (org-mode) + (org-export-get-inbuffer-options + backend (cons file files)))))) + ((string= key "OPTIONS") + (org-export-parse-option-keyword val backend)) + ((string= key "MACRO") + (when (string-match + "^\\([-a-zA-Z0-9_]+\\)\\(?:[ \t]+\\(.*?\\)[ \t]*$\\)?" + val) + (let ((key + (intern + (concat ":macro-" + (downcase (match-string 1 val))))) + (value (org-match-string-no-properties 2 val))) + (cond + ((not value) nil) + ;; Value will be evaled. Leave it as-is. + ((string-match "\\`(eval\\>" value) + (list key value)) + ;; Value has to be parsed for nested + ;; macros. + (t + (list + key + (let ((restr + (cdr + (assq 'macro + org-element-object-restrictions)))) + (org-element-parse-secondary-string + ;; If user explicitly asks for + ;; a newline, be sure to preserve it + ;; from further filling with + ;; `hard-newline'. Also replace + ;; "\\n" with "\n", "\\\n" with "\\n" + ;; and so on... + (replace-regexp-in-string + "\\(\\\\\\\\\\)n" "\\\\" + (replace-regexp-in-string + "\\(?:^\\|[^\\\\]\\)\\(\\\\n\\)" + hard-newline value nil nil 1) + nil nil 1) + restr))))))))))) + (setq plist (org-combine-plists plist prop))))))) + ;; 2. Standard options, as in `org-export-option-alist'. + (let* ((all (append org-export-option-alist + ;; Also look for back-end specific options + ;; if BACKEND is defined. + (and backend + (let ((var + (intern + (format "org-%s-option-alist" backend)))) + (and (boundp var) (eval var)))))) + ;; Build alist between keyword name and property name. + (alist + (delq nil (mapcar + (lambda (e) (when (nth 1 e) (cons (nth 1 e) (car e)))) + all))) + ;; Build regexp matching all keywords associated to export + ;; options. Note: the search is case insensitive. + (opt-re (org-make-options-regexp + (delq nil (mapcar (lambda (e) (nth 1 e)) all))))) + (goto-char (point-min)) + (while (re-search-forward opt-re nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let* ((key (upcase (org-element-property :key element))) + (val (org-element-property :value element)) + (prop (cdr (assoc key alist))) + (behaviour (nth 4 (assq prop all)))) + (setq plist + (plist-put + plist prop + ;; Handle value depending on specified BEHAVIOUR. + (case behaviour + (space + (if (not (plist-get plist prop)) (org-trim val) + (concat (plist-get plist prop) " " (org-trim val)))) + (newline + (org-trim + (concat (plist-get plist prop) "\n" (org-trim val)))) + (split + `(,@(plist-get plist prop) ,@(org-split-string val))) + ('t val) + (otherwise (if (not (plist-member plist prop)) val + (plist-get plist prop)))))))))) + ;; Parse keywords specified in `org-element-parsed-keywords'. + (mapc + (lambda (key) + (let* ((prop (cdr (assoc key alist))) + (value (and prop (plist-get plist prop)))) + (when (stringp value) + (setq plist + (plist-put + plist prop + (org-element-parse-secondary-string + value + (cdr (assq 'keyword org-element-string-restrictions)))))))) + org-element-parsed-keywords)) + ;; 3. Return final value. + plist))) + +(defun org-export-get-global-options (&optional backend) "Return global export options as a plist. -BACKEND is a symbol specifying which back-end should be used." + +Optional argument BACKEND, if non-nil, is a symbol specifying +which back-end specific export options should also be read in the +process." (let ((all (append org-export-option-alist - (let ((var (intern - (format "org-%s-option-alist" backend)))) - (and (boundp var) (eval var))))) + (and backend + (let ((var (intern + (format "org-%s-option-alist" backend)))) + (and (boundp var) (eval var)))))) ;; Output value. plist) (mapc (lambda (cell) - (setq plist - (plist-put plist (car cell) (eval (nth 3 cell))))) + (setq plist (plist-put plist (car cell) (eval (nth 3 cell))))) all) ;; Return value. plist)) -(defun org-export-initial-options (options) - "Return a plist with non-optional properties. -OPTIONS is the export options plist computed so far." - (list - ;; `:macro-date', `:macro-time' and `:macro-property' could as well - ;; be initialized as persistent properties, since they don't depend - ;; on initial environment. Though, it may be more logical to keep - ;; them close to other ":macro-" properties. - :macro-date "(eval (format-time-string \"$1\"))" - :macro-time "(eval (format-time-string \"$1\"))" - :macro-property "(eval (org-entry-get nil \"$1\" 'selective))" - :macro-modification-time - (and (buffer-file-name) - (file-exists-p (buffer-file-name)) - (concat "(eval (format-time-string \"$1\" '" - (prin1-to-string (nth 5 (file-attributes (buffer-file-name)))) - "))")) - :macro-input-file (and (buffer-file-name) - (file-name-nondirectory (buffer-file-name))) - ;; 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 some narrowing. - :footnote-definition-alist - (let (alist) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward org-footnote-definition-re nil t) - (let ((def (org-footnote-at-definition-p))) - (when def - (org-skip-whitespace) - (push (cons (car def) - (save-restriction - (narrow-to-region (point) (nth 2 def)) - (org-element-parse-buffer))) - alist)))) - alist)))) +(defun org-export-initial-options () + "Return a plist with properties related to input buffer." + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (list + ;; Store full path of input file name, or nil. For internal use. + :input-file visited-file + ;; `:macro-date', `:macro-time' and `:macro-property' could as well + ;; be initialized as tree properties, since they don't depend on + ;; initial environment. Though, it may be more logical to keep + ;; them close to other ":macro-" properties. + :macro-date "(eval (format-time-string \"$1\"))" + :macro-time "(eval (format-time-string \"$1\"))" + :macro-property "(eval (org-entry-get nil \"$1\" 'selective))" + :macro-modification-time + (and visited-file + (file-exists-p visited-file) + (concat "(eval (format-time-string \"$1\" '" + (prin1-to-string (nth 5 (file-attributes visited-file))) + "))")) + ;; Store input file name as a macro. + :macro-input-file (and visited-file (file-name-nondirectory visited-file)) + ;; 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 some narrowing. + :footnote-definition-alist + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-footnote-definition-re nil t) + (let ((def (org-footnote-at-definition-p))) + (when def + (org-skip-whitespace) + (push (cons (car def) + (save-restriction + (narrow-to-region (point) (nth 2 def)) + ;; Like `org-element-parse-buffer', but + ;; makes sure the definition doesn't start + ;; with a section element. + (nconc + (list 'org-data nil) + (org-element-parse-elements + (point-min) (point-max) nil nil nil nil nil)))) + alist)))) + alist))))) (defvar org-export-allow-BIND-local nil) (defun org-export-confirm-letbind () @@ -1097,125 +1231,74 @@ (defun org-export-install-letbind-maybe () (org-set-local (car pair) (nth 1 pair))))) -;;;; Persistent Properties - -;; Persistent properties are declared in -;; `org-export-persistent-properties-list' variable. Most of them are -;; initialized at the beginning of the transcoding process by -;; `org-export-initialize-persistent-properties'. The others are -;; updated during that process. - -;; Dedicated functions focus on computing the value of specific -;; persistent properties during initialization. Thus, -;; `org-export-use-select-tag-p' determines if an headline makes use -;; of an export tag enforcing inclusion. `org-export-get-min-level' -;; gets the minimal exportable level, used as a basis to compute -;; relative level for headlines. `org-export-get-point-max' returns -;; the maximum exportable ending position in the parse tree. -;; Eventually `org-export-collect-headline-numbering' builds an alist -;; between headlines' beginning position and their numbering. - -(defconst org-export-persistent-properties-list - '(:back-end :code-refs :headline-alist :headline-numbering :headline-offset - :parse-tree :point-max :footnote-seen-labels :target-list - :total-loc :use-select-tags) - "List of persistent properties.") +;;;; Tree Properties -(defconst org-export-persistent-properties nil - "Used internally to store properties and values during transcoding. +;; Tree properties are infromation extracted from parse tree. They +;; are initialized at the beginning of the transcoding process by +;; `org-export-collect-tree-properties'. -Only properties that should survive recursion are saved here. +;; Dedicated functions focus on computing the value of specific tree +;; properties during initialization. Thus, +;; `org-export-populate-ignore-list' lists elements and objects that +;; should be skipped during export, `org-export-get-min-level' gets +;; the minimal exportable level, used as a basis to compute relative +;; level for headlines. Eventually +;; `org-export-collect-headline-numbering' builds an alist between +;; headlines and their numbering. -This variable is reset before each transcoding.") +(defun org-export-collect-tree-properties (data info backend) + "Extract tree properties from parse tree. -(defun org-export-initialize-persistent-properties (data options backend) - "Initialize `org-export-persistent-properties'. +DATA is the parse tree from which information is retrieved. INFO +is a list holding export options. BACKEND is the back-end called +for transcoding, as a symbol. -DATA is the parse tree from which information is retrieved. -OPTIONS is a list holding export options. BACKEND is the -back-end called for transcoding, as a symbol. - -Following initial persistent properties are set: +Following tree properties are set: `:back-end' Back-end used for transcoding. -`:headline-alist' Alist of all headlines' name as key and a list - holding beginning and ending positions as - value. - `:headline-offset' Offset between true level of headlines and - local level. An offset of -1 means an headline + local level. An offset of -1 means an headline of level 2 should be considered as a level 1 headline in the context. -`:headline-numbering' Alist of all headlines' beginning position - as key an the associated numbering as value. +`: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. `:parse-tree' Whole parse tree. -`:point-max' Last position in the parse tree - -`:target-list' List of all targets' raw name in the parse tree. - -`:use-select-tags' Non-nil when parsed tree use a special tag to - enforce transcoding of the headline." - ;; First delete any residual persistent property. - (setq org-export-persistent-properties nil) - ;; Immediately after, set `:use-select-tags' property, as it will be - ;; required for further computations. - (setq options - (org-export-set-property - options - :use-select-tags - (org-export-use-select-tags-p data options))) - ;; Get the rest of the initial persistent properties, now - ;; `:use-select-tags' is set... - ;; 1. `:parse-tree' ... - (setq options (org-export-set-property options :parse-tree data)) - ;; 2. `:headline-offset' ... - (setq options - (org-export-set-property - options :headline-offset - (- 1 (org-export-get-min-level data options)))) - ;; 3. `:point-max' ... - (setq options (org-export-set-property - options :point-max - (org-export-get-point-max data options))) - ;; 4. `:target-list'... - (setq options (org-export-set-property - options :target-list - (org-element-map - data 'target - (lambda (target info) - (org-element-get-property :raw-value target))))) - ;; 5. `:headline-alist' - (setq options (org-export-set-property - options :headline-alist - (org-element-map - data 'headline - (lambda (headline info) - (list (org-element-get-property :raw-value headline) - (org-element-get-property :begin headline) - (org-element-get-property :end headline)))))) - ;; 6. `:headline-numbering' - (setq options (org-export-set-property - options :headline-numbering - (org-export-collect-headline-numbering data options))) - ;; 7. `:back-end' - (setq options (org-export-set-property options :back-end backend))) - -(defun org-export-use-select-tags-p (data options) - "Non-nil when data use a tag enforcing transcoding. -DATA is parsed data as returned by `org-element-parse-buffer'. -OPTIONS is a plist holding export options." - (org-element-map - data - 'headline - (lambda (headline info) - (let ((tags (org-element-get-property :with-tags headline))) - (and tags (string-match - (format ":%s:" (plist-get info :select-tags)) tags)))) - options - 'stop-at-first-match)) +`:target-list' List of all targets in the parse tree." + ;; First, 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)))) + ;; Then 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)))) + ;; Now, properties order doesn't matter: get the rest of the tree + ;; properties. + (nconc + `(:parse-tree + ,data + :target-list + ,(org-element-map + data '(keyword target) + (lambda (blob) + (when (or (eq (org-element-type blob) 'target) + (string= (upcase (org-element-property :key blob)) + "TARGET")) + blob)) info) + :headline-numbering ,(org-export-collect-headline-numbering data info) + :back-end ,backend) + info)) (defun org-export-get-min-level (data options) "Return minimum exportable headline's level in DATA. @@ -1223,47 +1306,35 @@ (defun org-export-get-min-level (data options) OPTIONS is a plist holding export options." (catch 'exit (let ((min-level 10000)) - (mapc (lambda (blob) - (when (and (eq (car blob) 'headline) - (not (org-export-skip-p blob options))) - (setq min-level - (min (org-element-get-property :level blob) min-level))) - (when (= min-level 1) (throw 'exit 1))) - (org-element-get-contents data)) + (mapc + (lambda (blob) + (when (and (eq (org-element-type blob) 'headline) + (not (member blob (plist-get options :ignore-list)))) + (setq min-level + (min (org-element-property :level blob) min-level))) + (when (= min-level 1) (throw 'exit 1))) + (org-element-contents data)) ;; If no headline was found, for the sake of consistency, set ;; minimum level to 1 nonetheless. (if (= min-level 10000) 1 min-level)))) -(defun org-export-get-point-max (data options) - "Return last exportable ending position in DATA. -DATA is parsed tree as returned by `org-element-parse-buffer'. -OPTIONS is a plist holding export options." - (let ((pos-max 1)) - (mapc (lambda (blob) - (unless (and (eq (car blob) 'headline) - (org-export-skip-p blob options)) - (setq pos-max (org-element-get-property :end blob)))) - (org-element-get-contents data)) - pos-max)) - (defun org-export-collect-headline-numbering (data options) "Return numbering of all exportable headlines in a parse tree. DATA is the parse tree. OPTIONS is the plist holding export options. -Return an alist whose key is headline's beginning position and -value is its associated numbering (in the shape of a list of -numbers)." +Return an alist whose key is an headline and value is its +associated numbering \(in the shape of a list of numbers\)." (let ((numbering (make-vector org-export-max-depth 0))) (org-element-map data 'headline - (lambda (headline info) + (lambda (headline) (let ((relative-level - (1- (org-export-get-relative-level headline info)))) + (1- (org-export-get-relative-level headline options)))) (cons - (org-element-get-property :begin headline) + headline (loop for n across numbering for idx from 0 to org-export-max-depth when (< idx relative-level) collect n @@ -1271,92 +1342,107 @@ (defun org-export-collect-headline-numbering (data options) 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. + +Return elements or objects to ignore as a list." + (let (ignore + (walk-data + (function + (lambda (data options selected) + ;; Collect ignored elements or objects into IGNORE-LIST. + (mapc + (lambda (el) + (if (org-export--skip-p el options selected) (push el ignore) + (let ((type (org-element-type el))) + (if (and (eq (plist-get info :with-archived-trees) 'headline) + (eq (org-element-type el) 'headline) + (org-element-property :archivedp el)) + ;; 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 el)) + ;; Move into recursive objects/elements. + (when (or (eq type 'org-data) + (memq type org-element-greater-elements) + (memq type org-element-recursive-objects) + (eq type 'paragraph)) + (funcall walk-data el options selected)))))) + (org-element-contents data)))))) + ;; Main call. First find trees containing a select tag, if any. + (funcall walk-data data options (org-export--selected-trees data options)) + ;; Return value. + ignore)) -;;;; Properties Management - -;; This is mostly done with the help of two functions. On the one -;; hand `org-export-update-info' is used to keep up-to-date local -;; information while walking the nested list representing the parsed -;; document. On the other end, `org-export-set-property' handles -;; properties modifications according to their type (persistent or -;; local). - -;; As exceptions, `:code-refs' and `:total-loc' properties are updated -;; with `org-export-handle-code' function. - -(defun org-export-update-info (blob info recursep) - "Update export options depending on context. - -BLOB is the element or object being parsed. INFO is the plist -holding the export options. - -When RECURSEP is non-nil, assume the following element or object -will be inside the current one. - -The following properties are updated: -`footnote-seen-labels' List of already parsed footnote - labels (string list) -`genealogy' List of current element's parents - (symbol list). -`inherited-properties' List of inherited properties from - parent headlines (plist). -`parent-properties' List of last element's properties - (plist). -`previous-element' Previous element's type (symbol). -`previous-object' Previous object's type (symbol). - -Return the property list." - (let* ((type (and (not (stringp blob)) (car blob)))) - (cond - ;; Case 1: We're moving into a recursive blob. - (recursep - (org-combine-plists - info - `(:genealogy ,(cons type (plist-get info :genealogy)) - :previous-element nil - :previous-object nil - :parent-properties - ,(if (memq type org-element-all-elements) - (nth 1 blob) - (plist-get info :parent-properties)) - :inherited-properties - ,(if (eq type 'headline) - (org-combine-plists - (plist-get info :inherited-properties) (nth 1 blob)) - (plist-get info :inherited-properties))) - ;; Add persistent properties. - org-export-persistent-properties)) - ;; Case 2: No recursion. - (t - ;; At a footnote reference: mark its label as seen, if not - ;; already the case. - (when (eq type 'footnote-reference) - (let ((label (org-element-get-property :label blob)) - (seen-labels (plist-get org-export-persistent-properties - :footnote-seen-labels))) - ;; Store anonymous footnotes (nil label) without checking if - ;; another anonymous footnote was seen before. - (unless (and label (member label seen-labels)) - (setq info (org-export-set-property - info :footnote-seen-labels (push label seen-labels)))))) - ;; Set `:previous-element' or `:previous-object' according to - ;; BLOB. - (setq info (cond ((not type) - (org-export-set-property - info :previous-object 'plain-text)) - ((memq type org-element-all-elements) - (org-export-set-property info :previous-element type)) - (t (org-export-set-property info :previous-object type)))) - ;; Return updated value. - info)))) - -(defun org-export-set-property (info prop value) - "Set property PROP to VALUE in plist INFO. -Return the new plist." - (when (memq prop org-export-persistent-properties-list) - (setq org-export-persistent-properties - (plist-put org-export-persistent-properties prop value))) - (plist-put info prop value)) +(defun org-export--selected-trees (data info) + "Return list of headlines containing a select tag in their tree. +DATA is parsed data as returned by `org-element-parse-buffer'. +INFO is a plist holding export options." + (let (selected-trees + (walk-data + (function + (lambda (data genealogy) + (case (org-element-type data) + (org-data + (funcall walk-data (org-element-contents data) genealogy)) + (headline + (let ((tags (org-element-property :tags headline))) + (if (and tags + (loop for tag in (plist-get info :select-tags) + thereis (string-match + (format ":%s:" tag) tags))) + ;; When a select tag is found, mark as acceptable + ;; full genealogy and every headline within the + ;; tree. + (setq selected-trees + (append + (cons data genealogy) + (org-element-map data 'headline 'identity) + selected-trees)) + ;; Else, continue searching in tree, recursively. + (funcall walk-data data (cons data genealogy)))))))))) + (funcall walk-data data nil) selected-trees)) + +(defun org-export--skip-p (blob options select-tags) + "Non-nil when element or object BLOB should be skipped during export. +OPTIONS is the plist holding export options." + (case (org-element-type blob) + ;; Check headline. + (headline + (let ((with-tasks (plist-get options :with-tasks)) + (todo (org-element-property :todo-keyword blob)) + (todo-type (org-element-property :todo-type blob)) + (archived (plist-get options :with-archived-trees)) + (tag-list (let ((tags (org-element-property :tags blob))) + (and tags (org-split-string tags ":"))))) + (or + ;; Ignore subtrees with an exclude tag. + (loop for k in (plist-get options :exclude-tags) + thereis (member k tag-list)) + ;; Ignore subtrees without a select tag, when such tag is + ;; found in the buffer. + (member blob select-tags) + ;; Ignore commented sub-trees. + (org-element-property :commentedp blob) + ;; Ignore archived subtrees if `:with-archived-trees' is nil. + (and (not archived) (org-element-property :archivedp blob)) + ;; Ignore tasks, if specified by `:with-tasks' property. + (and todo + (or (not with-tasks) + (and (memq with-tasks '(todo done)) + (not (eq todo-type with-tasks))) + (and (consp with-tasks) (not (member todo with-tasks)))))))) + ;; Check time-stamp. + (time-stamp (not (plist-get options :with-timestamps))) + ;; Check drawer. + (drawer + (or (not (plist-get options :with-drawers)) + (and (consp (plist-get options :with-drawers)) + (not (member (org-element-property :drawer-name blob) + (plist-get options :with-drawers)))))))) @@ -1373,11 +1459,12 @@ (defun org-export-set-property (info prop value) ;; `org-export-secondary-string' is provided for that specific task. ;; Internally, three functions handle the filtering of objects and -;; elements during the export. More precisely, `org-export-skip-p' -;; determines if the considered object or element should be ignored -;; altogether, `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. +;; elements during the export. In particular, +;; `org-export-ignore-element' mark 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. (defun org-export-data (data backend info) "Convert DATA to a string into BACKEND format. @@ -1396,35 +1483,32 @@ (defun org-export-data (data backend info) ;; BLOB can be an element, an object, a string, or nil. (lambda (blob) (cond - ((not blob) nil) ((equal blob "") nil) + ((not blob) nil) ;; BLOB is a string. Check if the optional transcoder for plain ;; text exists, and call it in that case. Otherwise, simply ;; return string. Also update INFO and call ;; `org-export-filter-plain-text-functions'. ((stringp blob) - (setq info (org-export-update-info blob info nil)) (let ((transcoder (intern (format "org-%s-plain-text" backend)))) (org-export-filter-apply-functions - org-export-filter-plain-text-functions + (plist-get info :filter-plain-text) (if (fboundp transcoder) (funcall transcoder blob info) blob) - backend))) + backend info))) ;; BLOB is an element or an object. (t - (let* ((type (if (stringp blob) 'plain-text (car blob))) + (let* ((type (org-element-type blob)) ;; 1. Determine the appropriate TRANSCODER. (transcoder (cond ;; 1.0 A full Org document is inserted. ((eq type 'org-data) 'identity) ;; 1.1. BLOB should be ignored. - ((org-export-skip-p blob info) nil) + ((member blob (plist-get info :ignore-list)) nil) ;; 1.2. BLOB shouldn't be transcoded. Interpret it ;; back into Org syntax. - ((not (org-export-interpret-p blob info)) - 'org-export-expand) + ((not (org-export-interpret-p blob info)) 'org-export-expand) ;; 1.3. Else apply naming convention. - (t (let ((trans (intern - (format "org-%s-%s" backend type)))) + (t (let ((trans (intern (format "org-%s-%s" backend type)))) (and (fboundp trans) trans))))) ;; 2. Compute CONTENTS of BLOB. (contents @@ -1432,12 +1516,10 @@ (defun org-export-data (data backend info) ;; Case 0. No transcoder defined: ignore BLOB. ((not transcoder) nil) ;; Case 1. Transparently export an Org document. - ((eq type 'org-data) - (org-export-data blob backend info)) + ((eq type 'org-data) (org-export-data blob backend info)) ;; Case 2. For a recursive object. ((memq type org-element-recursive-objects) - (org-export-data - blob backend (org-export-update-info blob info t))) + (org-export-data blob backend info)) ;; Case 3. For a recursive element. ((memq type org-element-greater-elements) ;; Ignore contents of an archived tree @@ -1445,10 +1527,9 @@ (defun org-export-data (data backend info) (unless (and (eq type 'headline) (eq (plist-get info :with-archived-trees) 'headline) - (org-element-get-property :archivedp blob)) + (org-element-property :archivedp blob)) (org-element-normalize-string - (org-export-data - blob backend (org-export-update-info blob info t))))) + (org-export-data blob backend info)))) ;; Case 4. For a paragraph. ((eq type 'paragraph) (let ((paragraph @@ -1458,13 +1539,11 @@ (defun org-export-data (data backend info) ;; a footnote definition, ignore first line's ;; indentation: there is none and it might be ;; misleading. - (and (not (plist-get info :previous-element)) - (let ((parent (car (plist-get info :genealogy)))) - (memq parent '(footnote-definition item))))))) - (org-export-data - paragraph - backend - (org-export-update-info blob info t)))))) + (and (not (org-export-get-previous-element blob info)) + (let ((parent (org-export-get-parent blob info))) + (memq (org-element-type parent) + '(footnote-definition item))))))) + (org-export-data paragraph backend info))))) ;; 3. Transcode BLOB into RESULTS string. (results (cond ((not transcoder) nil) @@ -1473,26 +1552,27 @@ (defun org-export-data (data backend info) `(org-data nil ,(funcall transcoder blob contents)) backend info)) (t (funcall transcoder blob contents info))))) - ;; 4. Discard nil results. Otherwise, update INFO, append - ;; the same white space between elements or objects as in - ;; the original buffer, and call appropriate filters. - (when results - (setq info (org-export-update-info blob info nil)) - ;; No filter for a full document. - (if (eq type 'org-data) - results - (org-export-filter-apply-functions - (eval (intern (format "org-export-filter-%s-functions" type))) - (if (memq type org-element-all-elements) - (concat - (org-element-normalize-string results) - (make-string (org-element-get-property :post-blank blob) 10)) - (concat - results - (make-string - (org-element-get-property :post-blank blob) 32))) - backend))))))) - (org-element-get-contents data) "")) + ;; 4. Return results. + (cond + ((not results) nil) + ;; No filter for a full document. + ((eq type 'org-data) results) + ;; Otherwise, update INFO, append the same white space + ;; between elements or objects as in the original buffer, + ;; and call appropriate filters. + (t + (let ((results + (org-export-filter-apply-functions + (plist-get info (intern (format ":filter-%s" type))) + (let ((post-blank (org-element-property :post-blank blob))) + (if (memq type org-element-all-elements) + (concat (org-element-normalize-string results) + (make-string post-blank ?\n)) + (concat results (make-string post-blank ? )))) + backend info))) + ;; Eventually return string. + results))))))) + (org-element-contents data) "")) (defun org-export-secondary-string (secondary backend info) "Convert SECONDARY string into BACKEND format. @@ -1500,74 +1580,19 @@ (defun org-export-secondary-string (secondary backend info) SECONDARY is a nested list as returned by `org-element-parse-secondary-string'. -BACKEND is a symbol among supported exporters. - -INFO is a plist holding export options and also used as -a communication channel between elements when walking the nested -list. See `org-export-update-info' function for more -details. +BACKEND is a symbol among supported exporters. INFO is a plist +used as a communication channel. Return transcoded string." ;; Make SECONDARY acceptable for `org-export-data'. (let ((s (if (listp secondary) secondary (list secondary)))) (org-export-data `(org-data nil ,@s) backend (copy-sequence info)))) -(defun org-export-skip-p (blob info) - "Non-nil when element or object BLOB should be skipped during export. -INFO is the plist holding export options." - ;; Check headline. - (unless (stringp blob) - (case (car blob) - ('headline - (let ((with-tasks (plist-get info :with-tasks)) - (todo (org-element-get-property :todo-keyword blob)) - (todo-type (org-element-get-property :todo-type blob)) - (archived (plist-get info :with-archived-trees)) - (tag-list (let ((tags (org-element-get-property :tags blob))) - (and tags (org-split-string tags ":"))))) - (or - ;; Ignore subtrees with an exclude tag. - (loop for k in (plist-get info :exclude-tags) - thereis (member k tag-list)) - ;; Ignore subtrees without a select tag, when such tag is found - ;; in the buffer. - (and (plist-get info :use-select-tags) - (loop for k in (plist-get info :select-tags) - never (member k tag-list))) - ;; Ignore commented sub-trees. - (org-element-get-property :commentedp blob) - ;; Ignore archived subtrees if `:with-archived-trees' is nil. - (and (not archived) (org-element-get-property :archivedp blob)) - ;; Ignore tasks, if specified by `:with-tasks' property. - (and todo (not with-tasks)) - (and todo - (memq with-tasks '(todo done)) - (not (eq todo-type with-tasks))) - (and todo - (consp with-tasks) - (not (member todo with-tasks)))))) - ;; Check time-stamp. - ('time-stamp (not (plist-get info :with-timestamps))) - ;; Check drawer. - ('drawer - (or (not (plist-get info :with-drawers)) - (and (consp (plist-get info :with-drawers)) - (not (member (org-element-get-property :drawer-name blob) - (plist-get info :with-drawers)))))) - ;; Check export snippet. - ('export-snippet - (let* ((raw-back-end (org-element-get-property :back-end blob)) - (true-back-end - (or (cdr (assoc raw-back-end org-export-snippet-translation-alist)) - raw-back-end))) - (not (string= (symbol-name (plist-get info :back-end)) - true-back-end))))))) - (defun org-export-interpret-p (blob info) "Non-nil if element or object BLOB should be interpreted as Org syntax. Check is done according to export options INFO, stored as a plist." - (case (car blob) + (case (org-element-type blob) ;; ... entities... (entity (plist-get info :with-entities)) ;; ... emphasis... @@ -1581,7 +1606,7 @@ (defun org-export-interpret-p (blob info) ((subscript superscript) (let ((sub/super-p (plist-get info :with-sub-superscript))) (if (eq sub/super-p '{}) - (org-element-get-property :use-brackets-p blob) + (org-element-property :use-brackets-p blob) sub/super-p))) ;; ... tables... (table (plist-get info :with-tables)) @@ -1591,8 +1616,15 @@ (defsubst org-export-expand (blob contents) "Expand a parsed element or object to its original state. BLOB is either an element or an object. CONTENTS is its contents, as a string or nil." - (funcall - (intern (format "org-element-%s-interpreter" (car blob))) blob contents)) + (funcall (intern (format "org-element-%s-interpreter" (org-element-type blob))) + 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)))) @@ -1605,7 +1637,8 @@ (defsubst org-export-expand (blob contents) ;; Every set is back-end agnostic. Although, a filter is always ;; called, in addition to the string it applies to, with the back-end ;; used as argument, so it's easy enough for the end-user to add -;; back-end specific filters in the set. +;; back-end specific filters in the set. The communication channel, +;; as a plist, is required as the third argument. ;; Filters sets are defined below. There are of four types: @@ -1621,298 +1654,375 @@ (defsubst org-export-expand (blob contents) ;; All filters sets are applied through ;; `org-export-filter-apply-functions' function. Filters in a set are -;; applied in reverse order, that is in the order of consing. It -;; allows developers to be reasonably sure that their filters will be -;; applied first. +;; applied in a LIFO fashion. It allows developers to be sure that +;; their filters will be applied first. + +;; Filters properties are installed in communication channel just +;; before parsing, with `org-export-install-filters' function. ;;;; Special Filters (defvar org-export-filter-parse-tree-functions nil "Filter, or list of filters, applied to the parsed tree. -Each filter is called with two arguments: the parse tree, as -returned by `org-element-parse-buffer', and the back-end as -a symbol. It must return the modified parse tree to transcode.") +Each filter is called with three arguments: the parse tree, as +returned by `org-element-parse-buffer', the back-end, as +a symbol, and the communication channel, as a plist. It must +return the modified parse tree to transcode.") (defvar org-export-filter-final-output-functions nil "Filter, or list of filters, applied to the transcoded string. -Each filter is called with two arguments: the full transcoded -string, and the back-end as a symbol. It must return a string -that will be used as the final export output.") +Each filter is called with three arguments: the full transcoded +string, the back-end, as a symbol, and the communication channel, +as a plist. It must return a string that will be used as the +final export output.") (defvar org-export-filter-plain-text-functions nil "Filter, or list of filters, applied to plain text. -Each filter is called with two arguments: a string which contains -no Org syntax, and the back-end as a symbol. It must return -a string or nil.") +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.") ;;;; Elements Filters (defvar org-export-filter-center-block-functions nil - "Filter, or list of filters, applied to a transcoded center block. -Each filter is called with two arguments: the transcoded center -block, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded center block. +Each filter is called with three arguments: the transcoded center +block, 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-drawer-functions nil - "Filter, or list of filters, applied to a transcoded drawer. -Each filter is called with two arguments: the transcoded drawer, -as a string, and the back-end, as a symbol. It must return -a string or nil.") + "List of functions applied to a transcoded drawer. +Each filter is called with three arguments: the transcoded +drawer, 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-dynamic-block-functions nil - "Filter, or list of filters, applied to a transcoded dynamic-block. -Each filter is called with two arguments: the transcoded -dynamic-block, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded dynamic-block. +Each filter is called with three arguments: the transcoded +dynamic-block, 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-headline-functions nil - "Filter, or list of filters, applied to a transcoded headline. -Each filter is called with two arguments: the transcoded -headline, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded headline. +Each filter is called with three arguments: the transcoded +headline, 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-inlinetask-functions nil - "Filter, or list of filters, applied to a transcoded inlinetask. -Each filter is called with two arguments: the transcoded -inlinetask, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded inlinetask. +Each filter is called with three arguments: the transcoded +inlinetask, 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-plain-list-functions nil - "Filter, or list of filters, applied to a transcoded plain-list. -Each filter is called with two arguments: the transcoded -plain-list, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded plain-list. +Each filter is called with three arguments: the transcoded +plain-list, 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-item-functions nil - "Filter, or list of filters, applied to a transcoded item. -Each filter is called with two arguments: the transcoded item, as -a string, and the back-end, as a symbol. It must return a string -or nil.") + "List of functions applied to a transcoded item. +Each filter is called with three arguments: the transcoded item, +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 - "Filter, or list of filters, applied to a transcoded comment. -Each filter is called with two arguments: the transcoded comment, -as a string, and the back-end, as a symbol. It must return -a string or nil.") + "List of functions applied to a transcoded comment. +Each filter is called with three arguments: the transcoded +comment, 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 - "Filter, or list of filters, applied to a transcoded comment-comment. -Each filter is called with two arguments: the transcoded -comment-block, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded comment-comment. +Each filter is called with three arguments: the transcoded +comment-block, 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-example-block-functions nil - "Filter, or list of filters, applied to a transcoded example-block. -Each filter is called with two arguments: the transcoded -example-block, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded example-block. +Each filter is called with three arguments: the transcoded +example-block, 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-export-block-functions nil - "Filter, or list of filters, applied to a transcoded export-block. -Each filter is called with two arguments: the transcoded -export-block, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded export-block. +Each filter is called with three arguments: the transcoded +export-block, 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-fixed-width-functions nil - "Filter, or list of filters, applied to a transcoded fixed-width. -Each filter is called with two arguments: the transcoded -fixed-width, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded fixed-width. +Each filter is called with three arguments: the transcoded +fixed-width, 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-footnote-definition-functions nil - "Filter, or list of filters, applied to a transcoded footnote-definition. -Each filter is called with two arguments: the transcoded -footnote-definition, as a string, and the back-end, as a symbol. -It must return a string or nil.") + "List of functions applied to a transcoded footnote-definition. +Each filter is called with three arguments: the transcoded +footnote-definition, 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-horizontal-rule-functions nil - "Filter, or list of filters, applied to a transcoded horizontal-rule. -Each filter is called with two arguments: the transcoded -horizontal-rule, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded horizontal-rule. +Each filter is called with three arguments: the transcoded +horizontal-rule, 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-keyword-functions nil - "Filter, or list of filters, applied to a transcoded keyword. -Each filter is called with two arguments: the transcoded keyword, -as a string, and the back-end, as a symbol. It must return -a string or nil.") + "List of functions applied to a transcoded keyword. +Each filter is called with three arguments: the transcoded +keyword, 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-latex-environment-functions nil - "Filter, or list of filters, applied to a transcoded latex-environment. -Each filter is called with two arguments: the transcoded -latex-environment, as a string, and the back-end, as a symbol. -It must return a string or nil.") + "List of functions applied to a transcoded latex-environment. +Each filter is called with three arguments: the transcoded +latex-environment, 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-babel-call-functions nil - "Filter, or list of filters, applied to a transcoded babel-call. -Each filter is called with two arguments: the transcoded -babel-call, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded babel-call. +Each filter is called with three arguments: the transcoded +babel-call, 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-paragraph-functions nil - "Filter, or list of filters, applied to a transcoded paragraph. -Each filter is called with two arguments: the transcoded -paragraph, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded paragraph. +Each filter is called with three arguments: the transcoded +paragraph, 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-property-drawer-functions nil - "Filter, or list of filters, applied to a transcoded property-drawer. -Each filter is called with two arguments: the transcoded -property-drawer, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded property-drawer. +Each filter is called with three arguments: the transcoded +property-drawer, 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-block-functions nil - "Filter, or list of filters, applied to a transcoded quote block. -Each filter is called with two arguments: the transcoded quote -block, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded quote block. +Each filter is called with three arguments: the transcoded quote +block, 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 - "Filter, or list of filters, applied to a transcoded quote-section. -Each filter is called with two arguments: the transcoded -quote-section, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded quote-section. +Each filter is called with three arguments: the transcoded +quote-section, 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 +section, 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-special-block-functions nil - "Filter, or list of filters, applied to a transcoded special block. -Each filter is called with two arguments: the transcoded special -block, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded special block. +Each filter is called with three arguments: the transcoded +special block, 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-src-block-functions nil - "Filter, or list of filters, applied to a transcoded src-block. -Each filter is called with two arguments: the transcoded -src-block, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded src-block. +Each filter is called with three arguments: the transcoded +src-block, 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-table-functions nil - "Filter, or list of filters, applied to a transcoded table. -Each filter is called with two arguments: the transcoded table, -as a string, and the back-end, as a symbol. It must return -a string or nil.") + "List of functions applied to a transcoded table. +Each filter is called with three arguments: the transcoded table, +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-verse-block-functions nil - "Filter, or list of filters, applied to a transcoded verse block. -Each filter is called with two arguments: the transcoded verse -block, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded verse block. +Each filter is called with three arguments: the transcoded verse +block, as a string, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") ;;;; Objects Filters (defvar org-export-filter-emphasis-functions nil - "Filter, or list of filters, applied to a transcoded emphasis. -Each filter is called with two arguments: the transcoded -emphasis, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded emphasis. +Each filter is called with three arguments: the transcoded +emphasis, 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-entity-functions nil - "Filter, or list of filters, applied to a transcoded entity. -Each filter is called with two arguments: the transcoded entity, -as a string, and the back-end, as a symbol. It must return -a string or nil.") + "List of functions applied to a transcoded entity. +Each filter is called with three arguments: the transcoded +entity, 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-export-snippet-functions nil - "Filter, or list of filters, applied to a transcoded export-snippet. -Each filter is called with two arguments: the transcoded -export-snippet, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded export-snippet. +Each filter is called with three arguments: the transcoded +export-snippet, 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-footnote-reference-functions nil - "Filter, or list of filters, applied to a transcoded footnote-reference. -Each filter is called with two arguments: the transcoded -footnote-reference, as a string, and the back-end, as a symbol. -It must return a string or nil.") + "List of functions applied to a transcoded footnote-reference. +Each filter is called with three arguments: the transcoded +footnote-reference, 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-inline-babel-call-functions nil - "Filter, or list of filters, applied to a transcoded inline-babel-call. -Each filter is called with two arguments: the transcoded -inline-babel-call, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded inline-babel-call. +Each filter is called with three arguments: the transcoded +inline-babel-call, 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-inline-src-block-functions nil - "Filter, or list of filters, applied to a transcoded inline-src-block. -Each filter is called with two arguments: the transcoded -inline-src-block, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded inline-src-block. +Each filter is called with three arguments: the transcoded +inline-src-block, 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-latex-fragment-functions nil - "Filter, or list of filters, applied to a transcoded latex-fragment. -Each filter is called with two arguments: the transcoded -latex-fragment, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded latex-fragment. +Each filter is called with three arguments: the transcoded +latex-fragment, 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-line-break-functions nil - "Filter, or list of filters, applied to a transcoded line-break. -Each filter is called with two arguments: the transcoded -line-break, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded line-break. +Each filter is called with three arguments: the transcoded +line-break, 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-link-functions nil - "Filter, or list of filters, applied to a transcoded link. -Each filter is called with two arguments: the transcoded link, as -a string, and the back-end, as a symbol. It must return a string -or nil.") + "List of functions applied to a transcoded link. +Each filter is called with three arguments: the transcoded link, +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-macro-functions nil - "Filter, or list of filters, applied to a transcoded macro. -Each filter is called with two arguments: the transcoded macro, -as a string, and the back-end, as a symbol. It must return -a string or nil.") + "List of functions applied to a transcoded macro. +Each filter is called with three arguments: the transcoded macro, +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-radio-target-functions nil - "Filter, or list of filters, applied to a transcoded radio-target. -Each filter is called with two arguments: the transcoded -radio-target, as a string, and the back-end, as a symbol. It -must return a string or nil.") + "List of functions applied to a transcoded radio-target. +Each filter is called with three arguments: the transcoded +radio-target, 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-statistics-cookie-functions nil - "Filter, or list of filters, applied to a transcoded statistics-cookie. -Each filter is called with two arguments: the transcoded -statistics-cookie, as a string, and the back-end, as a symbol. -It must return a string or nil.") + "List of functions applied to a transcoded statistics-cookie. +Each filter is called with three arguments: the transcoded +statistics-cookie, 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-subscript-functions nil - "Filter, or list of filters, applied to a transcoded subscript. -Each filter is called with two arguments: the transcoded -subscript, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded subscript. +Each filter is called with three arguments: the transcoded +subscript, 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-superscript-functions nil - "Filter, or list of filters, applied to a transcoded superscript. -Each filter is called with two arguments: the transcoded -superscript, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded superscript. +Each filter is called with three arguments: the transcoded +superscript, 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-target-functions nil - "Filter, or list of filters, applied to a transcoded target. -Each filter is called with two arguments: the transcoded target, -as a string, and the back-end, as a symbol. It must return -a string or nil.") + "List of functions applied to a transcoded target. +Each filter is called with three arguments: the transcoded +target, 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-time-stamp-functions nil - "Filter, or list of filters, applied to a transcoded time-stamp. -Each filter is called with two arguments: the transcoded -time-stamp, as a string, and the back-end, as a symbol. It must -return a string or nil.") + "List of functions applied to a transcoded time-stamp. +Each filter is called with three arguments: the transcoded +time-stamp, 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-verbatim-functions nil - "Filter, or list of filters, applied to a transcoded verbatim. -Each filter is called with two arguments: the transcoded -verbatim, as a string, and the back-end, as a symbol. It must -return a string or nil.") - -(defun org-export-filter-apply-functions (filters value backend) - "Call every function in FILTERS with arguments VALUE and BACKEND. -Functions are called in reverse order, to be reasonably sure that -developer-specified filters, if any, are called first." - ;; Ensure FILTERS is a list. - (let ((filters (if (listp filters) (reverse filters) (list filters)))) - (loop for filter in filters - if (not value) return nil else - do (setq value (funcall filter value backend)))) + "List of functions applied to a transcoded verbatim. +Each filter is called with three arguments: the transcoded +verbatim, as a string, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defun org-export-filter-apply-functions (filters value backend info) + "Call every function in FILTERS with arguments VALUE, BACKEND and INFO. +Functions are called in a LIFO fashion, to be sure that developer +specified filters, if any, are called first." + (loop for filter in filters + if (not value) return nil else + do (setq value (funcall filter value backend info))) value) +(defun org-export-install-filters (backend info) + "Install filters properties in communication channel. + +BACKEND is a symbol specifying which back-end specific filters to +install, if any. INFO is a plist containing the current +communication channel. + +Return the updated communication channel." + (let (plist) + ;; Install user defined filters with `org-export-filters-alist'. + (mapc (lambda (p) + (setq plist (plist-put plist (car p) (eval (cdr p))))) + org-export-filters-alist) + ;; Prepend back-end specific filters to that list. + (let ((back-end-filters (intern (format "org-%s-filters-alist" backend)))) + (when (boundp back-end-filters) + (mapc (lambda (p) + ;; Single values get consed, lists are prepended. + (let ((key (car p)) (value (cdr p))) + (when value + (setq plist + (plist-put + plist key + (if (atom value) (cons value (plist-get plist key)) + (append value (plist-get plist key)))))))) + (eval back-end-filters)))) + ;; Return new communication channel. + (org-combine-plists info plist))) + ;;; Core functions @@ -1921,13 +2031,27 @@ (defun org-export-filter-apply-functions (filters value backend) ;; its derivatives, `org-export-to-buffer' and `org-export-to-file'. ;; They differ only by the way they output the resulting code. +;; `org-export-output-file-name' is an auxiliary function meant to be +;; used with `org-export-to-file'. With a given extension, it tries +;; to provide a canonical file name to write export output to. + ;; Note that `org-export-as' doesn't really parse the current buffer, ;; but a copy of it (with the same buffer-local variables and -;; visibility), where Babel blocks are executed, if appropriate. +;; visibility), where include keywords are expanded and Babel blocks +;; are executed, if appropriate. ;; `org-export-with-current-buffer-copy' macro prepares that copy. -(defun org-export-as (backend - &optional subtreep visible-only body-only ext-plist) +;; File inclusion is taken care of by +;; `org-export-expand-include-keyword' and +;; `org-export-prepare-file-contents'. Structure wise, including +;; a whole Org file in a buffer often makes little sense. For +;; example, if the file contains an headline and the include keyword +;; was within an item, the item should contain the headline. That's +;; why file inclusion should be done before any structure can be +;; associated to the file, that is before parsing. + +(defun org-export-as + (backend &optional subtreep visible-only body-only ext-plist noexpand) "Transcode current Org buffer into BACKEND code. If narrowing is active in the current buffer, only transcode its @@ -1945,59 +2069,67 @@ (defun org-export-as (backend When optional argument BODY-ONLY is non-nil, only return body code, without preamble nor postamble. -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Optional argument NOEXPAND, when non-nil, prevents included files +to be expanded and Babel code to be executed. Return code as a string." (save-excursion (save-restriction ;; Narrow buffer to an appropriate region for parsing. - (when (org-region-active-p) - (narrow-to-region (region-beginning) (region-end))) - (goto-char (point-min)) - (when subtreep - (unless (org-at-heading-p) - (org-with-limited-levels (outline-next-heading))) - (let ((end (save-excursion (org-end-of-subtree t))) - (begin (progn (forward-line) - (org-skip-whitespace) - (point-at-bol)))) - (narrow-to-region begin end))) - ;; Retrieve export options (INFO) and parsed tree (RAW-DATA). + (cond ((org-region-active-p) + (narrow-to-region (region-beginning) (region-end))) + (subtreep (org-narrow-to-subtree))) + ;; Retrieve export options (INFO) and parsed tree (RAW-DATA), + ;; Then options can be completed with tree properties. Note: ;; Buffer isn't parsed directly. Instead, a temporary copy is - ;; created, where all code blocks are evaluated. RAW-DATA is - ;; the parsed tree of the buffer resulting from that process. - ;; Eventually call `org-export-filter-parse-tree-functions'.. - (let ((info (org-export-collect-options backend subtreep ext-plist)) - (raw-data (org-export-filter-apply-functions - org-export-filter-parse-tree-functions - (org-export-with-current-buffer-copy - (org-export-blocks-preprocess) - (org-element-parse-buffer nil visible-only)) - backend))) - ;; Initialize the communication system and combine it to INFO. + ;; created, where include keywords are expanded and code blocks + ;; are evaluated. RAW-DATA is the parsed tree of the buffer + ;; resulting from that process. Eventually call + ;; `org-export-filter-parse-tree-functions'. + (goto-char (point-min)) + (let ((info (org-export-get-environment backend subtreep ext-plist))) + ;; Remove subtree's headline from contents if subtree mode is + ;; activated. + (when subtreep (forward-line) (narrow-to-region (point) (point-max))) + ;; Install filters in communication channel. + (setq info (org-export-install-filters backend info)) + (let ((raw-data + (org-export-filter-apply-functions + (plist-get info :filter-parse-tree) + ;; If NOEXPAND is non-nil, simply parse current + ;; visible part of buffer. + (if noexpand (org-element-parse-buffer nil visible-only) + (org-export-with-current-buffer-copy + (org-export-expand-include-keyword) + (let ((org-current-export-file (current-buffer))) + (org-export-blocks-preprocess)) + (org-element-parse-buffer nil visible-only))) + backend info))) + ;; Complete communication channel with tree properties. (setq info (org-combine-plists info - (org-export-initialize-persistent-properties - raw-data info backend))) - ;; Now transcode RAW-DATA. Also call + (org-export-collect-tree-properties raw-data info backend))) + ;; Transcode RAW-DATA. Also call ;; `org-export-filter-final-output-functions'. - (let ((body (org-element-normalize-string - (org-export-data raw-data backend info))) - (template (intern (format "org-%s-template" backend)))) - (if (and (not body-only) (fboundp template)) - (org-trim - (org-export-filter-apply-functions - org-export-filter-final-output-functions - (funcall template body info) - backend)) - (org-export-filter-apply-functions - org-export-filter-final-output-functions body backend))))))) - -(defun org-export-to-buffer (backend buffer &optional subtreep visible-only - body-only ext-plist) + (let* ((body (org-element-normalize-string + (org-export-data raw-data backend info))) + (template (intern (format "org-%s-template" backend))) + (output (org-export-filter-apply-functions + (plist-get info :filter-final-output) + (if (or (not (fboundp template)) body-only) body + (funcall template body info)) + backend info))) + ;; Maybe add final OUTPUT to kill ring before returning it. + (when org-export-copy-to-kill-ring (org-kill-new output)) + output)))))) + +(defun org-export-to-buffer + (backend buffer &optional subtreep visible-only body-only ext-plist noexpand) "Call `org-export-as' with output to a specified buffer. BACKEND is the back-end used for transcoding, as a symbol. @@ -2005,11 +2137,13 @@ (defun org-export-to-buffer (backend buffer &optional subtreep visible-only BUFFER is the output buffer. If it already exists, it will be erased first, otherwise, it will be created. -Arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and EXT-PLIST are -similar to those used in `org-export-as', which see. +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST +and NOEXPAND are similar to those used in `org-export-as', which +see. Return buffer." - (let ((out (org-export-as backend subtreep visible-only body-only ext-plist)) + (let ((out (org-export-as + backend subtreep visible-only body-only ext-plist noexpand)) (buffer (get-buffer-create buffer))) (with-current-buffer buffer (erase-buffer) @@ -2017,41 +2151,77 @@ (defun org-export-to-buffer (backend buffer &optional subtreep visible-only (goto-char (point-min))) buffer)) -(defun org-export-to-file (backend filename &optional post-process subtreep - visible-only body-only ext-plist) +(defun org-export-to-file + (backend file &optional subtreep visible-only body-only ext-plist noexpand) "Call `org-export-as' with output to a specified file. -BACKEND is the back-end used for transcoding, as a symbol. - -FILENAME is the output file name. If it already exists, it will -be erased first, unless it isn't writable, in which case an error -will be returned. Otherwise, the file will be created. +BACKEND is the back-end used for transcoding, as a symbol. FILE +is the name of the output file, as a string. -Optional argument POST-PROCESS, when non-nil, is a function -applied to the output file. It expects one argument: the file -name, as a string. It can be used to call shell commands on that -file, display a specific buffer, etc. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST +and NOEXPAND are similar to those used in `org-export-as', which see. -Return file name." - ;; Checks for file and directory permissions. - (cond - ((not (file-exists-p filename)) - (let ((dir (or (file-name-directory filename) default-directory))) - (unless (file-writable-p dir) (error "Output directory not writable")))) - ((not (file-writable-p filename)) (error "Output file not writable"))) - ;; All checks passed: insert contents to a temporary buffer and - ;; write it to the specified file. - (let ((out (org-export-as backend subtreep visible-only body-only ext-plist))) +Return output file's name." + ;; Checks for FILE permissions. `write-file' would do the same, but + ;; we'd rather avoid needless transcoding of parse tree. + (unless (file-writable-p file) (error "Output file not writable")) + ;; Insert contents to a temporary buffer and write it to FILE. + (let ((out (org-export-as + backend subtreep visible-only body-only ext-plist noexpand))) (with-temp-buffer (insert out) - (write-file filename))) - (when post-process (funcall post-process filename)) - ;; Return value. - filename) + (let ((coding-system-for-write org-export-coding-system)) + (write-file file)))) + ;; Return full path. + file) + +(defun org-export-output-file-name (extension &optional subtreep pub-dir) + "Return output file's name according to buffer specifications. + +EXTENSION is a string representing the output file extension, +with the leading dot. + +With a non-nil optional argument SUBTREEP, try to determine +output file's name by looking for \"EXPORT_FILE_NAME\" property +of subtree at point. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +Return file name as a string, or nil if it couldn't be +determined." + (let ((base-name + ;; File name may come from EXPORT_FILE_NAME subtree property, + ;; assuming point is at beginning of said sub-tree. + (file-name-sans-extension + (or (and subtreep + (org-entry-get + (save-excursion + (ignore-errors + (org-back-to-heading (not visible-only)) (point))) + "EXPORT_FILE_NAME" t)) + ;; File name may be extracted from buffer's associated + ;; file, if any. + (buffer-file-name (buffer-base-buffer)) + ;; Can't determine file name on our own: Ask user. + (let ((read-file-name-function + (and org-completion-use-ido 'ido-read-file-name))) + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (name) + (string= (file-name-extension name t) extension)))))))) + ;; Build file name. Enforce EXTENSION over whatever user may have + ;; come up with. PUB-DIR, if defined, always has precedence over + ;; any provided path. + (cond + (pub-dir + (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name) + extension)) + ((string= (file-name-nondirectory base-name) base-name) + (concat (file-name-as-directory ".") base-name extension)) + (t (concat base-name extension))))) (defmacro org-export-with-current-buffer-copy (&rest body) "Apply BODY in a copy of the current buffer. @@ -2069,7 +2239,8 @@ (defmacro org-export-with-current-buffer-copy (&rest body) (with-temp-buffer (let ((buffer-invisibility-spec nil)) (org-clone-local-variables - ,original-buffer "^\\(org-\\|orgtbl-\\|major-mode$\\)") + ,original-buffer + "^\\(org-\\|orgtbl-\\|major-mode$\\|outline-\\(regexp\\|level\\)$\\)") (insert ,buffer-string) (mapc (lambda (ov) (move-overlay @@ -2082,6 +2253,160 @@ (defmacro org-export-with-current-buffer-copy (&rest body) (progn ,@body)))))) (def-edebug-spec org-export-with-current-buffer-copy (body)) +(defun org-export-expand-include-keyword (&optional included dir) + "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)) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+INCLUDE: \\(.*\\)" nil t) + (when (eq (org-element-type (save-match-data (org-element-at-point))) + 'keyword) + (beginning-of-line) + ;; Extract arguments from keyword's value. + (let* ((value (match-string 1)) + (ind (org-get-indentation)) + (file (and (string-match "^\"\\(\\S-+\\)\"" value) + (prog1 (expand-file-name (match-string 1 value) dir) + (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 "\\" value) 'example) + ((string-match "\\ level limit) (- level limit)))))) + (defun org-export-get-headline-number (headline info) "Return HEADLINE numbering as a list of numbers. INFO is a plist holding contextual information." - (cdr (assq (org-element-get-property :begin headline) - (plist-get info :headline-numbering)))) + (cdr (assoc 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))) (defun org-export-number-to-roman (n) "Convert integer N into a roman numeral." @@ -2212,123 +2638,13 @@ (defun org-export-number-to-roman (n) (defun org-export-first-sibling-p (headline info) "Non-nil when HEADLINE is the first sibling in its sub-tree. INFO is the plist used as a communication channel." - (not (eq (plist-get info :previous-element) 'headline))) + (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 the plist used as a communication channel." - (= (org-element-get-property :end headline) - (or (plist-get (plist-get info :parent-properties) :end) - (plist-get info :point-max)))) - - -;;;; For Include Keywords - -;; This section provides a tool to properly handle insertion of files -;; during export: `org-export-included-files'. It recursively -;; transcodes a file specfied by an include keyword. - -;; It uses two helper functions: `org-export-get-file-contents' -;; returns contents of a file according to parameters specified in the -;; keyword while `org-export-parse-included-file' parses the file -;; specified by it. - -(defun org-export-included-file (keyword backend info) - "Transcode file specified with include KEYWORD. - -KEYWORD is the include keyword element transcoded. BACKEND is -the language back-end used for transcoding. INFO is the plist -used as a communication channel. - -This function updates `:included-files' and `:headline-offset' -properties. - -Return the transcoded string." - (let ((data (org-export-parse-included-file keyword info)) - (file (let ((value (org-element-get-property :value keyword))) - (and (string-match "^\"\\(\\S-+\\)\"" value) - (match-string 1 value))))) - (org-element-normalize-string - (org-export-data - data backend - (org-combine-plists - info - ;; Store full path of already included files to avoid - ;; recursive file inclusion. - `(:included-files - ,(cons (expand-file-name file) (plist-get info :included-files)) - ;; Ensure that a top-level headline in the included - ;; file becomes a direct child of the current headline - ;; in the buffer. - :headline-offset - ,(- (+ (plist-get (plist-get info :inherited-properties) :level) - (plist-get info :headline-offset)) - (1- (org-export-get-min-level data info))))))))) - -(defun org-export-get-file-contents (file &optional lines) - "Get the contents of FILE and return them as a string. -When optional argument LINES is a string specifying a range of -lines, include only those lines." - (with-temp-buffer - (insert-file-contents file) - (when lines - (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 (point-min)) - (forward-line (1- lend)) - (point)))) - (narrow-to-region beg end))) - (buffer-string))) - -(defun org-export-parse-included-file (keyword info) - "Parse file specified by include KEYWORD. - -KEYWORD is the include keyword element transcoded. BACKEND is the -language back-end used for transcoding. INFO is the plist used as -a communication channel. - -Return the parsed tree." - (let* ((value (org-element-get-property :value keyword)) - (file (and (string-match "^\"\\(\\S-+\\)\"" value) - (prog1 (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 "\\" value) "example") - ((string-match "\\>) or + element (i.e. \"#+target: path\"), return it. -- If LINK path exactly matches any headline name, return - headline's beginning position as the identifier. 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. +- If LINK path exactly matches the name affiliated keyword + \(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. - Otherwise, return nil. Assume LINK type is \"fuzzy\"." - (let ((path (org-element-get-property :path link))) - (if (member path (plist-get info :target-list)) - ;; Link points to a target: return its name as a string. - path - ;; Link either points to an headline or nothing. Try to find - ;; the source, with priority given to headlines with the closest - ;; common ancestor. If such candidate is found, return its - ;; beginning position as an unique identifier, otherwise return - ;; nil. - (let* ((head-alist (plist-get info :headline-alist)) - (link-begin (org-element-get-property :begin link)) - (link-end (org-element-get-property :end link)) - ;; Store candidates as a list of cons cells holding their - ;; beginning and ending position. - (cands (loop for head in head-alist - when (string= (car head) path) - collect (cons (nth 1 head) (nth 2 head))))) - (cond - ;; No candidate: return nil. - ((not cands) nil) - ;; If one or more candidates share common ancestors with - ;; LINK, return beginning position of the first one matching - ;; the closer ancestor shared. - ((let ((ancestors (loop for head in head-alist - when (and (> link-begin (nth 1 head)) - (<= link-end (nth 2 head))) - collect (cons (nth 1 head) (nth 2 head))))) - (loop named main for ancestor in (nreverse ancestors) do - (loop for candidate in cands - when (and (>= (car candidate) (car ancestor)) - (<= (cdr candidate) (cdr ancestor))) - do (return-from main (car candidate)))))) - ;; No candidate have a common ancestor with link: First match - ;; will do. Return its beginning position. - (t (caar cands))))))) + (let ((path (org-element-property :path link))) + (cond + ;; First try to find a matching "<>" unless user specified + ;; he was looking for an headline (path starts with a * + ;; character). + ((and (not (eq (substring path 0 1) ?*)) + (loop for target in (plist-get info :target-list) + when (string= (org-element-property :value target) path) + return target))) + ;; Then try to find an element with a matching "#+name: path" + ;; affiliated keyword. + ((and (not (eq (substring path 0 1) ?*)) + (org-element-map + (plist-get info :parse-tree) org-element-all-elements + (lambda (el) + (when (string= (org-element-property :name el) path) el)) + info 'first-match))) + ;; Last case: link either points to an 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 its beginning position as an unique + ;; identifier, otherwise return nil. + (t + (let ((find-headline + (function + ;; Return first headline whose `:raw-value' property + ;; is NAME in parse tree DATA, or nil. + (lambda (name data) + (org-element-map + data 'headline + (lambda (headline) + (when (string= + (org-element-property :raw-value headline) + name) + headline)) + info 'first-match))))) + ;; Search among headlines sharing an ancestor with link, + ;; from closest to farthest. + (or (catch 'exit + (mapc + (lambda (parent) + (when (eq (org-element-type parent) 'headline) + (let ((foundp (funcall find-headline path parent))) + (when foundp (throw 'exit foundp))))) + (org-export-get-genealogy link info)) nil) + ;; No match with a common ancestor: try the full parse-tree. + (funcall find-headline path (plist-get info :parse-tree)))))))) + +(defun org-export-resolve-id-link (link info) + "Return headline referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be an headline element or nil. Assume LINK type +is either \"id\" or \"custom-id\"." + (let ((id (org-element-property :path link))) + (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)) + headline)) + info 'first-match))) + +(defun org-export-resolve-coderef (ref info) + "Resolve a code reference REF. + +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)) ;;;; For Macros @@ -2435,9 +2829,17 @@ (defun org-export-resolve-fuzzy-link (link info) (defun org-export-expand-macro (macro info) "Expand MACRO and return it as a string. INFO is a plist holding export options." - (let* ((key (org-element-get-property :key macro)) - (args (org-element-get-property :args macro)) - (value (plist-get info (intern (format ":macro-%s" key))))) + (let* ((key (org-element-property :key macro)) + (args (org-element-property :args macro)) + ;; User's macros are stored in the communication channel with + ;; a ":macro-" prefix. If it's a string leave it as-is. + ;; Otherwise, it's a secondary string that needs to be + ;; expanded recursively. + (value + (let ((val (plist-get info (intern (format ":macro-%s" key))))) + (if (stringp val) val + (org-export-secondary-string + val (plist-get info :back-end) info))))) ;; Replace arguments in VALUE. (let ((s 0) n) (while (string-match "\\$\\([0-9]+\\)" value s) @@ -2448,8 +2850,8 @@ (defun org-export-expand-macro (macro info) ;; VALUE starts with "(eval": it is a s-exp, `eval' it. (when (string-match "\\`(eval\\>" value) (setq value (eval (read value)))) - ;; Return expanded string. - (format "%s" value))) + ;; Return string. + (format "%s" (or value "")))) ;;;; For References @@ -2457,164 +2859,245 @@ (defun org-export-expand-macro (macro info) ;; `org-export-get-ordinal' associates a sequence number to any object ;; or element. -(defun org-export-get-ordinal (element info &optional within-section predicate) +(defun org-export-get-ordinal (element info &optional types predicate) "Return ordinal number of an element or object. ELEMENT is the element or object considered. INFO is the plist used as a communication channel. -When optional argument WITHIN-SECTION is non-nil, narrow counting -to the section containing ELEMENT. +Optional argument TYPES, when non-nil, is a list of element or +object types, as symbols, that should also be counted in. +Otherwise, only provided element's type is considered. Optional argument PREDICATE is a function returning a non-nil value if the current element or object should be counted in. It -accepts one argument: the element or object being considered. -This argument allows to count only a certain type of objects, -like inline images, which are a subset of links \(in that case, -`org-export-inline-image-p' might be an useful predicate\)." - (let ((counter 0) - (type (car element)) - ;; Determine if search should apply to current section, in - ;; which case it should be retrieved first, or to full parse - ;; tree. As a special case, an element or object without - ;; a parent headline will also trigger a full search, - ;; notwithstanding WITHIN-SECTION value. - (data - (let ((parse-tree (plist-get info :parse-tree))) - (if within-section - (let ((parent (plist-get (plist-get info :inherited-properties) - :begin))) - (if (not parent) parse-tree - (org-element-map - parse-tree 'headline - (lambda (el local) - (when (= (org-element-get-property :begin el) parent) el)) - info 'first-match))) - parse-tree)))) - ;; Increment counter until ELEMENT is found again. +accepts two arguments: the element or object being considered and +the plist used as a communication channel. This allows to count +only a certain type of objects (i.e. inline images). + +Return value is a list of numbers if ELEMENT is an headline or an +item. It is nil for keywords. It represents the footnote number +for footnote definitions and footnote references. If ELEMENT is +a target, return the same value as if ELEMENT was the closest +table, item or headline containing the target. In any other +case, return the sequence number of ELEMENT among elements or +objects of the same type." + ;; A target keyword, representing an invisible target, never has + ;; a sequence number. + (unless (eq (org-element-type element) 'keyword) + ;; Ordinal of a target object refer to the ordinal of the closest + ;; 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 info) + when + (memq + (org-element-type parent) + '(footnote-definition footnote-reference headline item + table)) + return parent))) + (case (org-element-type element) + ;; Special case 1: An headline returns its number as a list. + (headline (org-export-get-headline-number element info)) + ;; Special case 2: An item returns its number as a list. + (item (let ((struct (org-element-property :structure element))) + (org-list-get-item-number + (org-element-property :begin element) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct)))) + ((footnote definition footnote-reference) + (org-export-get-footnote-number element info)) + (otherwise + (let ((counter 0)) + ;; Increment counter until ELEMENT is found again. + (org-element-map + (plist-get info :parse-tree) (or types (org-element-type element)) + (lambda (el) + (cond + ((equal element el) (1+ counter)) + ((not predicate) (incf counter) nil) + ((funcall predicate el info) (incf counter) nil))) + info 'first-match)))))) + + +;;;; For Src-Blocks + +;; `org-export-get-loc' counts number of code lines accumulated in +;; src-block or example-block elements with a "+n" switch until +;; a given element, excluded. Note: "-n" switches reset that count. + +;; `org-export-unravel-code' extracts source code (along with a code +;; references alist) from an `element-block' or `src-block' type +;; element. + +;; `org-export-format-code' applies a formatting function to each line +;; of code, providing relative line number and code reference when +;; appropriate. Since it doesn't access the original element from +;; which the source code is coming, it expects from the code calling +;; it to know if lines should be numbered and if code references +;; should appear. + +;; Eventually, `org-export-format-code-default' is a higher-level +;; function (it makes use of the two previous functions) which handles +;; line numbering and code references inclusion, and returns source +;; code in a format suitable for plain text or verbatim output. + +(defun org-export-get-loc (element info) + "Return accumulated lines of code up to ELEMENT. + +INFO is the plist used as a communication channel. + +ELEMENT is excluded from count." + (let ((loc 0)) (org-element-map - data type - (lambda (el local) + (plist-get info :parse-tree) + `(src-block example-block ,(org-element-type element)) + (lambda (el) (cond - ((and (functionp predicate) (funcall predicate el))) - ((equal element el) (1+ counter)) - (t (incf counter) nil))) - info 'first-match))) + ;; ELEMENT is reached: Quit the loop. + ((equal el element) t) + ;; Only count lines from src-block and example-block elements + ;; with a "+n" or "-n" switch. A "-n" switch resets counter. + ((not (memq (org-element-type el) '(src-block example-block))) nil) + ((let ((linums (org-element-property :number-lines el))) + (when linums + ;; Accumulate locs or reset them. + (let ((lines (org-count-lines + (org-trim (org-element-property :value el))))) + (setq loc (if (eq linums 'new) lines (+ loc lines)))))) + ;; Return nil to stay in the loop. + nil))) + info 'first-match) + ;; Return value. + loc)) +(defun org-export-unravel-code (element) + "Clean source code and extract references out of it. -;;;; For Src-Blocks +ELEMENT has either a `src-block' an `example-block' type. -;; `org-export-handle-code' takes care of line numbering and reference -;; cleaning in source code, when appropriate. It also updates global -;; LOC count (`:total-loc' property) and code references alist -;; (`:code-refs' property). - -(defun org-export-handle-code (code switches info - &optional language num-fmt ref-fmt) - "Handle line numbers and code references in CODE. - -CODE is the string to process. SWITCHES is the option string -determining which changes will be applied to CODE. INFO is the -plist used as a communication channel during export. - -Optional argument LANGUAGE, when non-nil, is a string specifying -code's language. - -If optional argument NUM-FMT is a string, it will be used as -a format string for numbers at beginning of each line. - -If optional argument REF-FMT is a string, it will be used as -a format string for each line of code containing a reference. - -Update the following INFO properties by side-effect: `:total-loc' -and `:code-refs'. - -Return new code as a string." - (let* ((switches (or switches "")) - (numberp (string-match "[-+]n\\>" switches)) - (continuep (string-match "\\+n\\>" switches)) - (total-LOC (if (and numberp (not continuep)) - 0 - (or (plist-get info :total-loc) 0))) - (preserve-indent-p (or org-src-preserve-indentation - (string-match "-i\\>" switches))) - (replace-labels (when (string-match "-r\\>" switches) - (if (string-match "-k\\>" switches) 'keep t))) +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)." + (let* ((line 0) refs ;; Get code and clean it. Remove blank lines at its ;; beginning and end. Also remove protective commas. (code (let ((c (replace-regexp-in-string "\\`\\([ \t]*\n\\)+" "" (replace-regexp-in-string - "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n" code)))) + "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n" + (org-element-property :value element))))) ;; If appropriate, remove global indentation. - (unless preserve-indent-p (setq c (org-remove-indentation c))) + (unless (or org-src-preserve-indentation + (org-element-property :preserve-indent element)) + (setq c (org-remove-indentation c))) ;; Free up the protected lines. Note: Org blocks ;; have commas at the beginning or every line. - (if (string= language "org") + (if (string= (org-element-property :language element) "org") (replace-regexp-in-string "^," "" c) (replace-regexp-in-string "^\\(,\\)\\(:?\\*\\|[ \t]*#\\+\\)" "" c nil nil 1)))) - ;; Split code to process it line by line. - (code-lines (org-split-string code "\n")) - ;; Ensure line numbers will be correctly padded before - ;; applying the format string. - (num-fmt (format (if (stringp num-fmt) num-fmt "%s: ") - (format "%%%ds" - (length (number-to-string - (+ (length code-lines) - total-LOC)))))) ;; Get format used for references. - (label-fmt (or (and (string-match "-l +\"\\([^\"\n]+\\)\"" switches) - (match-string 1 switches)) - org-coderef-label-format)) + (label-fmt (regexp-quote + (or (org-element-property :label-fmt element) + org-coderef-label-format))) ;; Build a regexp matching a loc with a reference. - (with-ref-re (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" - (replace-regexp-in-string - "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t))) - coderefs) + (with-ref-re + (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$" + (replace-regexp-in-string + "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t)))) + ;; Return value. + (cons + ;; Code with references removed. + (org-element-normalize-string + (mapconcat + (lambda (loc) + (incf line) + (if (not (string-match with-ref-re loc)) loc + ;; Ref line: remove ref, and signal its position in REFS. + (push (cons line (match-string 3 loc)) refs) + (replace-match "" nil nil loc 1))) + (org-split-string code "\n") "\n")) + ;; Reference alist. + refs))) + +(defun org-export-format-code (code fun &optional num-lines ref-alist) + "Format CODE by applying FUN line-wise and return it. + +CODE is a string representing the code to format. FUN is +a function. It must accept three arguments: a line of +code (string), the current line number (integer) or nil and the +reference associated to the current line (string) or nil. + +Optional argument NUM-LINES can be an integer representing the +number of code lines accumulated until the current code. Line +numbers passed to FUN will take it into account. If it is nil, +FUN's second argument will always be nil. This number can be +obtained with `org-export-get-loc' function. + +Optional argument REF-ALIST can be an alist between relative line +number (i.e. ignoring NUM-LINES) and the name of the code +reference on it. If it is nil, FUN's third argument will always +be nil. It can be obtained through the use of +`org-export-unravel-code' function." + (let ((--locs (org-split-string code "\n")) + (--line 0)) (org-element-normalize-string - (mapconcat (lambda (loc) - ;; Maybe add line number to current line of code - ;; (LOC). - (when numberp - (setq loc (concat (format num-fmt (incf total-LOC)) loc))) - ;; Take action if at a ref line. - (when (string-match with-ref-re loc) - (let ((ref (match-string 3 loc))) - (setq loc - (cond - ;; Option "-k": don't remove labels. Use - ;; numbers for references when lines are - ;; numbered, use labels otherwise. - ((eq replace-labels 'keep) - (let ((full-ref (format "(%s)" ref))) - (push (cons ref (if numberp total-LOC full-ref)) - coderefs) - (replace-match full-ref nil nil loc 2)) - (replace-match (format "(%s)" ref) nil nil loc 2)) - ;; Option "-r" without "-k": remove labels. - ;; Use numbers for references when lines are - ;; numbered, use labels otherwise. - (replace-labels - (push (cons ref (if numberp total-LOC ref)) - coderefs) - (replace-match "" nil nil loc 1)) - ;; Else: don't remove labels and don't use - ;; numbers for references. - (t - (let ((full-ref (format "(%s)" ref))) - (push (cons ref full-ref) coderefs) - (replace-match full-ref nil nil loc 2))))))) - ;; If REF-FMT is defined, apply it to current LOC. - (when (stringp ref-fmt) (setq loc (format ref-fmt loc))) - ;; Update by side-effect communication channel. - ;; Return updated LOC. - (setq info (org-export-set-property - (org-export-set-property - info :code-refs coderefs) - :total-loc total-LOC)) - loc) - code-lines "\n")))) + (mapconcat + (lambda (--loc) + (incf --line) + (let ((--ref (cdr (assq --line ref-alist)))) + (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) + --locs "\n")))) + +(defun org-export-format-code-default (element info) + "Return source code from ELEMENT, formatted in a standard way. + +ELEMENT is either a `src-block' or `example-block' element. INFO +is a plist used as a communication channel. + +This function takes care of line numbering and code references +inclusion. Line numbers, when applicable, appear at the +beginning of the line, separated from the code by two white +spaces. Code references, on the other hand, appear flushed to +the right, separated by six white spaces from the widest line of +code." + ;; Extract code and references. + (let* ((code-info (org-export-unravel-code element)) + (code (car code-info)) + (code-lines (org-split-string code "\n")) + (refs (and (org-element-property :retain-labels element) + (cdr code-info))) + ;; Handle line numbering. + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0))) + (num-fmt + (and num-start + (format "%%%ds " + (length (number-to-string + (+ (length code-lines) num-start)))))) + ;; Prepare references display, if required. Any reference + ;; should start six columns after the widest line of code, + ;; wrapped with parenthesis. + (max-width + (+ (apply 'max (mapcar 'length code-lines)) + (if (not num-start) 0 (length (format num-fmt num-start)))))) + (org-export-format-code + code + (lambda (loc line-num ref) + (let ((number-str (and num-fmt (format num-fmt line-num)))) + (concat + number-str + loc + (and ref + (concat (make-string + (- (+ 6 max-width) + (+ (length loc) (length number-str))) ? ) + (format "(%s)" ref)))))) + num-start refs))) ;;;; For Tables @@ -2649,7 +3132,6 @@ (defun org-export-table-format-info (table) (mapc (lambda (row) (if (string-match "^[ \t]*|[-+]+|[ \t]*$" row) (incf row-group) - (push row-group rowgroups) ;; Determine if a special column is present by looking ;; for special markers in the first column. More ;; accurately, the first column is considered special @@ -2658,8 +3140,8 @@ (defun org-export-table-format-info (table) (setq special-column-p (cond ((not special-column-p) nil) - ((string-match "^[ \t]*| *\\\\?\\([\#!$*_^]\\) *|" - row) 'special) + ((string-match "^[ \t]*| *\\\\?\\([/#!$*_^]\\) *|" row) + 'special) ((string-match "^[ \t]*| +|" row) special-column-p)))) (cond ;; Read forced alignment and width information, if any, @@ -2667,10 +3149,13 @@ (defun org-export-table-format-info (table) ((org-table-cookie-line-p row) (let ((col 0)) (mapc (lambda (field) - (when (string-match "<\\([lrc]\\)\\([0-9]+\\)?>" field) - (aset align col (match-string 1 field)) - (aset width col (let ((w (match-string 2 field))) - (and w (string-to-number w))))) + (when (string-match + "<\\([lrc]\\)?\\([0-9]+\\)?>" field) + (let ((align-data (match-string 1 field))) + (when align-data (aset align col align-data))) + (let ((w-data (match-string 2 field))) + (when w-data + (aset width col (string-to-number w-data))))) (incf col)) (org-split-string row "[ \t]*|[ \t]*")))) ;; Read column groups information. @@ -2682,7 +3167,9 @@ (defun org-export-table-format-info (table) ((string= ">" field) 'end) ((string= "<>" field) 'start-end))) (incf col)) - (org-split-string row "[ \t]*|[ \t]*")))))) + (org-split-string row "[ \t]*|[ \t]*")))) + ;; Contents line. + (t (push row-group rowgroups)))) (org-split-string table "\n")) ;; Return plist. (list :alignment align @@ -2706,7 +3193,7 @@ (defun org-export-clean-table (table specialp) ((org-table-colgroup-line-p row) nil) ((org-table-cookie-line-p row) nil) ;; Ignore rows starting with a special marker. - ((string-match "^[ \t]*| *[!_^/] *|" row) nil) + ((string-match "^[ \t]*| *[!_^/$] *|" row) nil) ;; Remove special column. ((and specialp (or (string-match "^\\([ \t]*\\)|-+\\+" row) @@ -2731,6 +3218,8 @@ (defun org-export-clean-table (table specialp) (defun org-export-collect-headlines (info &optional n) "Collect headlines in order to build a table of contents. +INFO is a plist used as a communication channel. + When non-nil, optional argument N must be an integer. It specifies the depth of the table of contents. @@ -2738,70 +3227,353 @@ (defun org-export-collect-headlines (info &optional n) (org-element-map (plist-get info :parse-tree) 'headline - (lambda (headline local) + (lambda (headline) ;; Strip contents from HEADLINE. - (let ((relative-level (org-export-get-relative-level headline local))) + (let ((relative-level (org-export-get-relative-level headline info))) (unless (and n (> relative-level n)) headline))) info)) -(defun org-export-collect-elements (type backend info) - "Collect named elements of type TYPE. +(defun org-export-collect-elements (type info &optional predicate) + "Collect referenceable elements of a determined type. -Only elements with a caption or a name are collected. +TYPE can be a symbol or a list of symbols specifying element +types to search. Only elements with a caption or a name are +collected. -BACKEND is the back-end used to transcode their caption or name. -INFO is a plist holding export options. +INFO is a plist used as a communication channel. -Return an alist where key is entry's name and value an unique -identifier that might be used for internal links." - (org-element-map - (plist-get info :parse-tree) - type - (lambda (element info) - (let ((entry - (cond - ((org-element-get-property :caption element) - (org-export-secondary-string - (org-element-get-property :caption element) backend info)) - ((org-element-get-property :name element) - (org-export-secondary-string - (org-element-get-property :name element) backend info))))) - ;; Skip elements with neither a caption nor a name. - (when entry (cons entry (org-element-get-property :begin element))))) - info)) +When non-nil, optional argument PREDICATE is a function accepting +one argument, an element of type TYPE. It returns a non-nil +value when that element should be collected. -(defun org-export-collect-tables (backend info) +Return a list of all elements found, in order of appearance." + (org-element-map + (plist-get info :parse-tree) type + (lambda (element) + (and (or (org-element-property :caption element) + (org-element-property :name element)) + (or (not predicate) (funcall predicate element)) + element)) info)) + +(defun org-export-collect-tables (info) "Build a list of tables. -BACKEND is the back-end used to transcode table's name. INFO is -a plist holding export options. +INFO is a plist used as a communication channel. -Return an alist where key is the caption of the table and value -an unique identifier that might be used for internal links." - (org-export-collect-elements 'table backend info)) +Return a list of table elements with a caption or a name +affiliated keyword." + (org-export-collect-elements 'table info)) -(defun org-export-collect-figures (backend info) +(defun org-export-collect-figures (info predicate) "Build a list of figures. -A figure is a paragraph type element with a caption or a name. +INFO is a plist used as a communication channel. PREDICATE is +a function which accepts one argument: a paragraph element and +whose return value is non-nil when that element should be +collected. -BACKEND is the back-end used to transcode headline's name. INFO -is a plist holding export options. +A figure is a paragraph type element, with a caption or a name, +verifying PREDICATE. The latter has to be provided since +a \"figure\" is a vague concept that may depend on back-end. -Return an alist where key is the caption of the figure and value -an unique indentifier that might be used for internal links." - (org-export-collect-elements 'paragraph backend info)) +Return a list of elements recognized as figures." + (org-export-collect-elements 'paragraph info predicate)) -(defun org-export-collect-listings (backend info) +(defun org-export-collect-listings (info) "Build a list of src blocks. -BACKEND is the back-end used to transcode src block's name. INFO -is a plist holding export options. +INFO is a plist used as a communication channel. + +Return a list of src-block elements with a caption or a name +affiliated keyword." + (org-export-collect-elements 'src-block info)) + + +;;;; Topology + +;; Here are various functions to retrieve information about the +;; neighbourhood of a given element or object. Neighbours of interest +;; are direct parent (`org-export-get-parent'), parent headline +;; (`org-export-get-parent-headline'), parent paragraph +;; (`org-export-get-parent-paragraph'), previous element or object +;; (`org-export-get-previous-element') and next element or object +;; (`org-export-get-next-element'). + +;; All of these functions are just a specific use of the more generic +;; `org-export-get-genealogy', which returns the genealogy relative to +;; the element or object. + +(defun org-export-get-genealogy (blob info) + "Return genealogy relative to a given element or object. +BLOB is the element or object being considered. INFO is a plist +used as a communication channel." + (let* ((type (org-element-type blob)) + (end (org-element-property :end blob)) + (walk-data + (lambda (data genealogy) + ;; Walk DATA, looking for BLOB. GENEALOGY is the list of + ;; parents of all elements in DATA. + (mapc + (lambda (el) + (cond + ((stringp el) nil) + ((equal el blob) (throw 'exit genealogy)) + ((>= (org-element-property :end el) end) + ;; If BLOB is an object and EL contains a secondary + ;; string, be sure to check it. + (when (memq type org-element-all-objects) + (let ((sec-prop + (cdr (assq (org-element-type el) + org-element-secondary-value-alist)))) + (when sec-prop + (funcall + walk-data + (cons 'org-data + (cons nil (org-element-property sec-prop el))) + (cons el genealogy))))) + (funcall walk-data el (cons el genealogy))))) + (org-element-contents data))))) + (catch 'exit (funcall walk-data (plist-get info :parse-tree) nil) nil))) + +(defun org-export-get-parent (blob info) + "Return BLOB parent or nil. +BLOB is the element or object considered. INFO is a plist used +as a communication channel." + (car (org-export-get-genealogy blob info))) + +(defun org-export-get-parent-headline (blob info) + "Return closest parent headline or nil. + +BLOB is the element or object being considered. INFO is a plist +used as a communication channel." + (catch 'exit + (mapc + (lambda (el) (when (eq (org-element-type el) 'headline) (throw 'exit el))) + (org-export-get-genealogy blob info)) + nil)) + +(defun org-export-get-parent-paragraph (object info) + "Return parent paragraph or nil. + +INFO is a plist used as a communication channel. + +Optional argument OBJECT, when provided, is the object to consider. +Otherwise, return the paragraph containing current object. + +This is useful for objects, which share attributes with the +paragraph containing them." + (catch 'exit + (mapc + (lambda (el) (when (eq (org-element-type el) 'paragraph) (throw 'exit el))) + (org-export-get-genealogy object info)) + nil)) + +(defun org-export-get-previous-element (blob info) + "Return previous element or object. + +BLOB is an element or object. INFO is a plist used as +a communication channel. + +Return previous element or object, a string, or nil." + (let ((parent (org-export-get-parent blob info))) + (cadr (member blob (reverse (org-element-contents parent)))))) + +(defun org-export-get-next-element (blob info) + "Return next element or object. + +BLOB is an element or object. INFO is a plist used as +a communication channel. + +Return next element or object, a string, or nil." + (let ((parent (org-export-get-parent blob info))) + (cadr (member blob (org-element-contents parent))))) + -Return an alist where key is the caption of the src block and -value an unique indentifier that might be used for internal -links." - (org-export-collect-elements 'src-block backend info)) + +;;; The Dispatcher + +;; `org-export-dispatch' is the standard interactive way to start an +;; export process. It uses `org-export-dispatch-ui' as a subroutine +;; for its interface. Most commons back-ends should have an entry in +;; it. + +(defun org-export-dispatch () + "Export dispatcher for Org mode. + +It provides an access to common export related tasks in a buffer. +Its interface comes in two flavours: standard and expert. While +both share the same set of bindings, only the former displays the +valid keys associations. Set `org-export-dispatch-use-expert-ui' +to switch to one or the other. + +Return an error if key pressed has no associated command." + (interactive) + (let* ((input (org-export-dispatch-ui + (if (listp org-export-initial-scope) org-export-initial-scope + (list org-export-initial-scope)) + org-export-dispatch-use-expert-ui)) + (raw-key (car input)) + (optns (cdr input))) + ;; Translate "C-a", "C-b"... into "a", "b"... Then take action + ;; depending on user's key pressed. + (case (if (< raw-key 27) (+ raw-key 96) raw-key) + ;; Allow to quit with "q" key. + (?q nil) + ;; Export with `e-ascii' back-end. + ((?A ?N ?U) + (let ((outbuf + (org-export-to-buffer + 'e-ascii "*Org E-ASCII Export*" + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns) + `(:ascii-charset + ,(case raw-key (?A 'ascii) (?N 'latin1) (t 'utf-8)))))) + (with-current-buffer outbuf (text-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf)))) + ((?a ?n ?u) + (org-e-ascii-export-to-ascii + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns) + `(:ascii-charset ,(case raw-key (?a 'ascii) (?n 'latin1) (t 'utf-8))))) + ;; Export with `e-latex' back-end. + (?L + (let ((outbuf + (org-export-to-buffer + 'e-latex "*Org E-LaTeX Export*" + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) + (with-current-buffer outbuf (latex-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf)))) + (?l (org-e-latex-export-to-latex + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?p (org-e-latex-export-to-pdf + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?d (org-open-file + (org-e-latex-export-to-pdf + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) + ;; Export with `e-html' back-end. + (?H + (let ((outbuf + (org-export-to-buffer + 'e-html "*Org E-HTML Export*" + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) + ;; set major mode + (with-current-buffer outbuf + (if (featurep 'nxhtml-mode) (nxhtml-mode) (nxml-mode))) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf)))) + (?h (org-e-html-export-to-html + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?b (org-open-file + (org-e-html-export-to-html + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) + ;; Export with `e-odt' back-end. + (?o (org-e-odt-export-to-odt + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?O (org-open-file + (org-e-odt-export-to-odt + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) + ;; Publishing facilities + (?F (org-e-publish-current-file (memq 'force optns))) + (?P (org-e-publish-current-project (memq 'force optns))) + (?X (let ((project + (assoc (org-icompleting-read + "Publish project: " org-e-publish-project-alist nil t) + org-e-publish-project-alist))) + (org-e-publish project (memq 'force optns)))) + (?E (org-e-publish-all (memq 'force optns))) + ;; Undefined command. + (t (error "No command associated with key %s" + (char-to-string raw-key)))))) + +(defun org-export-dispatch-ui (options expertp) + "Handle interface for `org-export-dispatch'. + +OPTIONS is a list containing current interactive options set for +export. It can contain any of the following symbols: +`body' toggles a body-only export +`subtree' restricts export to current subtree +`visible' restricts export to visible part of buffer. +`force' force publishing files. + +EXPERTP, when non-nil, triggers expert UI. In that case, no help +buffer is provided, but indications about currently active +options are given in the prompt. Moreover, \[?] allows to switch +back to standard interface. + +Return value is a list with key pressed as CAR and a list of +final interactive export options as CDR." + (let ((help + (format "---- (Options) ------------------------------------------- + +\[1] Body only: %s [2] Export scope: %s +\[3] Visible only: %s [4] Force publishing: %s + + +--- (ASCII/Latin-1/UTF-8 Export) ------------------------- + +\[a/n/u] to TXT file [A/N/U] to temporary buffer + +--- (HTML Export) ---------------------------------------- + +\[h] to HTML file [b] ... and open it +\[H] to temporary buffer + +--- (LaTeX Export) --------------------------------------- + +\[l] to TEX file [L] to temporary buffer +\[p] to PDF file [d] ... and open it + +--- (ODF Export) ----------------------------------------- + +\[o] to ODT file [O] ... and open it + +--- (Publish) -------------------------------------------- + +\[F] current file [P] current project +\[X] a project [E] every project" + (if (memq 'body options) "On " "Off") + (if (memq 'subtree options) "Subtree" "Buffer ") + (if (memq 'visible options) "On " "Off") + (if (memq 'force options) "On " "Off"))) + (standard-prompt "Export command: ") + (expert-prompt (format "Export command (%s%s%s%s): " + (if (memq 'body options) "b" "-") + (if (memq 'subtree options) "s" "-") + (if (memq 'visible options) "v" "-") + (if (memq 'force options) "f" "-"))) + (handle-keypress + (function + ;; Read a character from command input, toggling interactive + ;; options when applicable. PROMPT is the displayed prompt, + ;; as a string. + (lambda (prompt) + (let ((key (read-char-exclusive prompt))) + (cond + ;; Ignore non-standard characters (i.e. "M-a"). + ((not (characterp key)) (org-export-dispatch-ui options expertp)) + ;; Help key: Switch back to standard interface if + ;; expert UI was active. + ((eq key ??) (org-export-dispatch-ui options nil)) + ;; Toggle export options. + ((memq key '(?1 ?2 ?3 ?4)) + (org-export-dispatch-ui + (let ((option (case key (?1 'body) (?2 'subtree) (?3 'visible) + (?4 'force)))) + (if (memq option options) (remq option options) + (cons option options))) + expertp)) + ;; Action selected: Send key and options back to + ;; `org-export-dispatch'. + (t (cons key options)))))))) + ;; With expert UI, just read key with a fancy prompt. In standard + ;; UI, display an intrusive help buffer. + (if expertp (funcall handle-keypress expert-prompt) + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Org Export/Publishing Help*" (princ help)) + (org-fit-window-to-buffer + (get-buffer-window "*Org Export/Publishing Help*")) + (funcall handle-keypress standard-prompt))))) (provide 'org-export) diff --git a/contrib/lisp/org-interactive-query.el b/contrib/lisp/org-interactive-query.el index 6bf40f8..ab6669b 100644 --- a/contrib/lisp/org-interactive-query.el +++ b/contrib/lisp/org-interactive-query.el @@ -6,7 +6,7 @@ ;; Version: 1.0 ;; Keywords: org, wp ;; -;; This file is not part of GNU Emacs. +;; 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 @@ -31,7 +31,7 @@ ;; / add a keyword as a positive selection criterion ;; \ add a keyword as a newgative selection criterion ;; = clear a keyword from the selection string -;; ; +;; ; (require 'org) @@ -39,7 +39,7 @@ (org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd) (org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd) (org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd) - + ;;; Agenda interactive query manipulation (defcustom org-agenda-query-selection-single-key t @@ -283,7 +283,7 @@ (defun org-agenda-query-merge-todo-key (alist entry) (defun org-agenda-query-generic-cmd (op) "Activate query manipulation with OP as initial operator." (let ((q (org-agenda-query-selection org-agenda-query-string op - org-tag-alist + org-tag-alist (org-agenda-query-global-todo-keys)))) (when q (setq org-agenda-query-string q) diff --git a/contrib/lisp/org-invoice.el b/contrib/lisp/org-invoice.el index ca25711..c951d4e 100644 --- a/contrib/lisp/org-invoice.el +++ b/contrib/lisp/org-invoice.el @@ -181,7 +181,7 @@ (defun org-invoice-level-min-max (ls) (when (or (not min) (< level min)) (setq min level)) (when (> level max) (setq max level)))) (cons (or min 0) max))) - + (defun org-invoice-collapse-list (ls) "Reorganize the given list by dates." (let ((min-max (org-invoice-level-min-max ls)) new) @@ -214,7 +214,7 @@ (defun org-invoice-collapse-list (ls) (+ price (cdr (assoc 'price (car bucket))))) (nconc bucket (list info)))))) (nreverse new))) - + (defun org-invoice-info-to-table (info) "Create a single org table row from the given info alist." (let ((title (cdr (assoc 'title info))) @@ -223,19 +223,19 @@ (defun org-invoice-info-to-table (info) (price (cdr (assoc 'price info))) (with-price (plist-get org-invoice-table-params :price))) (unless total - (setq + (setq org-invoice-total-time (+ org-invoice-total-time work) org-invoice-total-price (+ org-invoice-total-price price))) (setq total (and total (org-minutes-to-hh:mm-string total))) (setq work (and work (org-minutes-to-hh:mm-string work))) - (insert-before-markers + (insert-before-markers (concat "|" title (cond (total (concat "|" total)) (work (concat "|" work))) (and with-price price (concat "|" (format "%.2f" price))) "|" "\n")))) - + (defun org-invoice-list-to-table (ls) "Convert a list of heading info to an org table" (let ((with-price (plist-get org-invoice-table-params :price)) @@ -243,7 +243,7 @@ (defun org-invoice-list-to-table (ls) (with-header (plist-get org-invoice-table-params :headers)) (org-invoice-total-time 0) (org-invoice-total-price 0)) - (insert-before-markers + (insert-before-markers (concat "| Task / Date | Time" (and with-price "| Price") "|\n")) (dolist (info ls) (insert-before-markers "|-\n") @@ -268,9 +268,9 @@ (defun org-invoice-collect-invoice-data () (org-clock-sum) (run-hook-with-args 'org-invoice-start-hook) (cons org-invoice-current-invoice - (org-invoice-collapse-list + (org-invoice-collapse-list (org-map-entries 'org-invoice-heading-info t 'tree 'archive)))))) - + (defun org-dblock-write:invoice (params) "Function called by OrgMode to write the invoice dblock. To create an invoice dblock you can use the `org-invoice-report' @@ -397,5 +397,5 @@ (defun org-invoice-report (&optional jump) (if report (goto-char report) (org-create-dblock (list :name "invoice"))) (org-update-dblock))) - + (provide 'org-invoice) diff --git a/contrib/lisp/org-mac-iCal.el b/contrib/lisp/org-mac-iCal.el index 5d29d4b..0fdc95f 100644 --- a/contrib/lisp/org-mac-iCal.el +++ b/contrib/lisp/org-mac-iCal.el @@ -101,7 +101,7 @@ (defun org-mac-iCal () (shell-command "sw_vers" (current-buffer)) (when (re-search-backward "10\\.[567]" nil t) (omi-concat-leopard-ics all-calendars))) - + ;; move all caldav ics files to the same place as local ics files (mapc (lambda (x) @@ -111,7 +111,7 @@ (defun org-mac-iCal () (concat "~/Library/Calendars/" y))) (directory-files x nil ".*ics$"))) caldav-folders) - + ;; check calendar has contents and import (setq import-calendars (directory-files "~/Library/Calendars" 1 ".*ics$")) (mapc @@ -181,7 +181,7 @@ (defun omi-import-ics (string) (* (/ org-mac-iCal-range 2) 30)) (delete-region startEntry endEntry))) (goto-char (point-max)))) - (while + (while (re-search-forward "^END:VEVENT$" nil t) (delete-blank-lines)) (goto-line 1) diff --git a/contrib/lisp/org-mac-link-grabber.el b/contrib/lisp/org-mac-link-grabber.el index 1644fc4..b422bfb 100644 --- a/contrib/lisp/org-mac-link-grabber.el +++ b/contrib/lisp/org-mac-link-grabber.el @@ -2,7 +2,7 @@ ;;; application and insert them as links into org-mode documents ;; ;; Copyright (c) 2010-2012 Free Software Foundation, Inc. -;; +;; ;; Author: Anthony Lander ;; Version: 1.0.1 ;; Keywords: org, mac, hyperlink @@ -52,7 +52,7 @@ ;; add (require 'org-mac-link-grabber) to your .emacs, and optionally ;; bind a key to activate the link grabber menu, like this: ;; -;; (add-hook 'org-mode-hook (lambda () +;; (add-hook 'org-mode-hook (lambda () ;; (define-key org-mode-map (kbd "C-c g") 'omlg-grab-link))) ;; ;; @@ -161,7 +161,7 @@ (defun omlg-grab-link () (when (and active (eq input key)) (call-interactively grab-function)))) descriptors))) - + (defalias 'omgl-grab-link 'omlg-grab-link "Renamed, and this alias will be obsolete next revision.") @@ -344,7 +344,7 @@ (defun as-mac-safari-get-frontmost-url () " return theUrl & \"::split::\" & theName & \"\n\"\n" "end tell\n")))) (car (split-string result "[\r\n]+" t)))) - + (defun org-mac-safari-get-frontmost-url () (interactive) (message "Applescript: Getting Safari url...") @@ -361,7 +361,7 @@ (defun org-mac-safari-get-frontmost-url () (defun org-mac-safari-insert-frontmost-url () (interactive) (insert (org-mac-safari-get-frontmost-url))) - + ;; ;; diff --git a/contrib/lisp/org-mairix.el b/contrib/lisp/org-mairix.el index 11e4e70..367a866 100644 --- a/contrib/lisp/org-mairix.el +++ b/contrib/lisp/org-mairix.el @@ -207,7 +207,7 @@ (defgroup org-mairix-mutt nil :group 'org-mairix) (defcustom org-mairix-mutt-display-command - "xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f + "xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f ~/mail/mairix -e \"push \"' &" "Command to execute to display mairix search results via mutt within an xterm. @@ -244,7 +244,7 @@ (defcustom org-mairix-gnus-results-group "nnmaildir:mairix" :group 'org-mairix-gnus :type 'string) -(defcustom org-mairix-gnus-select-display-group-function +(defcustom org-mairix-gnus-select-display-group-function 'org-mairix-gnus-select-display-group-function-gg "Hook to call to select the group that contains the matching articles. We should not need this, it is owed to a problem of gnus that people were @@ -285,7 +285,7 @@ (defun org-mairix-gnus-display-results (search args) If you can improve this, please do!" (if (not (equal (substring search 0 2) "m:" )) - (error "org-mairix-gnus-display-results: display of search other than + (error "org-mairix-gnus-display-results: display of search other than message-id not implemented yet")) (setq message-id (substring search 2 nil)) (require 'gnus) diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el index 72bdd68..b9d9f37 100644 --- a/contrib/lisp/org-mime.el +++ b/contrib/lisp/org-mime.el @@ -43,13 +43,13 @@ ;; ;; you might want to bind this to a key with something like the ;; following message-mode binding -;; +;; ;; (add-hook 'message-mode-hook ;; (lambda () ;; (local-set-key "\C-c\M-o" 'org-mime-htmlize))) ;; ;; and the following org-mode binding -;; +;; ;; (add-hook 'org-mode-hook ;; (lambda () ;; (local-set-key "\C-c\M-o" 'org-mime-org-buffer-htmlize))) diff --git a/contrib/lisp/org-mtags.el b/contrib/lisp/org-mtags.el index 4178cde..cbae721 100644 --- a/contrib/lisp/org-mtags.el +++ b/contrib/lisp/org-mtags.el @@ -254,4 +254,3 @@ (defun org-mtags-fontify-tags (limit) (provide 'org-mtags) ;;; org-mtags.el ends here - diff --git a/contrib/lisp/org-notmuch.el b/contrib/lisp/org-notmuch.el index 11e06b8..25f6ab6 100644 --- a/contrib/lisp/org-notmuch.el +++ b/contrib/lisp/org-notmuch.el @@ -32,7 +32,7 @@ ;; Links have one the following form ;; notmuch: -;; notmuch-search:. +;; notmuch-search:. ;; The first form open the queries in notmuch-show mode, whereas the ;; second link open it in notmuch-search mode. Note that queries are @@ -61,13 +61,13 @@ (defun org-notmuch-store-link () (setq link (org-make-link "notmuch:" "id:" message-id)) (org-add-link-props :link link :description desc) link))) - + (defun org-notmuch-open (path) "Follow a notmuch message link specified by PATH." (org-notmuch-follow-link path)) (defun org-notmuch-follow-link (search) - "Follow a notmuch link to SEARCH. + "Follow a notmuch link to SEARCH. Can link to more than one message, if so all matching messages are shown." (require 'notmuch) @@ -82,10 +82,10 @@ (defun org-notmuch-follow-link (search) (defun org-notmuch-search-store-link () "Store a link to a notmuch search or message." (when (eq major-mode 'notmuch-search-mode) - (let ((link (org-make-link "notmuch-search:" + (let ((link (org-make-link "notmuch-search:" (org-link-escape notmuch-search-query-string))) (desc (concat "Notmuch search: " notmuch-search-query-string))) - (org-store-link-props :type "notmuch-search" + (org-store-link-props :type "notmuch-search" :link link :description desc) link))) diff --git a/contrib/lisp/org-panel.el b/contrib/lisp/org-panel.el index a6117ce..3ffdfaf 100644 --- a/contrib/lisp/org-panel.el +++ b/contrib/lisp/org-panel.el @@ -639,5 +639,3 @@ (defun orgpan-minor-post-command () ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; org-panel.el ends here - - diff --git a/contrib/lisp/org-registry.el b/contrib/lisp/org-registry.el index 3b43ce2..c1a1c6c 100644 --- a/contrib/lisp/org-registry.el +++ b/contrib/lisp/org-registry.el @@ -145,15 +145,15 @@ (defun org-registry-display-files (files link) (defun org-registry-assoc-all (link &optional registry) "Return all associated entries of LINK in the registry." - (org-registry-find-all + (org-registry-find-all (lambda (entry) (string= link (car entry))) registry)) (defun org-registry-find-all (test &optional registry) "Return all entries satisfying `test' in the registry." - (delq nil - (mapcar - (lambda (x) (and (funcall test x) x)) + (delq nil + (mapcar + (lambda (x) (and (funcall test x) x)) (or registry org-registry-alist)))) ;;;###autoload diff --git a/contrib/lisp/org-screen.el b/contrib/lisp/org-screen.el index ba74267..a517b4b 100644 --- a/contrib/lisp/org-screen.el +++ b/contrib/lisp/org-screen.el @@ -40,7 +40,7 @@ ;; associated with that task, go to the end of your item and type: ;; ;; M-x org-screen -;; +;; ;; This will prompt you for a name of a screen session. Type in a ;; name and it will insert a link into your org file at your current ;; location. @@ -79,10 +79,10 @@ (defun org-screen-helper (name arg) ;; Pick the name of the new buffer. (let ((term-ansi-buffer-name - (generate-new-buffer-name + (generate-new-buffer-name (org-screen-buffer-name name)))) (setq term-ansi-buffer-name - (term-ansi-make-term + (term-ansi-make-term term-ansi-buffer-name org-screen-program-name nil arg name)) (set-buffer term-ansi-buffer-name) (term-mode) @@ -104,5 +104,5 @@ (defun org-screen-goto (name) '("screen" . "elisp:(org-screen-goto \"%s\")")) (setq org-link-abbrev-alist '(("screen" . "elisp:(org-screen-goto \"%s\")")))) - + (provide 'org-screen) diff --git a/contrib/lisp/org-static-mathjax.el b/contrib/lisp/org-static-mathjax.el index 6a9f0ec..29f2cfe 100644 --- a/contrib/lisp/org-static-mathjax.el +++ b/contrib/lisp/org-static-mathjax.el @@ -86,7 +86,7 @@ (defun org-static-mathjax-hook-installer () (set 'org-static-mathjax-mathjax-path (car (read-from-string (substring mathjax-options (match-end 0)))))))) - (add-hook 'after-save-hook + (add-hook 'after-save-hook 'org-static-mathjax-process nil t))))) @@ -117,20 +117,20 @@ (defun org-static-mathjax-process () (set symbol (eval (car (read-from-string (substring options (match-end 0)))))))) '(embed-fonts output-file-name)) - + ; debug (when org-static-mathjax-debug (message "output file name, embed-fonts") (print output-file-name) (print embed-fonts)) - + ; open (temporary) input file, copy contents there, replace MathJax path with local installation (with-temp-buffer (insert html-code) (goto-char 1) (replace-regexp mathjax-oldpath mathjax-newpath) (write-file input-file-name)) - + ; prepare argument list for call-process (let ((call-process-args (list org-static-mathjax-xulrunner-path nil nil nil @@ -146,10 +146,10 @@ (defun org-static-mathjax-process () (if (not embed-fonts) (progn (add-to-list 'call-process-args "--final-mathjax-url" t) - (add-to-list 'call-process-args + (add-to-list 'call-process-args (file-name-directory org-static-mathjax-mathjax-path) t))) - + ; debug (when org-static-mathjax-debug (print call-process-args)) diff --git a/contrib/lisp/org-sudoku.el b/contrib/lisp/org-sudoku.el index 768729c..bf9a699 100644 --- a/contrib/lisp/org-sudoku.el +++ b/contrib/lisp/org-sudoku.el @@ -1,5 +1,5 @@ ;;; org-sudoku.el --- Greate and solve SUDOKU games in Org tables -;; Copyright (C) 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp, games @@ -126,7 +126,7 @@ (defun org-sudoku-solve-field () (setq game (org-sudoku-solve-game game)) (if game (progn - (org-table-put i j (number-to-string + (org-table-put i j (number-to-string (nth 1 (assoc (cons i j) game))) 'align) (org-table-goto-line i) @@ -139,7 +139,7 @@ (defun org-sudoku-get-game () "Interpret table at point as sudoku game and read it. A game structure is returned." (let (b e g i j game) - + (org-table-goto-line 1) (org-table-goto-column 1) (setq b (point)) diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el index 1c9752b..3f37cb8 100644 --- a/contrib/lisp/org-toc.el +++ b/contrib/lisp/org-toc.el @@ -278,7 +278,7 @@ (defun org-toc-show (&optional depth position) ;;; Navigation functions: (defun org-toc-goto (&optional jump cycle) "From Org TOC buffer, follow the targeted subtree in the Org window. -If JUMP is non-nil, go to the base buffer. +If JUMP is non-nil, go to the base buffer. If JUMP is 'delete, go to the base buffer and delete other windows. If CYCLE is non-nil, cycle the targeted subtree in the Org window." (interactive) @@ -459,15 +459,15 @@ (defun org-toc-get-headlines-status () (defun org-toc-help () "Display a quick help message in the echo-area for `org-toc-mode'." (interactive) - (let ((st-start 0) + (let ((st-start 0) (help-message "\[space\] show heading \[1-4\] hide headlines below this level \[TAB\] jump to heading \[f\] toggle follow mode (currently %s) \[return\] jump and delete others windows \[i\] toggle info mode (currently %s) \[S-TAB\] cycle subtree (in Org) \[S\] toggle show subtree mode (currently %s) -\[C-S-TAB\] global cycle (in Org) \[r\] toggle recenter mode (currently %s) +\[C-S-TAB\] global cycle (in Org) \[r\] toggle recenter mode (currently %s) \[:\] cycle subtree (in TOC) \[c\] toggle column view (currently %s) -\[n/p\] next/previous heading \[s\] save TOC configuration +\[n/p\] next/previous heading \[s\] save TOC configuration \[q\] quit the TOC \[g\] restore last TOC configuration")) (while (string-match "\\[[^]]+\\]" help-message st-start) (add-text-properties (match-beginning 0) diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el index a5a5b19..87cc174 100644 --- a/contrib/lisp/org-wikinodes.el +++ b/contrib/lisp/org-wikinodes.el @@ -174,7 +174,7 @@ (defun org-wikinodes-follow-link (target) (message "New Wiki target `%s' created in current buffer" target)))))) -;;; The target cache +;;; The target cache (defvar org-wikinodes-directory-targets-cache nil) @@ -206,7 +206,7 @@ (defun org-wikinodes-get-targets () (while (re-search-forward re nil t) (push (org-match-string-no-properties 4) targets)))) (nreverse targets))) - + (defun org-wikinodes-get-links-for-directory (dir) "Return an alist that connects wiki links to files in directory DIR." (let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'")) @@ -328,7 +328,7 @@ (defun org-wikinodes-add-to-font-lock-keywords () (setcdr m (cons '(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/org2rem.el b/contrib/lisp/org2rem.el index 7fa9dd9..d54eff3 100644 --- a/contrib/lisp/org2rem.el +++ b/contrib/lisp/org2rem.el @@ -402,7 +402,7 @@ (defun org-print-remind-entries (&optional combine) (insert sexp "\n")))) ;; (princ (org-diary-to-rem-string sexp-buffer)) (kill-buffer sexp-buffer)) - + (when org-remind-include-todo (setq prefix "TODO-") (goto-char (point-min)) @@ -450,7 +450,7 @@ (defun org-print-remind-entries (&optional combine) (if dos diff-days 0) (if dos 0 diff-days)) 1000))) - + (if (and (numberp org-rem-aw) (> org-rem-aw 0)) (setq remind-aw (+ (or remind-aw 0) org-rem-aw))) @@ -470,7 +470,7 @@ (defun org-print-remind-entries (&optional combine) (and due (setq due (org-rem-ts-to-remind-date-type due))) (and start (setq start (org-rem-ts-to-remind-date-type start))) (and remind-ew (setq remind-ew (org-rem-ts-to-remind-date-type remind-ew))) - + (if (string-match org-bracket-link-regexp hd) (setq hd (replace-match (if (match-end 3) (match-string 3 hd) (match-string 1 hd)) diff --git a/contrib/lisp/test-org-export-preproc.el b/contrib/lisp/test-org-export-preproc.el index b03da70..66c342f 100644 --- a/contrib/lisp/test-org-export-preproc.el +++ b/contrib/lisp/test-org-export-preproc.el @@ -36,4 +36,3 @@ (defun test-preproc () (org-pop-to-buffer-same-window "*preproc-temp*") (point-max) (insert string)))) - diff --git a/contrib/scripts/StartOzServer.oz b/contrib/scripts/StartOzServer.oz index 56940a3..9d41e83 100644 --- a/contrib/scripts/StartOzServer.oz +++ b/contrib/scripts/StartOzServer.oz @@ -1,5 +1,5 @@ %%% ************************************************************* -%%% Copyright (C) 2009 Torsten Anders (www.torsten-anders.de) +%%% Copyright (C) 2009-2012 Torsten Anders (www.torsten-anders.de) %%% 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 2 diff --git a/contrib/scripts/org2hpda b/contrib/scripts/org2hpda index 6b308f3..b59b6a3 100755 --- a/contrib/scripts/org2hpda +++ b/contrib/scripts/org2hpda @@ -1,5 +1,5 @@ # org2hpda - a small utility to generate hipster pda style printouts from org mode -# Copyright (C) 2007 Christian Egli +# Copyright (C) 2007-2012 Christian Egli # # Version: 0.6 # diff --git a/doc/org.texi b/doc/org.texi index 3a1a77d..d8ebef5 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -5,7 +5,7 @@ @settitle The Org Manual @set VERSION 7.8.05 -@set DATE mars 2012 +@set DATE March 2012 @c Use proper quote and backtick for code sections in PDF output @c Cf. Texinfo manual 14.2 @@ -265,7 +265,7 @@ @copying This manual is for Org version @value{VERSION}. -Copyright @copyright{} 2004-2011 Free Software Foundation, Inc. +Copyright @copyright{} 2004-2012 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -717,6 +717,7 @@ * rownames:: Handle row names in tables * shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks +* wrap:: Mark source block evaluation results Miscellaneous @@ -1080,7 +1081,7 @@ @section Feedback @node Conventions, , Feedback, Introduction @section Typesetting conventions used in this manual -Org uses three types of keywords: TODO keywords, tags, and property +Org uses three types of keywords: TODO keywords, tags and property names. In this manual we use the following conventions: @table @code @@ -1098,7 +1099,14 @@ @section Typesetting conventions used in this manual special meaning are written with all capitals. @end table -The manual lists both the keys and the corresponding commands for accessing +Moreover, Org uses @i{option keywords} (like @code{#+TITLE} to set the title) +and @i{environment keywords} (like @code{#+BEGIN_HTML} to start a @code{HTML} +environment). They are written in uppercase in the manual to enhance its +readability, but you can use lowercase in your Org files@footnote{Easy +templates insert lowercase keywords and Babel dynamically inserts +@code{#+results}.} + +The manual lists both the keys and the corresponding commands for accessing a functionality. Org mode often uses the same key for different functions, depending on context. The command that is bound to such keys has a generic name, like @code{org-metaright}. In the manual we will, wherever possible, @@ -1158,7 +1166,8 @@ @section Headlines start with one or more stars, on the left margin@footnote{See the variables @code{org-special-ctrl-a/e}, @code{org-special-ctrl-k}, and @code{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a}, -@kbd{C-e}, and @kbd{C-k} in headlines.}. For example: +@kbd{C-e}, and @kbd{C-k} in headlines.} @footnote{Clocking only works with +headings indented less then 30 stars.}. For example: @example * Top level headline @@ -1428,7 +1437,7 @@ @section Structure editing @code{org-clone-subtree-with-time-shift}. @orgcmd{C-c C-w,org-refile} Refile entry or region to a different location. @xref{Refiling notes}. -@orgcmd{C-c ^,org-sort-entries-or-items} +@orgcmd{C-c ^,org-sort} Sort same-level entries. When there is an active region, all entries in the region will be sorted. Otherwise the children of the current headline are sorted. The command prompts for the sorting method, which can be @@ -1755,11 +1764,13 @@ @section Drawers @cindex visibility cycling, drawers @vindex org-drawers +@cindex org-insert-drawer +@kindex C-c C-x d Sometimes you want to keep information associated with an entry, but you normally don't want to see it. For this, Org mode has @emph{drawers}. Drawers need to be configured with the variable -@code{org-drawers}@footnote{You can define drawers on a per-file basis -with a line like @code{#+DRAWERS: HIDDEN PROPERTIES STATE}}. Drawers +@code{org-drawers}@footnote{You can define additional drawers on a +per-file basis with a line like @code{#+DRAWERS: HIDDEN STATE}}. Drawers look like this: @example @@ -1771,6 +1782,13 @@ @section Drawers After the drawer. @end example +You can interactively insert drawers at point by calling +@code{org-insert-drawer}, which is bound to @key{C-c C-x d}. With an active +region, this command will put the region inside the drawer. With a prefix +argument, this command calls @code{org-insert-property-drawer} and add a +property drawer right below the current headline. Completion over drawer +keywords is also possible using @key{M-TAB}. + Visibility cycling (@pxref{Visibility cycling}) on the headline will hide and show the entry, but keep the drawer collapsed to a single line. In order to look inside the drawer, you need to move the cursor to the drawer line and @@ -3225,6 +3243,8 @@ @section External links vm:folder @r{VM folder link} vm:folder#id @r{VM message link} vm://myself@@some.where.org/folder#id @r{VM on remote machine} +vm-imap:account:folder @r{VM IMAP folder link} +vm-imap:account:folder#id @r{VM IMAP message link} wl:folder @r{WANDERLUST folder link} wl:folder#id @r{WANDERLUST message link} mhe:folder @r{MH-E folder link} @@ -4063,9 +4083,11 @@ @subsection Tracking TODO state changes headline as an itemized list, newest first@footnote{See the variable @code{org-log-states-order-reversed}}. When taking a lot of notes, you might want to get the notes out of the way into a drawer (@pxref{Drawers}). -Customize the variable @code{org-log-into-drawer} to get this -behavior---the recommended drawer for this is called @code{LOGBOOK}. You can -also overrule the setting of this variable for a subtree by setting a +Customize the variable @code{org-log-into-drawer} to get this behavior---the +recommended drawer for this is called @code{LOGBOOK}@footnote{Note that the +@code{LOGBOOK} drawer is unfolded when pressing @key{SPC} in the agenda to +show an entry---use @key{C-u SPC} to keep it folded here}. You can also +overrule the setting of this variable for a subtree by setting a @code{LOG_INTO_DRAWER} property. Since it is normally too much to record a note for every state, Org mode @@ -4870,8 +4892,8 @@ @section Property syntax @orgcmd{C-c C-x p,org-set-property} Set a property. This prompts for a property name and a value. If necessary, the property drawer is created as well. -@item M-x org-insert-property-drawer -@findex org-insert-property-drawer +@item C-u M-x org-insert-drawer +@cindex org-insert-drawer Insert a property drawer into the current entry. The drawer will be inserted early in the entry, but after the lines with planning information like deadlines. @@ -5896,12 +5918,14 @@ @section Clocking work time @cindex time clocking Org mode allows you to clock the time you spend on specific tasks in a -project. When you start working on an item, you can start the clock. -When you stop working on that task, or when you mark the task done, the -clock is stopped and the corresponding time interval is recorded. It -also computes the total time spent on each subtree of a project. And it -remembers a history or tasks recently clocked, to that you can jump quickly -between a number of tasks absorbing your time. +project. When you start working on an item, you can start the clock. When +you stop working on that task, or when you mark the task done, the clock is +stopped and the corresponding time interval is recorded. It also computes +the total time spent on each subtree@footnote{Clocking only works if all +headings are indented with less than 30 stars. This is a hardcoded +limitation of `lmax' in `org-clock-sum'.} of a project. And it remembers a +history or tasks recently clocked, to that you can jump quickly between a +number of tasks absorbing your time. To save the clock history across Emacs sessions, use @lisp @@ -6680,21 +6704,21 @@ @subsubsection Template expansion @vindex org-from-is-user-regexp @smallexample -Link type | Available keywords -------------------------+---------------------------------------------- -bbdb | %:name %:company -irc | %:server %:port %:nick -vm, wl, mh, mew, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:date @r{(message date header field)} - | %:date-timestamp @r{(date as active timestamp)} - | %:date-timestamp-inactive @r{(date as inactive timestamp)} - | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} -gnus | %:group, @r{for messages also all email fields} -w3, w3m | %:url -info | %:file %:node -calendar | %:date +Link type | Available keywords +---------------------------------+---------------------------------------------- +bbdb | %:name %:company +irc | %:server %:port %:nick +vm, vm-imap, wl, mh, mew, rmail | %:type %:subject %:message-id + | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:date @r{(message date header field)} + | %:date-timestamp @r{(date as active timestamp)} + | %:date-timestamp-inactive @r{(date as inactive timestamp)} + | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} +gnus | %:group, @r{for messages also all email fields} +w3, w3m | %:url +info | %:file %:node +calendar | %:date @end smallexample @noindent @@ -9020,7 +9044,7 @@ @section Images and Tables @example #+CAPTION: This is the caption for the next table (or link) -#+LABEL: tbl:basic-data +#+LABEL: tab:basic-data | ... | ...| |-----|----| @end example @@ -9634,7 +9658,7 @@ @section Export options @cindex #+EXPORT_SELECT_TAGS @cindex #+EXPORT_EXCLUDE_TAGS @cindex #+XSLT -@cindex #+LATEX_HEADER +@cindex #+LaTeX_HEADER @vindex user-full-name @vindex user-mail-address @vindex org-export-default-language @@ -9654,7 +9678,7 @@ @section Export options @r{You need to confirm using these, or configure @code{org-export-allow-BIND}} #+LINK_UP: the ``up'' link of an exported page #+LINK_HOME: the ``home'' link of an exported page -#+LATEX_HEADER: extra line(s) for the @LaTeX{} header, like \usepackage@{xyz@} +#+LaTeX_HEADER: extra line(s) for the @LaTeX{} header, like \usepackage@{xyz@} #+EXPORT_SELECT_TAGS: Tags that select a tree for export #+EXPORT_EXCLUDE_TAGS: Tags that exclude a tree from export #+XSLT: the XSLT stylesheet used by DocBook exporter to generate FO file @@ -10326,11 +10350,11 @@ @subsection Header and sectioning structure @vindex org-export-latex-classes @vindex org-export-latex-default-packages-alist @vindex org-export-latex-packages-alist -@cindex #+LATEX_HEADER -@cindex #+LATEX_CLASS -@cindex #+LATEX_CLASS_OPTIONS -@cindex property, LATEX_CLASS -@cindex property, LATEX_CLASS_OPTIONS +@cindex #+LaTeX_HEADER +@cindex #+LaTeX_CLASS +@cindex #+LaTeX_CLASS_OPTIONS +@cindex property, LaTeX_CLASS +@cindex property, LaTeX_CLASS_OPTIONS You can change this globally by setting a different value for @code{org-export-latex-default-class} or locally by adding an option like @code{#+LaTeX_CLASS: myclass} in your file, or with a @code{:LaTeX_CLASS:} @@ -10340,11 +10364,22 @@ @subsection Header and sectioning structure @code{org-export-latex-default-packages-alist} and @code{org-export-latex-packages-alist} are spliced.}, and allows you to define the sectioning structure for each class. You can also define your own -classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{LaTeX_CLASS_OPTIONS} -property can specify the options for the @code{\documentclass} macro. You -can also use @code{#+LATEX_HEADER: \usepackage@{xyz@}} to add lines to the -header. See the docstring of @code{org-export-latex-classes} for more -information. +classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{:LaTeX_CLASS_OPTIONS:} +property can specify the options for the @code{\documentclass} macro. The +options to documentclass have to be provided, as expected by @LaTeX{}, within +square brackets. You can also use @code{#+LaTeX_HEADER: \usepackage@{xyz@}} +to add lines to the header. See the docstring of +@code{org-export-latex-classes} for more information. An example is shown +below. + +@example +#+LaTeX_CLASS: article +#+LaTeX_CLASS_OPTIONS: [a4paper] +#+LaTeX_HEADER: \usepackage@{xyz@} + +* Headline 1 + some text +@end example @node Quoting @LaTeX{} code, Tables in @LaTeX{} export, Header and sectioning, @LaTeX{} and PDF export @subsection Quoting @LaTeX{} code @@ -10428,9 +10463,7 @@ @subsection Images in @LaTeX{} export this option can be used with tables as well@footnote{One can also take advantage of this option to pass other, unrelated options into the figure or table environment. For an example see the section ``Exporting org files'' in -@url{http://orgmode.org/worg/org-hacks.html}}. For example the -@code{#+ATTR_LaTeX:} line below is exported as the @code{figure} environment -below it. +@url{http://orgmode.org/worg/org-hacks.html}}. If you would like to let text flow around the image, add the word @samp{wrap} to the @code{#+ATTR_LaTeX:} line, which will make the figure occupy the left @@ -10517,7 +10550,7 @@ @subsection Beamer class export Frames will automatically receive a @code{fragile} option if they contain source code that uses the verbatim environment. Special @file{beamer} specific code can be inserted using @code{#+BEAMER:} and -@code{#+BEGIN_beamer...#+end_beamer} constructs, similar to other export +@code{#+BEGIN_BEAMER...#+END_BEAMER} constructs, similar to other export backends, but with the difference that @code{#+LaTeX:} stuff will be included in the presentation as well. @@ -12280,7 +12313,7 @@ @subsection Generating an index @end multitable The file will be created when first publishing a project with the -@code{:makeindex} set. The file only contains a statement @code{#+include: +@code{:makeindex} set. The file only contains a statement @code{#+INCLUDE: "theindex.inc"}. You can then build around this include statement by adding a title, style information, etc. @@ -12668,10 +12701,10 @@ @section Evaluating code blocks begins by default with @code{#+RESULTS} and optionally a cache identifier and/or the name of the evaluated code block. The default value of @code{#+RESULTS} can be changed with the customizable variable -@code{org-babel-results-keyword}. +@code{org-babel-results-keyword}. By default, the evaluation facility is only enabled for Lisp code blocks -specified as @code{emacs-lisp}. However, source code blocks in many languages +specified as @code{emacs-lisp}. However, source code blocks in many languages can be evaluated within Org mode (see @ref{Languages} for a list of supported languages and @ref{Structure of code blocks} for information on the syntax used to define a code block). @@ -12685,8 +12718,8 @@ @section Evaluating code blocks its results into the Org mode buffer. @cindex #+CALL -It is also possible to evaluate named code blocks from anywhere in an -Org mode buffer or an Org mode table. Live code blocks located in the current +It is also possible to evaluate named code blocks from anywhere in an Org +mode buffer or an Org mode table. Live code blocks located in the current Org mode buffer or in the ``Library of Babel'' (see @ref{Library of Babel}) can be executed. Named code blocks can be executed with a separate @code{#+CALL:} line or inline within a block of text. @@ -12980,7 +13013,7 @@ @subsection Using header arguments (message "data1:%S, data2:%S" data1 data2) #+END_SRC - #+results: + #+RESULTS: : data1:1, data2:2 @end example @@ -12992,7 +13025,7 @@ @subsection Using header arguments (message "data:%S" data) #+END_SRC - #+results: named-block + #+RESULTS: named-block : data:2 @end example @@ -13050,6 +13083,7 @@ @subsection Specific header arguments * rownames:: Handle row names in tables * shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks +* wrap:: Mark source block evaluation results @end menu Additional header arguments are defined on a language-specific basis, see @@ -13064,7 +13098,7 @@ @subsubsection @code{:var} case, variables require a default value when they are declared. The values passed to arguments can either be literal values, references, or -Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). References +Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). References include anything in the Org mode file that takes a @code{#+NAME:}, @code{#+TBLNAME:}, or @code{#+RESULTS:} line. This includes tables, lists, @code{#+BEGIN_EXAMPLE} blocks, other code blocks, and the results of other @@ -13103,7 +13137,7 @@ @subsubsection @code{:var} (length table) #+END_SRC -#+results: table-length +#+RESULTS: table-length : 4 @end example @@ -13122,7 +13156,7 @@ @subsubsection @code{:var} (print x) #+END_SRC -#+results: +#+RESULTS: | simple | list | @end example @@ -13135,7 +13169,7 @@ @subsubsection @code{:var} (* 2 length) #+END_SRC -#+results: +#+RESULTS: : 8 @end example @@ -13150,7 +13184,7 @@ @subsubsection @code{:var} (* 2 input) #+END_SRC -#+results: double +#+RESULTS: double : 16 #+NAME: squared @@ -13158,7 +13192,7 @@ @subsubsection @code{:var} (* input input) #+END_SRC -#+results: squared +#+RESULTS: squared : 4 @end example @@ -13177,7 +13211,7 @@ @subsubsection @code{:var} (concatenate 'string x " for you.") #+END_SRC -#+results: read-literal-example +#+RESULTS: read-literal-example : A literal example : on two lines for you. @@ -13219,7 +13253,7 @@ @subsubsection @code{:var} data #+END_SRC -#+results: +#+RESULTS: : a @end example @@ -13240,7 +13274,7 @@ @subsubsection @code{:var} data #+END_SRC -#+results: +#+RESULTS: | 2 | b | | 3 | c | | 4 | d | @@ -13262,7 +13296,7 @@ @subsubsection @code{:var} data #+END_SRC -#+results: +#+RESULTS: | 1 | 2 | 3 | 4 | @end example @@ -13282,7 +13316,7 @@ @subsubsection @code{:var} data #+END_SRC -#+results: +#+RESULTS: | 11 | 14 | 17 | @end example @@ -13315,7 +13349,7 @@ @subsubsection @code{:var} $data #+END_SRC -#+results: +#+RESULTS: : (a b c) @end example @@ -13381,10 +13415,10 @@ @subsubsection @code{:results} into the buffer. If the results look like a table they will be aligned as such by Org mode. E.g., @code{:results value raw}. @item @code{html} -Results are assumed to be HTML and will be enclosed in a @code{begin_html} +Results are assumed to be HTML and will be enclosed in a @code{BEGIN_HTML} block. E.g., @code{:results value html}. @item @code{latex} -Results assumed to be @LaTeX{} and are enclosed in a @code{begin_latex} block. +Results assumed to be @LaTeX{} and are enclosed in a @code{BEGIN_LaTeX} block. E.g., @code{:results value latex}. @item @code{code} Result are assumed to be parsable code and are enclosed in a code block. @@ -13617,21 +13651,34 @@ @subsubsection @code{:session} @node noweb, noweb-ref, session, Specific header arguments @subsubsection @code{:noweb} -The @code{:noweb} header argument controls expansion of ``noweb'' style (see -@ref{Noweb reference syntax}) references in a code block. This header -argument can have one of three values: @code{yes}, @code{no}, or @code{tangle}. +The @code{:noweb} header argument controls expansion of ``noweb'' syntax +references (see @ref{Noweb reference syntax}) when the code block is +evaluated, tangled, or exported. The @code{:noweb} header argument can have +one of the five values: @code{no}, @code{yes}, @code{tangle}, or +@code{no-export} @code{strip-export}. @itemize @bullet -@item @code{yes} -All ``noweb'' syntax references in the body of the code block will be -expanded before the block is evaluated, tangled or exported. @item @code{no} -The default. No ``noweb'' syntax specific action is taken when the code -block is evaluated, tangled or exported. +The default. ``Noweb'' syntax references in the body of the code block will +not be expanded before the code block is evaluated, tangled or exported. +@item @code{yes} +``Noweb'' syntax references in the body of the code block will be +expanded before the code block is evaluated, tangled or exported. @item @code{tangle} -All ``noweb'' syntax references in the body of the code block will be -expanded before the block is tangled, however ``noweb'' references will not -be expanded when the block is evaluated or exported. +``Noweb'' syntax references in the body of the code block will be expanded +before the code block is tangled. However, ``noweb'' syntax references will +not be expanded when the code block is evaluated or exported. +@item @code{no-export} +``Noweb'' syntax references in the body of the code block will be expanded +before the block is evaluated or tangled. However, ``noweb'' syntax +references will not be expanded when the code block is exported. +@item @code{strip-export} +``Noweb'' syntax references in the body of the code block will be expanded +before the block is evaluated or tangled. However, ``noweb'' syntax +references will not be removed when the code block is exported. +@item @code{eval} +``Noweb'' syntax references in the body of the code block will only be +expanded before the block is evaluated. @end itemize @subsubheading Noweb prefix lines @@ -13732,7 +13779,7 @@ @subsubsection @code{:cache} @item @code{yes} Every time the code block is run a SHA1 hash of the code and arguments passed to the block will be generated. This hash is packed into the -@code{#+results:} line and will be checked on subsequent +@code{#+RESULTS:} line and will be checked on subsequent executions of the code block. If the code block has not changed since the last time it was evaluated, it will not be re-evaluated. @end itemize @@ -13749,7 +13796,7 @@ @subsubsection @code{:cache} runif(1) #+END_SRC - #+results[a2a72cd647ad44515fab62e144796432793d68e1]: random + #+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random 0.4659510825295 #+NAME: caller @@ -13757,7 +13804,7 @@ @subsubsection @code{:cache} x #+END_SRC - #+results[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller + #+RESULTS[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller 0.254227238707244 @end example @@ -13801,7 +13848,7 @@ @subsubsection @code{:hlines} return tab #+END_SRC -#+results: echo-table +#+RESULTS: echo-table | a | b | c | | d | e | f | | g | h | i | @@ -13823,7 +13870,7 @@ @subsubsection @code{:hlines} return tab #+END_SRC -#+results: echo-table +#+RESULTS: echo-table | a | b | c | |---+---+---| | d | e | f | @@ -13861,7 +13908,7 @@ @subsubsection @code{:colnames} return [[val + '*' for val in row] for row in tab] #+END_SRC -#+results: echo-table-again +#+RESULTS: echo-table-again | a | |----| | b* | @@ -13904,7 +13951,7 @@ @subsubsection @code{:rownames} return [[val + 10 for val in row] for row in tab] #+END_SRC -#+results: echo-table-once-again +#+RESULTS: echo-table-once-again | one | 11 | 12 | 13 | 14 | 15 | | two | 16 | 17 | 18 | 19 | 20 | @end example @@ -13922,7 +13969,7 @@ @subsubsection @code{:shebang} first line of any tangled file holding the code block, and the file permissions of the tangled file are set to make it executable. -@node eval, , shebang, Specific header arguments +@node eval, wrap, shebang, Specific header arguments @subsubsection @code{:eval} The @code{:eval} header argument can be used to limit the evaluation of specific code blocks. The @code{:eval} header argument can be useful for @@ -13947,6 +13994,14 @@ @subsubsection @code{:eval} of the @code{org-confirm-babel-evaluate} variable see @ref{Code evaluation security}. +@node wrap, , eval, Specific header arguments +@subsubsection @code{:wrap} +The @code{:wrap} header argument is used to mark the results of source block +evaluation. The header argument can be passed a string that will be appended +to @code{#+BEGIN_} and @code{#+END_}, which will then be used to wrap the +results. If not string is specified then the results will be wrapped in a +@code{#+BEGIN/END_RESULTS} block. + @node Results of evaluation, Noweb reference syntax, Header arguments, Working With Source Code @section Results of evaluation @cindex code block, results of evaluation @@ -14016,7 +14071,7 @@ @subsubsection @code{:results output} print "bye" #+END_SRC -#+results: +#+RESULTS: : hello : bye @end example @@ -14029,7 +14084,7 @@ @subsubsection @code{:results output} print "bye" #+END_SRC -#+results: +#+RESULTS: : hello : 2 : bye @@ -14320,19 +14375,19 @@ @section Easy Templates The following template selectors are currently supported. @multitable @columnfractions 0.1 0.9 -@item @kbd{s} @tab @code{#+begin_src ... #+end_src} -@item @kbd{e} @tab @code{#+begin_example ... #+end_example} -@item @kbd{q} @tab @code{#+begin_quote ... #+end_quote} -@item @kbd{v} @tab @code{#+begin_verse ... #+end_verse} -@item @kbd{c} @tab @code{#+begin_center ... #+end_center} -@item @kbd{l} @tab @code{#+begin_latex ... #+end_latex} -@item @kbd{L} @tab @code{#+latex:} -@item @kbd{h} @tab @code{#+begin_html ... #+end_html} -@item @kbd{H} @tab @code{#+html:} -@item @kbd{a} @tab @code{#+begin_ascii ... #+end_ascii} -@item @kbd{A} @tab @code{#+ascii:} -@item @kbd{i} @tab @code{#+index:} line -@item @kbd{I} @tab @code{#+include:} line +@item @kbd{s} @tab @code{#+BEGIN_SRC ... #+END_SRC} +@item @kbd{e} @tab @code{#+BEGIN_EXAMPLE ... #+END_EXAMPLE} +@item @kbd{q} @tab @code{#+BEGIN_QUOTE ... #+END_QUOTE} +@item @kbd{v} @tab @code{#+BEGIN_VERSE ... #+END_VERSE} +@item @kbd{c} @tab @code{#+BEGIN_CENTER ... #+END_CENTER} +@item @kbd{l} @tab @code{#+BEGIN_LaTeX ... #+END_LaTeX} +@item @kbd{L} @tab @code{#+LaTeX:} +@item @kbd{h} @tab @code{#+BEGIN_HTML ... #+END_HTML} +@item @kbd{H} @tab @code{#+HTML:} +@item @kbd{a} @tab @code{#+BEGIN_ASCII ... #+END_ASCII} +@item @kbd{A} @tab @code{#+ASCII:} +@item @kbd{i} @tab @code{#+INDEX:} line +@item @kbd{I} @tab @code{#+INCLUDE:} line @end multitable For example, on an empty line, typing " -#+begin_src
+#+NAME: +#+BEGIN_SRC
-#+end_src +#+END_SRC @end example Where @code{} is a string used to name the code block, @@ -2520,11 +2520,11 @@ @section iCalendar export manual. The following shows a code block and its results. @example -#+begin_src emacs-lisp +#+BEGIN_SRC emacs-lisp (+ 1 2 3 4) -#+end_src +#+END_SRC -#+results: +#+RESULTS: : 10 @end example @@ -2663,10 +2663,17 @@ @section A cleaner outline view @node MobileOrg, , Clean view, Miscellaneous @section MobileOrg -@i{MobileOrg} is an application originally developed for the @i{iPhone/iPod -Touch} series of devices, developed by Richard Moreland. There is also an -independent implementation for Android devices, by Matt Jones. -For details, see the Org-mode manual. +@i{MobileOrg} is the name of the mobile companion app for Org mode, currently +available for iOS and for Android. @i{MobileOrg} offers offline viewing and +capture support for an Org mode system rooted on a ``real'' computer. It +does also allow you to record changes to existing entries. + +The @uref{http://mobileorg.ncogni.to/, iOS implementation} for the +@i{iPhone/iPod Touch/iPad} series of devices, was developed by Richard +Moreland. Android users should check out +@uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg Android} +by Matt Jones. The two implementations are not identical but offer similar +features. @seealso{ @uref{http://orgmode.org/manual/Miscellaneous.html#Miscellaneous, Chapter 15 diff --git a/doc/pdflayout.sty b/doc/pdflayout.sty index e16babc..1b421a1 100644 --- a/doc/pdflayout.sty +++ b/doc/pdflayout.sty @@ -1,4 +1,4 @@ -% Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. +% Copyright (C) 2007-2012 Free Software Foundation, Inc. % This file is part of GNU Emacs. diff --git a/doc/texinfo.tex b/doc/texinfo.tex index 067dad1..9631275 100644 --- a/doc/texinfo.tex +++ b/doc/texinfo.tex @@ -3,11 +3,11 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2011-08-15.20} +\def\texinfoversion{2012-01-03.18} % % Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -% 2007, 2008 Free Software Foundation, Inc. +% 2007, 2008-2012 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el index ded8ee4..682d802 100644 --- a/lisp/ob-awk.el +++ b/lisp/ob-awk.el @@ -24,9 +24,9 @@ ;;; Commentary: ;; Babel's awk can use special header argument: -;; +;; ;; - :in-file takes a path to a file of data to be processed by awk -;; +;; ;; - :stdin takes an Org-mode data or code block reference, the value ;; of which will be passed to the awk process through STDIN diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index 57ae4b9..ae7794b 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -34,15 +34,28 @@ ;; 3) we are adding the "file" and "cmdline" header arguments ;; ;; 4) there are no variables (at least for now) +;; +;; 5) it depends on a variable defined in org-exp-blocks (namely +;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded ;;; Code: (require 'ob) +(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks + (defvar org-babel-default-header-args:ditaa - '((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8")) + '((:results . "file") + (:exports . "results") + (:java . "-Dfile.encoding=UTF-8")) "Default arguments for evaluating a ditaa source block.") -(defvar org-ditaa-jar-path) +(defcustom org-ditaa-jar-option "-jar" + "Option for the ditaa jar file. +Do not leave leading or trailing spaces in this string." + :group 'org-babel + :version "24.1" + :type 'string) + (defun org-babel-execute:ditaa (body params) "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." @@ -55,7 +68,7 @@ (defun org-babel-execute:ditaa (body params) (cmdline (cdr (assoc :cmdline params))) (java (cdr (assoc :java params))) (in-file (org-babel-temp-file "ditaa-")) - (cmd (concat "java " java " -jar " + (cmd (concat "java " java " " org-ditaa-jar-option " " (shell-quote-argument (expand-file-name org-ditaa-jar-path)) " " cmdline diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 181f1be..2299dd4 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -43,31 +43,37 @@ (defcustom org-export-babel-evaluate t When set to nil no code will be evaluated as part of the export process." :group 'org-babel + :version "24.1" :type 'boolean) (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")))) + (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)))) - (link (when org-current-export-file - (org-make-link-string - (if heading - (concat org-current-export-file "::" heading) - org-current-export-file)))) - (export-buffer (current-buffer)) results) - (when link + (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 (get-file-buffer org-current-export-file)) + (set-buffer original-buffer) (save-restriction - (condition-case nil - (let ((org-link-search-inhibit-query t)) - (org-open-link-from-string link)) - (error (when heading - (goto-char (point-min)) - (re-search-forward (regexp-quote heading) nil t)))) + (when heading + (condition-case nil + (let ((org-link-search-inhibit-query t)) + (org-link-search heading)) + (error (when heading + (goto-char (point-min)) + (re-search-forward (regexp-quote heading) nil t))))) (setq results ,@body)) (set-buffer export-buffer) results))) @@ -109,13 +115,32 @@ (defun org-babel-exp-src-block (body &rest headers) (setf hash (org-babel-sha1-hash info))) ;; expand noweb references in the original file (setf (nth 1 info) - (if (and (cdr (assoc :noweb (nth 2 info))) - (string= "yes" (cdr (assoc :noweb (nth 2 info))))) - (org-babel-expand-noweb-references - info (get-file-buffer org-current-export-file)) - (nth 1 info))) + (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info)))) + (replace-regexp-in-string + (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)) + (nth 1 info)))) (org-babel-exp-do-export info 'block hash))))) +(defcustom org-babel-exp-call-line-template + "" + "Template used to export call lines. +This template may be customized to include the call line name +with any export markup. The template is filled out using +`org-fill-template', and the following %keys may be used. + + line --- call line + +An example value would be \"\\n: call: %line\" to export the call line +wrapped in a verbatim environment. + +Note: the results are inserted separately after the contents of +this template." + :group 'org-babel + :type 'string) + (defvar org-babel-default-lob-header-args) (defun org-babel-exp-non-block-elements (start end) "Process inline source and call lines between START and END for export." @@ -146,7 +171,7 @@ (defun org-babel-exp-non-block-elements (start end) (if (and (cdr (assoc :noweb params)) (string= "yes" (cdr (assoc :noweb params)))) (org-babel-expand-noweb-references - info (get-file-buffer org-current-export-file)) + info (org-babel-exp-get-export-buffer)) (nth 1 info))) (let ((code-replacement (save-match-data (org-babel-exp-do-export @@ -162,22 +187,24 @@ (defun org-babel-exp-non-block-elements (start end) (inlinep (match-string 11)) (inline-start (match-end 11)) (inline-end (match-end 0)) - (rep (let ((lob-info (org-babel-lob-get-info))) - (save-match-data - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-babel-clean-text-properties - (concat ":var results=" - (mapconcat #'identity - (butlast lob-info) - " "))))) - "" nil (car (last lob-info))) - 'lob))))) + (results (save-match-data + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (org-babel-merge-params + org-babel-default-header-args + org-babel-default-lob-header-args + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties + (concat ":var results=" + (mapconcat #'identity + (butlast lob-info) + " "))))) + "" nil (car (last lob-info))) + 'lob))) + (rep (org-fill-template + org-babel-exp-call-line-template + `(("line" . ,(nth 0 lob-info)))))) (if inlinep (save-excursion (goto-char inline-start) @@ -212,13 +239,37 @@ (defun org-babel-exp-do-export (info type &optional hash) ('both (org-babel-exp-results info type nil hash) (org-babel-exp-code info))))) +(defcustom org-babel-exp-code-template + "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC" + "Template used to export the body of 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 + 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) + (defun org-babel-exp-code (info) "Return the original code block formatted for export." (org-fill-template - "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC" + org-babel-exp-code-template `(("lang" . ,(nth 0 info)) + ("body" . ,(nth 1 info)) + ,@(mapcar (lambda (pair) + (cons (substring (symbol-name (car pair)) 1) + (format "%S" (cdr pair)))) + (nth 2 info)) ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info))) - ("body" . ,(nth 1 info))))) + ("name" . ,(or (nth 4 info) ""))))) (defun org-babel-exp-results (info type &optional silent hash) "Evaluate and return the results of the current code block for export. @@ -229,7 +280,8 @@ (defun org-babel-exp-results (info type &optional silent hash) (when (and org-export-babel-evaluate (not (and hash (equal hash (org-babel-current-result-hash))))) (let ((lang (nth 0 info)) - (body (nth 1 info))) + (body (nth 1 info)) + (info (copy-sequence info))) ;; skip code blocks which we can't evaluate (when (fboundp (intern (concat "org-babel-execute:" lang))) (org-babel-eval-wipe-error-buffer) diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el index 0cdef4e..5d07366 100644 --- a/lisp/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -34,7 +34,7 @@ ;;; Requirements: ;; - gnuplot :: http://www.gnuplot.info/ -;; +;; ;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html ;;; Code: diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index b04c3b0..53c5532 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -79,7 +79,7 @@ (defun org-babel-execute:haskell (body params) (cdr (member org-babel-haskell-eoe (reverse (mapcar #'org-babel-trim raw))))))) (org-babel-reassemble-table - (cond + (cond ((equal result-type 'output) (mapconcat #'identity (reverse (cdr results)) "\n")) ((equal result-type 'value) diff --git a/lisp/ob-js.el b/lisp/ob-js.el index bbb7aa0..893bc7b 100644 --- a/lisp/ob-js.el +++ b/lisp/ob-js.el @@ -55,6 +55,7 @@ (defvar org-babel-js-eoe "org-babel-js-eoe" (defcustom org-babel-js-cmd "node" "Name of command used to evaluate js blocks." :group 'org-babel + :version "24.1" :type 'string) (defvar org-babel-js-function-wrapper diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el index 1f412fd..0e9b0c6 100644 --- a/lisp/ob-lilypond.el +++ b/lisp/ob-lilypond.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2010-2012 Free Software Foundation, Inc. ;; Author: Martyn Jago -;; Keywords: babel language, literate programming +;; Keywords: babel language, literate programming, music score ;; Homepage: https://github.com/mjago/ob-lilypond ;; This file is part of GNU Emacs. @@ -23,10 +23,14 @@ ;;; Commentary: -;; Installation / usage info, and examples are available at -;; https://github.com/mjago/ob-lilypond +;; Installation, ob-lilypond documentation, and examples are available at +;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html +;; +;; Lilypond documentation can be found at +;; http://lilypond.org/manuals.html ;;; Code: + (require 'ob) (require 'ob-eval) (require 'ob-tangle) @@ -37,9 +41,11 @@ (defalias 'lilypond-mode 'LilyPond-mode) (add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) (defvar org-babel-default-header-args:lilypond '() - "Default header arguments for js code blocks.") + "Default header arguments for lilypond code blocks. +NOTE: The arguments are determined at lilypond compile time. +See (ly-set-header-args)") -(defconst ly-version "0.3" +(defconst ly-version "7.6" "The version number of the file ob-lilypond.el.") (defvar ly-compile-post-tangle t @@ -86,6 +92,10 @@ (defvar ly-gen-html nil "HTML generation can be turned on by default by setting LY-GEN-HTML to t") +(defvar ly-gen-pdf nil +"PDF generation can be turned on by default by setting +LY-GEN-PDF to t") + (defvar ly-use-eps nil "You can force the compiler to use the EPS backend by setting LY-USE-EPS to t") @@ -114,7 +124,7 @@ (defun org-babel-expand-body:lilypond (body params) body)))) vars) body)) - + (defun org-babel-execute:lilypond (body params) "This function is called by `org-babel-execute-src-block'. Depending on whether we are in arrange mode either: @@ -138,7 +148,7 @@ (defun ly-tangle () (defun ly-process-basic (body params) "Execute a lilypond block in basic mode" - + (let* ((result-params (cdr (assoc :result-params params))) (out-file (cdr (assoc :file params))) (cmdline (or (cdr (assoc :cmdline params)) @@ -147,7 +157,7 @@ (defun ly-process-basic (body params) (with-temp-file in-file (insert (org-babel-expand-body:generic body params))) - + (org-babel-eval (concat (ly-determine-ly-path) @@ -177,7 +187,7 @@ (defun ly-execute-tangled-ly () (ly-temp-file (ly-switch-extension (buffer-file-name) ".ly"))) (if (file-exists-p ly-tangled-file) - (progn + (progn (when (file-exists-p ly-temp-file) (delete-file ly-temp-file)) (rename-file ly-tangled-file @@ -203,18 +213,20 @@ (defun ly-compile-lilyfile (file-name &optional test) (arg-2 nil) ;infile (arg-3 "*lilypond*") ;buffer (arg-4 t) ;display - (arg-5 (if ly-gen-png "--png" "")) ;&rest... - (arg-6 (if ly-gen-html "--html" "")) - (arg-7 (if ly-use-eps "-dbackend=eps" "")) - (arg-8 (if ly-gen-svg "-dbackend=svg" "")) - (arg-9 (concat "--output=" (file-name-sans-extension file-name))) - (arg-10 file-name)) + (arg-4 t) ;display + (arg-5 (if ly-gen-png "--png" "")) ;&rest... + (arg-6 (if ly-gen-html "--html" "")) + (arg-7 (if ly-gen-pdf "--pdf" "")) + (arg-8 (if ly-use-eps "-dbackend=eps" "")) + (arg-9 (if ly-gen-svg "-dbackend=svg" "")) + (arg-10 (concat "--output=" (file-name-sans-extension file-name))) + (arg-11 file-name)) (if test - `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 - ,arg-6 ,arg-7 ,arg-8 ,arg-9 ,arg-10) + `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6 + ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11) (call-process - arg-1 arg-2 arg-3 arg-4 arg-5 - arg-6 arg-7 arg-8 arg-9 arg-10)))) + arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 + arg-7 arg-8 arg-9 arg-10 arg-11)))) (defun ly-check-for-compile-error (file-name &optional test) "Check for compile error. @@ -243,7 +255,7 @@ (defun ly-mark-error-line (file-name line) "Mark the erroneous lines in the lilypond org buffer. FILE-NAME is full path to lilypond file. LINE is the erroneous line" - + (switch-to-buffer-other-window (concat (file-name-nondirectory (ly-switch-extension file-name ".org")))) @@ -256,7 +268,7 @@ (defun ly-mark-error-line (file-name line) (set-mark (point)) (goto-char (- (point) (length line)))) (goto-char temp)))) - + (defun ly-parse-line-num (&optional buffer) "Extract error line number." @@ -284,7 +296,7 @@ (defun ly-parse-error-line (file-name lineNo) "Extract the erroneous line from the tangled .ly file FILE-NAME is full path to lilypond file. LINENO is the number of the erroneous line" - + (with-temp-buffer (insert-file-contents (ly-switch-extension file-name ".ly") nil nil nil t) @@ -294,12 +306,12 @@ (defun ly-parse-error-line (file-name lineNo) (forward-line (- lineNo 1)) (buffer-substring (point) (point-at-eol))) nil))) - + (defun ly-attempt-to-open-pdf (file-name &optional test) "Attempt to display the generated pdf file FILE-NAME is full path to lilypond file If TEST is non-nil, the shell command is returned and is not run" - + (when ly-display-pdf-post-tangle (let ((pdf-file (ly-switch-extension file-name ".pdf"))) (if (file-exists-p pdf-file) @@ -307,8 +319,12 @@ (defun ly-attempt-to-open-pdf (file-name &optional test) (concat (ly-determine-pdf-path) " " pdf-file))) (if test cmd-string - (shell-command cmd-string))) - (message "No pdf file generated so can't display!"))))) + (start-process + "\"Audition pdf\"" + "*lilypond*" + (ly-determine-pdf-path) + pdf-file))) + (message "No pdf file generated so can't display!"))))) (defun ly-attempt-to-play-midi (file-name &optional test) "Attempt to play the generated MIDI file @@ -322,7 +338,11 @@ (defun ly-attempt-to-play-midi (file-name &optional test) (concat (ly-determine-midi-path) " " midi-file))) (if test cmd-string - (shell-command cmd-string))) + (start-process + "\"Audition midi\"" + "*lilypond*" + (ly-determine-midi-path) + midi-file))) (message "No midi file generated so can't play!"))))) (defun ly-determine-ly-path (&optional test) @@ -340,7 +360,7 @@ (defun ly-determine-ly-path (&optional test) (defun ly-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") @@ -352,7 +372,7 @@ (defun ly-determine-pdf-path (&optional test) (defun ly-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") @@ -360,10 +380,10 @@ (defun ly-determine-midi-path (&optional test) ((string= sys-type "win32") ly-win32-midi-path) (t ly-nix-midi-path)))) - + (defun ly-toggle-midi-play () "Toggle whether midi will be played following a successful compilation" - + (interactive) (setq ly-play-midi-post-tangle (not ly-play-midi-post-tangle)) @@ -373,7 +393,7 @@ (defun ly-toggle-midi-play () (defun ly-toggle-pdf-display () "Toggle whether pdf will be displayed following a successful compilation" - + (interactive) (setq ly-display-pdf-post-tangle (not ly-display-pdf-post-tangle)) @@ -399,6 +419,15 @@ (defun ly-toggle-html-generation () (message (concat "HTML generation has been " (if ly-gen-html "ENABLED." "DISABLED.")))) +(defun ly-toggle-pdf-generation () + "Toggle whether pdf will be generated by compilation" + + (interactive) + (setq ly-gen-pdf + (not ly-gen-pdf)) + (message (concat "PDF generation has been " + (if ly-gen-pdf "ENABLED." "DISABLED.")))) + (defun ly-toggle-arrange-mode () "Toggle whether in Arrange mode or Basic mode" @@ -428,6 +457,7 @@ (defun ly-get-header-args (mode) '((:tangle . "yes") (:noweb . "yes") (:results . "silent") + (:cache . "yes") (:comments . "yes"))) (t '((:results . "file") @@ -441,6 +471,4 @@ (defun ly-set-header-args (mode) (provide 'ob-lilypond) - - ;;; ob-lilypond.el ends here diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index 2e45787..a0ec1b7 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -49,6 +49,7 @@ (defcustom org-babel-lisp-dir-fmt For example a value of \"(progn ;; %s\\n %%s)\" would ignore the current directory string." :group 'org-babel + :version "24.1" :type 'string) (defun org-babel-expand-body:lisp (body params) diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index eff2737..6abb313 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -39,6 +39,7 @@ (defcustom org-babel-lob-files '() "Files used to populate the `org-babel-library-of-babel'. To add files to this list use the `org-babel-lob-ingest' command." :group 'org-babel + :version "24.1" :type 'list) (defvar org-babel-default-lob-header-args '((:exports . "results")) @@ -104,7 +105,7 @@ (defun org-babel-lob-get-info () (beginning-of-line 1) (when (looking-at org-babel-lob-one-liner-regexp) (append - (mapcar #'org-babel-clean-text-properties + (mapcar #'org-babel-clean-text-properties (list (format "%s%s(%s)%s" (nonempty 3 12) @@ -115,7 +116,7 @@ (defun org-babel-lob-get-info () (nonempty 9 18))) (list (length (if (= (length (match-string 12)) 0) (match-string 2) (match-string 11)))))))))) - + (defun org-babel-lob-execute (info) "Execute the lob call specified by INFO." (let ((params (org-babel-process-params diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el index 6b4c54d..8d61ff3 100644 --- a/lisp/ob-ocaml.el +++ b/lisp/ob-ocaml.el @@ -98,7 +98,7 @@ (defun org-babel-variable-assignments:ocaml (params) (lambda (pair) (format "let %s = %s;;" (car pair) (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) (mapcar #'cdr (org-babel-get-header params :var)))) - + (defun org-babel-ocaml-elisp-to-ocaml (val) "Return a string of ocaml code which evaluates to VAL." (if (listp val) diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el index 04fcad5..7f4e468 100644 --- a/lisp/ob-picolisp.el +++ b/lisp/ob-picolisp.el @@ -45,10 +45,10 @@ ;; PicoLisp _is_ an object-oriented database with a Prolog-based query ;; language implemented in PicoLisp (Pilog). Database objects are -;; first-class members of the language. +;; first-class members of the language. ;; PicoLisp is an extremely productive framework for the development -;; of interactive web-applications (on top of a database). +;; of interactive web-applications (on top of a database). ;;; Requirements: @@ -76,6 +76,7 @@ (defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe" (defcustom org-babel-picolisp-cmd "pil" "Name of command used to evaluate picolisp blocks." :group 'org-babel + :version "24.1" :type 'string) (defun org-babel-expand-body:picolisp (body params &optional processed-params) @@ -96,7 +97,7 @@ (defun org-babel-expand-body:picolisp (body params &optional processed-params) (defun org-babel-execute:picolisp (body params) "Execute a block of Picolisp code with org-babel. This function is - called by `org-babel-execute-src-block'" + called by `org-babel-execute-src-block'" (message "executing Picolisp source code block") (let* ( ;; name of the session or "none" @@ -119,7 +120,7 @@ (defun org-babel-execute:picolisp (body params) ((member "value" result-params) (format "(out \"/dev/null\" %s)" full-body)) (t full-body)))) - + ((lambda (result) (if (or (member "verbatim" result-params) (member "scalar" result-params) diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index da70052..55729eb 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -44,6 +44,7 @@ (defvar org-babel-default-header-args:plantuml (defcustom org-plantuml-jar-path nil "Path to the plantuml.jar file." :group 'org-babel + :version "24.1" :type 'string) (defun org-babel-execute:plantuml (body params) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index bd9e389..cde594e 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -60,7 +60,7 @@ (declare-function org-narrow-to-subtree "org" ()) (declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) (declare-function org-show-context "org" (&optional key)) -(declare-function org-pop-to-buffer-same-window +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (defvar org-babel-ref-split-regexp diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index 8f7e44e..19cce58 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -28,10 +28,10 @@ ;;; Requirements: ;; - ruby and irb executables :: http://www.ruby-lang.org/ -;; +;; ;; - ruby-mode :: Can be installed through ELPA, or from ;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el -;; +;; ;; - inf-ruby mode :: Can be installed through ELPA, or from ;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index 4bcde94..e1f7657 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -54,6 +54,7 @@ (defvar org-babel-scheme-eoe "org-babel-scheme-eoe" (defcustom org-babel-scheme-cmd "guile" "Name of command used to evaluate scheme blocks." :group 'org-babel + :version "24.1" :type 'string) (defun org-babel-expand-body:scheme (body params) diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el index 6f4cb4f..1fbac1d 100644 --- a/lisp/ob-sh.el +++ b/lisp/ob-sh.el @@ -56,14 +56,13 @@ (defun org-babel-execute:sh (body params) This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-sh-initiate-session (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) (stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string (org-babel-ref-resolve stdin)))) (cdr (assoc :stdin params)))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:sh params)))) (org-babel-reassemble-table - (org-babel-sh-evaluate session full-body result-params stdin) + (org-babel-sh-evaluate session full-body params stdin) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name @@ -134,29 +133,38 @@ (defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'" (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 result-params stdin) +(defun org-babel-sh-evaluate (session body &optional params stdin) "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." ((lambda (results) (when results - (if (or (member "scalar" result-params) - (member "verbatim" result-params) - (member "output" result-params)) - results - (let ((tmp-file (org-babel-temp-file "sh-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))))) + (let ((result-params (cdr (assoc :result-params params)))) + (if (or (member "scalar" result-params) + (member "verbatim" result-params) + (member "output" result-params)) + results + (let ((tmp-file (org-babel-temp-file "sh-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)))))) (cond (stdin ; external shell script w/STDIN (let ((script-file (org-babel-temp-file "sh-script-")) - (stdin-file (org-babel-temp-file "sh-stdin-"))) - (with-temp-file script-file (insert body)) + (stdin-file (org-babel-temp-file "sh-stdin-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (string= "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) (with-temp-file stdin-file (insert stdin)) (with-temp-buffer (call-process-shell-command - (format "%s %s" org-babel-sh-command script-file) + (if shebang + script-file + (format "%s %s" org-babel-sh-command script-file)) stdin-file (current-buffer)) (buffer-string)))) @@ -182,7 +190,17 @@ (defun org-babel-sh-evaluate (session body &optional result-params stdin) (list org-babel-sh-eoe-indicator)))) 2)) "\n")) ('otherwise ; external shell script - (org-babel-eval org-babel-sh-command (org-babel-trim body)))))) + (if (cdr (assoc :shebang params)) + (let ((script-file (org-babel-temp-file "sh-script-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (string= "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (org-babel-eval script-file "")) + (org-babel-eval org-babel-sh-command (org-babel-trim body))))))) (defun org-babel-sh-strip-weird-long-prompt (string) "Remove prompt cruft from a string of shell output." diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index 56fbdae..20fbad3 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -40,7 +40,7 @@ ;; - add more useful header arguments (user, passwd, database, etc...) ;; - support for more engines (currently only supports mysql) ;; - what's a reasonable way to drop table data into SQL? -;; +;; ;;; Code: (require 'ob) @@ -70,6 +70,10 @@ (defun org-babel-execute:sql (body params) (org-babel-temp-file "sql-out-"))) (header-delim "") (command (case (intern engine) + ('monetdb (format "mclient -f tab %s < %s > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) ('msosql (format "osql %s -s \"\t\" -i %s -o %s" (or cmdline "") (org-babel-process-file-name in-file) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 5e498ab..2af033c 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -47,6 +47,7 @@ (defcustom org-babel-tangle-lang-exts written in this language. If no entry is found in this list, then the name of the language is used." :group 'org-babel-tangle + :version "24.1" :type '(repeat (cons (string "Language name") @@ -55,16 +56,19 @@ (defcustom org-babel-tangle-lang-exts (defcustom org-babel-post-tangle-hook nil "Hook run in code files tangled by `org-babel-tangle'." :group 'org-babel + :version "24.1" :type 'hook) (defcustom org-babel-pre-tangle-hook '(save-buffer) "Hook run at the beginning of `org-babel-tangle'." :group 'org-babel + :version "24.1" :type 'hook) (defcustom org-babel-tangle-body-hook nil "Hook run over the contents of each code block body." :group 'org-babel + :version "24.1" :type 'hook) (defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]" @@ -79,6 +83,7 @@ (defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]" 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-tangle-comment-format-end "%source-name ends here" @@ -93,6 +98,7 @@ (defcustom org-babel-tangle-comment-format-end "%source-name ends here" 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 @@ -101,6 +107,7 @@ (defcustom org-babel-process-comment-text #'org-babel-trim should take a single string argument and return a string result. The default value is `org-babel-trim'." :group 'org-babel + :version "24.1" :type 'function) (defun org-babel-find-file-noselect-refresh (file) @@ -283,7 +290,7 @@ (defun org-babel-tangle-clean () (interactive) (goto-char (point-min)) (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) - (re-search-forward "<<[^[:space:]]*>>" nil t)) + (re-search-forward (org-babel-noweb-wrap) nil t)) (delete-region (save-excursion (beginning-of-line 1) (point)) (save-excursion (end-of-line 1) (forward-char 1) (point))))) @@ -344,11 +351,7 @@ (defun org-babel-tangle-collect-blocks (&optional language) body params (and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) - (if (and (cdr (assoc :noweb params)) ;; expand noweb refs - (let ((nowebs (split-string - (cdr (assoc :noweb params))))) - (or (member "yes" nowebs) - (member "tangle" nowebs)))) + (if (org-babel-noweb-p params :tangle) (org-babel-expand-noweb-references info) (nth 1 info))))) (comment diff --git a/lisp/ob.el b/lisp/ob.el index 9205a20..531cd16 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -33,6 +33,8 @@ (defvar org-src-lang-modes) (defvar org-babel-library-of-babel) (declare-function show-all "outline" ()) (declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag)) (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) @@ -57,6 +59,7 @@ (defvar org-babel-library-of-babel) (declare-function org-cycle "org" (&optional arg)) (declare-function org-uniquify "org" (list)) (declare-function org-current-level "org" ()) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function org-table-import "org-table" (file arg)) (declare-function org-add-hook "org-compat" (hook function &optional append local)) @@ -104,6 +107,7 @@ (defcustom org-confirm-babel-evaluate t `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to remove code block execution from the C-c C-c keybinding." :group 'org-babel + :version "24.1" :type '(choice boolean function)) ;; don't allow this variable to be changed through file settings (put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) @@ -111,6 +115,7 @@ (defcustom org-confirm-babel-evaluate t (defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil "Remove code block evaluation from the C-c C-c key binding." :group 'org-babel + :version "24.1" :type 'boolean) (defcustom org-babel-results-keyword "RESULTS" @@ -120,6 +125,23 @@ (defcustom org-babel-results-keyword "RESULTS" :group 'org-babel :type 'string) +(defcustom org-babel-noweb-wrap-start "<<" + "String used to begin a noweb reference in a code block. +See also `org-babel-noweb-wrap-end'." + :group 'org-babel + :type 'string) + +(defcustom org-babel-noweb-wrap-end ">>" + "String used to end a noweb reference in a code block. +See also `org-babel-noweb-wrap-start'." + :group 'org-babel + :type 'string) + +(defun org-babel-noweb-wrap (&optional regexp) + (concat org-babel-noweb-wrap-start + (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") + org-babel-noweb-wrap-end)) + (defvar org-babel-src-name-regexp "^[ \t]*#\\+name:[ \t]*" "Regular expression used to match a source name line.") @@ -381,7 +403,7 @@ (defconst org-babel-common-header-args-w-values (mkdirp . ((yes no))) (no-expand) (noeval) - (noweb . ((yes no tangle))) + (noweb . ((yes no tangle no-export strip-export))) (noweb-ref . :any) (noweb-sep . :any) (padline . ((yes no))) @@ -394,7 +416,8 @@ (defconst org-babel-common-header-args-w-values (session . :any) (shebang . :any) (tangle . ((tangle yes no :any))) - (var . :any))) + (var . :any) + (wrap . :any))) (defconst org-babel-header-arg-names (mapcar #'car org-babel-common-header-args-w-values) @@ -492,12 +515,9 @@ (defun org-babel-execute-src-block (&optional arg info params) (new-hash (when cache? (org-babel-sha1-hash info))) (old-hash (when cache? (org-babel-current-result-hash))) (body (setf (nth 1 info) - (let ((noweb (cdr (assoc :noweb params)))) - (if (and noweb - (or (string= "yes" noweb) - (string= "tangle" noweb))) - (org-babel-expand-noweb-references info) - (nth 1 info))))) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info)))) (dir (cdr (assoc :dir params))) (default-directory (or (and dir (file-name-as-directory dir)) default-directory)) @@ -571,8 +591,7 @@ (defun org-babel-expand-src-block (&optional arg info params) (lambda (el1 el2) (string< (symbol-name (car el1)) (symbol-name (car el2))))))) (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) + (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:" @@ -669,8 +688,7 @@ (defun org-babel-load-in-session (&optional arg info) (lang (nth 0 info)) (params (nth 2 info)) (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) + (if (org-babel-noweb-p params :eval) (org-babel-expand-noweb-references info) (nth 1 info)))) (session (cdr (assoc :session params))) @@ -1442,13 +1460,35 @@ (defun org-babel-goto-src-block-head () (defun org-babel-goto-named-src-block (name) "Go to a named source-code block." (interactive - (let ((completion-ignore-case t)) - (list (org-icompleting-read "source-block name: " - (org-babel-src-block-names) nil t)))) + (let ((completion-ignore-case t) + (under-point (thing-at-point 'line))) + (list (org-icompleting-read + "source-block name: " (org-babel-src-block-names) nil t + (cond + ;; noweb + ((string-match (org-babel-noweb-wrap) under-point) + (let ((block-name (match-string 1 under-point))) + (string-match "[^(]*" block-name) + (match-string 0 block-name))) + ;; #+call: + ((string-match org-babel-lob-one-liner-regexp under-point) + (let ((source-info (car (org-babel-lob-get-info)))) + (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) + (let ((source-name (match-string 1 source-info))) + source-name)))) + ;; #+results: + ((string-match (concat "#\\+" org-babel-results-keyword + "\\:\s+\\([^\\(]*\\)") under-point) + (match-string 1 under-point)) + ;; symbol-at-point + ((and (thing-at-point 'symbol)) + (org-babel-find-named-block (thing-at-point 'symbol)) + (thing-at-point 'symbol)) + ("")))))) (let ((point (org-babel-find-named-block name))) (if point ;; taken from `org-open-at-point' - (progn (goto-char point) (org-show-context)) + (progn (org-mark-ring-push) (goto-char point) (org-show-context)) (message "source-code block '%s' not found in this buffer" name)))) (defun org-babel-find-named-block (name) @@ -1874,6 +1914,9 @@ (defun org-babel-insert-result (setq end (point-marker)) ;; possibly wrap result (cond + ((assoc :wrap (nth 2 info)) + (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) + (wrap (concat "#+BEGIN_" name) (concat "#+END_" name)))) ((member "html" result-params) (wrap "#+BEGIN_HTML" "#+END_HTML")) ((member "latex" result-params) @@ -1925,11 +1968,10 @@ (defun org-babel-result-end () (progn (re-search-forward (concat "^" (match-string 1) ":END:")) (forward-char 1) (point))) (t - (let ((case-fold-search t) - (blocks-re (regexp-opt - (list "latex" "html" "example" "src" "result" "org")))) - (if (looking-at (concat "[ \t]*#\\+begin_" blocks-re)) - (progn (re-search-forward (concat "[ \t]*#\\+end_" blocks-re) nil t) + (let ((case-fold-search t)) + (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)")) + (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1)) + nil t) (forward-char 1)) (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") (forward-line 1)))) @@ -2073,8 +2115,11 @@ (defun org-babel-merge-params (&rest plists) (:tangle ;; take the latest -- always overwrite (setq tangle (or (list (cdr pair)) tangle))) (:noweb - (setq noweb (e-merge '(("yes" "no" "tangle")) noweb - (split-string (or (cdr pair) ""))))) + (setq noweb (e-merge + '(("yes" "no" "tangle" "no-export" + "strip-export" "eval")) + noweb + (split-string (or (cdr pair) ""))))) (:cache (setq cache (e-merge '(("yes" "no")) cache (split-string (or (cdr pair) ""))))) @@ -2106,6 +2151,20 @@ (defvar *org-babel-use-quick-and-dirty-noweb-expansion* nil not properly allow code blocks to inherit the \":noweb-ref\" header argument from buffer or subtree wide properties.") +(defun org-babel-noweb-p (params context) + "Check if PARAMS require expansion in CONTEXT. +CONTEXT may be one of :tangle, :export or :eval." + (flet ((intersect (as bs) + (when as + (if (member (car as) bs) + (car as) + (intersect (cdr as) bs))))) + (intersect (case context + (:tangle '("yes" "tangle" "no-export" "strip-export")) + (:eval '("yes" "no-export" "strip-export" "eval")) + (:export '("yes"))) + (split-string (or (cdr (assoc :noweb params)) ""))))) + (defun org-babel-expand-noweb-references (&optional info parent-buffer) "Expand Noweb references in the body of the current source code block. @@ -2153,8 +2212,7 @@ (defun org-babel-expand-noweb-references (&optional info parent-buffer) (with-temp-buffer (insert body) (goto-char (point-min)) (setq index (point)) - (while (and (re-search-forward "<<\\([^ \t\n].+?[^ \t\n]\\|[^ \t\n]\\)>>" - nil t)) + (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) (save-match-data (setf source-name (match-string 1))) (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) (save-match-data @@ -2226,7 +2284,7 @@ (defun org-babel-expand-noweb-references (&optional info parent-buffer) ;; possibly raise an error if named block doesn't exist (if (member lang org-babel-noweb-error-langs) (error "%s" (concat - "<<" source-name ">> " + (org-babel-noweb-wrap source-name) "could not be resolved (see " "`org-babel-noweb-error-langs')")) ""))) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 25f9b8c..1b033e8 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -247,7 +247,9 @@ (defconst org-sorting-choice ;; Keep custom values for `org-agenda-filter-preset' compatible with ;; the new variable `org-agenda-tag-filter-preset'. -(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) +(if (fboundp 'defvaralias) + (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) + (defvaralias 'org-agenda-filter 'org-agenda-tag-filter)) (defconst org-agenda-custom-commands-local-options `(repeat :tag "Local settings for this command. Remember to quote values" @@ -647,6 +649,7 @@ (defcustom org-agenda-todo-ignore-timestamp nil to make his option also apply to the tags-todo list." :group 'org-agenda-skip :group 'org-agenda-todo-list + :version "24.1" :type '(choice (const :tag "Ignore future timestamp todos" future) (const :tag "Ignore past or present timestamp todos" past) @@ -794,6 +797,7 @@ (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil because you will take care of it on the day when scheduled." :group 'org-agenda-skip :group 'org-agenda-daily/weekly + :version "24.1" :type '(choice (const :tag "Alwas show prewarning" nil) (const :tag "Remove prewarning if entry is scheduled" t) @@ -858,6 +862,7 @@ (defcustom org-agenda-menu-show-matcher t Setting it to nil is good if matcher strings are very long and/or if you want to use two-column display (see `org-agenda-menu-two-column')." :group 'org-agenda + :version "24.1" :type 'boolean) (defcustom org-agenda-menu-two-column nil @@ -865,6 +870,7 @@ (defcustom org-agenda-menu-two-column nil If you use this, you probably want to set `org-agenda-menu-show-matcher' to nil." :group 'org-agenda + :version "24.1" :type 'boolean) (defcustom org-finalize-agenda-hook nil @@ -888,6 +894,7 @@ (defcustom org-agenda-follow-indirect nil "Non-nil means `org-agenda-follow-mode' displays only the current item's tree, in an indirect buffer." :group 'org-agenda + :version "24.1" :type 'boolean) (defcustom org-agenda-show-outline-path t @@ -1040,11 +1047,13 @@ (defcustom org-agenda-time-leading-zero nil "Non-nil means use leading zero for military times in agenda. For example, 9:30am would become 09:30 rather than 9:30." :group 'org-agenda-daily/weekly + :version "24.1" :type 'boolean) (defcustom org-agenda-timegrid-use-ampm nil "When set, show AM/PM style timestamps on the timegrid." :group 'org-agenda + :version "24.1" :type 'boolean) (defun org-agenda-time-of-day-to-ampm (time) @@ -1092,6 +1101,7 @@ (defcustom org-agenda-move-date-from-past-immediately-to-today t to today. WHen nil, just move one day forward even if the date stays in the past." :group 'org-agenda-daily/weekly + :version "24.1" :type 'boolean) (defcustom org-agenda-include-diary nil @@ -1104,6 +1114,7 @@ (defcustom org-agenda-include-deadlines t "If non-nil, include entries within their deadline warning period. Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly + :version "24.1" :type 'boolean) (defcustom org-agenda-repeating-timestamp-show-all t @@ -1179,6 +1190,7 @@ (defcustom org-agenda-clock-consistency-checks :short-face face for clock intervals that are too short" :group 'org-agenda-daily/weekly :group 'org-clock + :version "24.1" :type 'plist) (defcustom org-agenda-log-mode-add-notes t @@ -1237,6 +1249,7 @@ (defcustom org-agenda-search-view-always-boolean nil is a regexp marked with braces like \"{abc}\", this will also switch to boolean search." :group 'org-agenda-search-view + :version "24.1" :type 'boolean) (if (fboundp 'defvaralias) @@ -1247,6 +1260,7 @@ (defcustom org-agenda-search-view-force-full-words nil "Non-nil means, search words must be matches as complete words. When nil, they may also match part of a word." :group 'org-agenda-search-view + :version "24.1" :type 'boolean) (defgroup org-agenda-time-grid nil @@ -1310,12 +1324,14 @@ (defcustom org-agenda-time-grid (defcustom org-agenda-show-current-time-in-grid t "Non-nil means show the current time in the time grid." :group 'org-agenda-time-grid + :version "24.1" :type 'boolean) (defcustom org-agenda-current-time-string "now - - - - - - - - - - - - - - - - - - - - - - - - -" "The string for the current time marker in the agenda." :group 'org-agenda-time-grid + :version "24.1" :type 'string) (defgroup org-agenda-sorting nil @@ -1526,6 +1542,7 @@ (defcustom org-agenda-inactive-leader "[" "Text preceding item pulled into the agenda by inactive time stamps. These entries are added to the agenda when pressing \"[\"." :group 'org-agenda-line-format + :version "24.1" :type '(list (string :tag "Scheduled today ") (string :tag "Scheduled previously"))) @@ -1564,6 +1581,7 @@ (defcustom org-agenda-remove-timeranges-from-blocks nil "Non-nil means remove time ranges specifications in agenda items that span on several days." :group 'org-agenda-line-format + :version "24.1" :type 'boolean) (defcustom org-agenda-default-appointment-duration nil @@ -1645,6 +1663,7 @@ (defcustom org-agenda-day-face-function nil returns a face, or nil if does not want to specify a face and let the normal rules apply." :group 'org-agenda-line-format + :version "24.1" :type 'function) (defcustom org-agenda-category-icon-alist nil @@ -1677,6 +1696,7 @@ (defcustom org-agenda-category-icon-alist nil (\"Emacs\" '(space . (:width (16))))" :group 'org-agenda-line-format + :version "24.1" :type '(alist :key-type (string :tag "Regexp matching category") :value-type (choice (list :tag "Icon" (string :tag "File or data") @@ -1739,6 +1759,7 @@ (defcustom org-agenda-bulk-custom-functions nil the custom function `set-category' on the selected entries. Note that functions in this alist don't need to be quoted." :type 'alist + :version "24.1" :group 'org-agenda) (eval-when-compile @@ -1768,7 +1789,7 @@ (defun org-add-agenda-custom-command (entry) (setcdr ass (cdr entry)) (push entry org-agenda-custom-commands)))) -;;; Define the Org-agenda-mode +;;; Define the org-agenda-mode (defvar org-agenda-mode-map (make-sparse-keymap) "Keymap for `org-agenda-mode'.") @@ -4375,7 +4396,7 @@ (defun org-agenda-list-stuck-projects (&rest ignore) ;;; Diary integration (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. -(defvar list-diary-entries-hook) +(defvar diary-list-entries-hook) (defvar diary-time-regexp) (defun org-get-entries-from-diary (date) "Get the (Emacs Calendar) diary entries for DATE." @@ -4384,8 +4405,8 @@ (defun org-get-entries-from-diary (date) (diary-display-hook '(fancy-diary-display)) (diary-display-function 'fancy-diary-display) (pop-up-frames nil) - (list-diary-entries-hook - (cons 'org-diary-default-entry list-diary-entries-hook)) + (diary-list-entries-hook + (cons 'org-diary-default-entry diary-list-entries-hook)) (diary-file-name-prefix-function nil) ; turn this feature off (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) entries @@ -6190,8 +6211,9 @@ (defun org-agenda-redo () (recenter window-line))) (defvar org-global-tags-completion-table nil) +(defvar org-agenda-filtered-by-category nil) (defvar org-agenda-filter-form nil) - +(defvar org-agenda-filtered-by-category nil) (defun org-agenda-filter-by-category (strip) "Keep only those lines in the agenda buffer that have a specific category. The category is that of the current line." @@ -6369,10 +6391,9 @@ (defun org-agenda-compare-effort (op value) (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) value)))) -(defvar org-agenda-filtered-by-category nil) (defun org-agenda-filter-apply (filter type) "Set FILTER as the new agenda filter and apply it." - (let (tags) + (let (tags cat) (if (eq type 'tag) (setq org-agenda-tag-filter filter) (setq org-agenda-category-filter filter @@ -7150,10 +7171,13 @@ (defun org-agenda-show (&optional full-entry) (select-window win))) (defvar org-agenda-show-window nil) -(defun org-agenda-show-and-scroll-up () +(defun org-agenda-show-and-scroll-up (&optional arg) "Display the Org-mode file which contains the item at point. -When called repeatedly, scroll the window that is displaying the buffer." - (interactive) +When called repeatedly, scroll the window that is displaying the buffer. +With a \\[universal-argument] prefix, use `org-show-entry' instead of +`show-subtree' to display the item, so that drawers and logbooks stay +folded." + (interactive "P") (let ((win (selected-window))) (if (and (window-live-p org-agenda-show-window) (eq this-command last-command)) @@ -7161,7 +7185,7 @@ (defun org-agenda-show-and-scroll-up () (select-window org-agenda-show-window) (ignore-errors (scroll-up))) (org-agenda-goto t) - (show-subtree) + (if arg (org-show-entry) (show-subtree)) (setq org-agenda-show-window (selected-window))) (select-window win))) @@ -7996,6 +8020,7 @@ (defcustom org-agenda-insert-diary-strategy 'date-tree (defcustom org-agenda-insert-diary-extract-time nil "Non-nil means extract any time specification from the diary entry." :group 'org-agenda + :version "24.1" :type 'boolean) (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 4137e2c..db3b825 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -43,6 +43,7 @@ (defcustom org-archive-default-command 'org-archive-subtree (defcustom org-archive-reversed-order nil "Non-nil means make the tree first child under the archive heading, not last." :group 'org-archive + :version "24.1" :type 'boolean) (defcustom org-archive-sibling-heading "Archive" @@ -72,6 +73,7 @@ (defcustom org-archive-stamp-time t (defcustom org-archive-subtree-add-inherited-tags 'infile "Non-nil means append inherited tags when archiving a subtree." :group 'org-archive + :version "24.1" :type '(choice (const :tag "Never" nil) (const :tag "When archiving a subtree to the same file" infile) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index c652671..90f39fd 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -108,7 +108,7 @@ (defun org-export-as-latin1-to-buffer (&rest args) (defun org-export-as-utf8 (&rest args) "Like `org-export-as-ascii', use encoding for special symbols." (interactive) - (org-export-as-encoding 'org-export-as-ascii + (org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any) 'utf8 args)) diff --git a/lisp/org-attach.el b/lisp/org-attach.el index 73d0fa4..7ba3d72 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -101,6 +101,7 @@ (defvar org-attach-inherited nil (defcustom org-attach-store-link-p nil "Non-nil means store a link to a file when attaching it." :group 'org-attach + :version "24.1" :type '(choice (const :tag "Don't store link" nil) (const :tag "Link to origin location" t) diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el index 49b9cf7..7fddbb2 100644 --- a/lisp/org-bbdb.el +++ b/lisp/org-bbdb.el @@ -120,6 +120,7 @@ (declare-function diary-ordinal-suffix "diary-lib" (n)) (defvar date) ;; dynamically scoped from Org +(defvar name) ;; dynamically scoped from Org ;; Customization diff --git a/lisp/org-beamer.el b/lisp/org-beamer.el index 28b79a0..575967b 100644 --- a/lisp/org-beamer.el +++ b/lisp/org-beamer.el @@ -43,6 +43,7 @@ (defgroup org-beamer nil (defcustom org-beamer-use-parts nil "" :group 'org-beamer + :version "24.1" :type 'boolean) (defcustom org-beamer-frame-level 1 @@ -52,6 +53,7 @@ (defcustom org-beamer-frame-level 1 You can set this to 4 as well, if you at the same time set `org-beamer-use-parts' to make the top levels `\part'." :group 'org-beamer + :version "24.1" :type '(choice (const :tag "Frames need a BEAMER_env property" nil) (integer :tag "Specific level makes a frame"))) @@ -60,12 +62,14 @@ (defcustom org-beamer-frame-default-options "" "Default options string to use for frames, should contains the [brackets]. And example for this is \"[allowframebreaks]\"." :group 'org-beamer + :version "24.1" :type '(string :tag "[options]")) (defcustom org-beamer-column-view-format "%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)" "Default column view format that should be used to fill the template." :group 'org-beamer + :version "24.1" :type '(choice (const :tag "Do not insert Beamer column view format" nil) (string :tag "Beamer column view format"))) @@ -76,6 +80,7 @@ (defcustom org-beamer-themes When a beamer template is filled, this will be the default for BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}." :group 'org-beamer + :version "24.1" :type '(choice (const :tag "Do not insert Beamer themes" nil) (string :tag "Beamer themes"))) @@ -102,6 +107,7 @@ (defconst org-beamer-environments-default ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}") ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}") ("example" "e" "\\begin{example}%a%U%x" "\\end{example}") + ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}") ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}") ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}") ("normal" "h" "%h" "") ; Emit the heading as normal text @@ -142,6 +148,7 @@ (defcustom org-beamer-environments-extra nil close The closing string of the environment." :group 'org-beamer + :version "24.1" :type '(repeat (list (string :tag "Environment") @@ -402,6 +409,7 @@ (defun org-beamer-amend-header () (defcustom org-beamer-fragile-re "\\\\\\(verb\\|lstinline\\)\\|^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}" "If this regexp matches in a frame, the frame is marked as fragile." :group 'org-beamer + :version "24.1" :type 'regexp) (defface org-beamer-tag '((t (:box (:line-width 1 :color grey40)))) @@ -511,6 +519,7 @@ (defun org-beamer-auto-fragile-frames () (defcustom org-beamer-outline-frame-title "Outline" "Default title of a frame containing an outline." :group 'org-beamer + :version "24.1" :type '(string :tag "Outline frame title") ) @@ -519,6 +528,7 @@ (defcustom org-beamer-outline-frame-options nil You might want to put e.g. [allowframebreaks=0.9] here. Remember to include square brackets." :group 'org-beamer + :version "24.1" :type '(string :tag "Outline frame options") ) diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el index 17cdbc2..cebd6ca 100644 --- a/lisp/org-bibtex.el +++ b/lisp/org-bibtex.el @@ -216,12 +216,14 @@ (defvar *org-bibtex-entries* nil (defcustom org-bibtex-autogen-keys nil "Set to a truth value to use `bibtex-generate-autokey' to generate keys." :group 'org-bibtex + :version "24.1" :type 'boolean) (defcustom org-bibtex-prefix nil "Optional prefix for all bibtex property names. For example setting to 'BIB_' would allow interoperability with fireforg." :group 'org-bibtex + :version "24.1" :type 'string) (defcustom org-bibtex-treat-headline-as-title t @@ -230,6 +232,7 @@ (defcustom org-bibtex-treat-headline-as-title t the property. If this value is t, `org-bibtex-check' will ignore a missing title field." :group 'org-bibtex + :version "24.1" :type 'boolean) (defcustom org-bibtex-export-arbitrary-fields nil @@ -238,6 +241,7 @@ (defcustom org-bibtex-export-arbitrary-fields nil ensure that other org-properties, such as CATEGORY or LOGGING are not placed in the exported bibtex entry." :group 'org-bibtex + :version "24.1" :type 'boolean) (defcustom org-bibtex-key-property "CUSTOM_ID" @@ -247,11 +251,13 @@ (defcustom org-bibtex-key-property "CUSTOM_ID" to enable global links, but only with great caution, as global IDs must be unique." :group 'org-bibtex + :version "24.1" :type 'string) (defcustom org-bibtex-tags nil "List of tag(s) that should be added to new bib entries." :group 'org-bibtex + :version "24.1" :type '(repeat :tag "Tag" (string))) (defcustom org-bibtex-tags-are-keywords nil @@ -266,17 +272,20 @@ (defcustom org-bibtex-tags-are-keywords nil 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-export-tags-as-keywords` is t." :group 'org-bibtex + :version "24.1" :type '(repeat :tag "Tag" (string))) (defcustom org-bibtex-type-property-name "btype" "Property in which to store bibtex entry type (e.g., article)." :group 'org-bibtex + :version "24.1" :type 'string) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 0fd8003..e3bd9f7 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -56,7 +56,7 @@ (date &optional keep-restriction)) (declare-function org-table-get-specials "org-table" ()) (declare-function org-table-goto-line "org-table" (N)) -(declare-function org-pop-to-buffer-same-window "org-compat" +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (defvar org-remember-default-headline) @@ -262,6 +262,7 @@ (defcustom org-capture-templates nil info | %:type %:file %:node calendar | %:type %:date" :group 'org-capture + :version "24.1" :type '(repeat (choice :value ("" "" entry (file "~/org/notes.org") "") @@ -336,12 +337,21 @@ (defcustom org-capture-before-finalize-hook nil The capture buffer is still current when this hook runs and it is widened to the entire buffer." :group 'org-capture + :version "24.1" :type 'hook) (defcustom org-capture-after-finalize-hook nil "Hook that is run right after a capture process is finalized. Suitable for window cleanup" :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-prepare-finalize-hook nil + "Hook that is run before the finalization starts. +The capture buffer is current and still narrowed." + :group 'org-capture + :version "24.1" :type 'hook) ;;; The property list for keeping information about the capture process @@ -527,6 +537,8 @@ (defun org-capture-finalize (&optional stay-with-capture) (buffer-base-buffer (current-buffer))) (error "This does not seem to be a capture buffer for Org-mode")) + (run-hooks 'org-capture-prepare-finalize-hook) + ;; Did we start the clock in this capture buffer? (when (and org-capture-clock-was-started org-clock-marker (marker-buffer org-clock-marker) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 591f59c..46d9af8 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -226,6 +226,7 @@ (defcustom org-task-overrun-text nil When this is a string, it is prepended to the clock string as an indication, also using the face `org-mode-line-clock-overrun'." :group 'org-clock + :version "24.1" :type '(choice (const :tag "Just mark the time string" nil) (string :tag "Text to prepend"))) @@ -267,12 +268,14 @@ (defcustom org-clocktable-defaults :formatter nil) "Default properties for clock tables." :group 'org-clock + :version "24.1" :type 'plist) (defcustom org-clock-clocktable-formatter 'org-clocktable-write-default "Function to turn clocking data into a table. For more information, see `org-clocktable-write-default'." :group 'org-clocktable + :version "24.1" :type 'function) ;; FIXME: translate es and nl last string "Clock summary at" @@ -283,6 +286,7 @@ (defcustom org-clock-clocktable-language-setup ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")) "Terms used in clocktable, translated to different languages." :group 'org-clocktable + :version "24.1" :type 'alist) (defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file) @@ -310,11 +314,13 @@ (defcustom org-clock-auto-clock-resolution 'when-no-clock-is-running (defcustom org-clock-report-include-clocking-task nil "When non-nil, include the current clocking task time in clock reports." :group 'org-clock + :version "24.1" :type 'boolean) (defcustom org-clock-resolve-expert nil "Non-nil means do not show the splash buffer with the clock resolver." :group 'org-clock + :version "24.1" :type 'boolean) (defvar org-clock-in-prepare-hook nil @@ -1387,7 +1393,8 @@ (defun org-clock-out (&optional fail-quietly at-time) (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m (if remove " => LINE REMOVED" "")) (run-hooks 'org-clock-out-hook) - (org-clock-delete-current)))))) + (unless (org-clocking-p) + (org-clock-delete-current))))))) (add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) @@ -1989,7 +1996,7 @@ (defun org-clocktable-shift (dir n) (encode-time 0 0 0 (+ d n) m y)))) ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) (require 'cal-iso) - (setq date (calendar-gregorian-from-absolute + (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (list (+ mw n) 1 y)))) (setq ins (format-time-string "%G-W%V" @@ -2006,7 +2013,7 @@ (defun org-clocktable-shift (dir n) (setq mw 5 y (- y 1)) ()) - (setq date (calendar-gregorian-from-absolute + (setq date (calendar-gregorian-from-absolute (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) (setq ins (format-time-string (concatenate 'string (number-to-string y) "-Q" (number-to-string (+ mw n))) @@ -2456,7 +2463,9 @@ (defun org-clock-get-table-data (file params) (org-clock-sum ts te (unless (null matcher) (lambda () - (let ((tags-list (org-get-tags-at))) + (let* ((tags-list (org-get-tags-at)) + (org-scanner-tags tags-list) + (org-trust-scanner-tags t)) (eval matcher))))) (goto-char (point-min)) (setq st t) @@ -2631,4 +2640,3 @@ (defun org-clock-persistence-insinuate () (provide 'org-clock) ;;; org-clock.el ends here - diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index f3e63b0..f60c61e 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -76,21 +76,21 @@ (defgroup org-crypt nil "Org Crypt" - :tag "Org Crypt" + :tag "Org Crypt" :group 'org) (defcustom org-crypt-tag-matcher "crypt" "The tag matcher used to find headings whose contents should be encrypted. See the \"Match syntax\" section of the org manual for more details." - :type 'string + :type 'string :group 'org-crypt) (defcustom org-crypt-key "" "The default key to use when encrypting the contents of a heading. This setting can also be overridden in the CRYPTKEY property." - :type 'string + :type 'string :group 'org-crypt) (defcustom org-crypt-disable-auto-save 'ask @@ -111,6 +111,7 @@ (defcustom org-crypt-disable-auto-save 'ask NOTE: This only works for entries which have a tag that matches `org-crypt-tag-matcher'." :group 'org-crypt + :version "24.1" :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Ask" ask) diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el index ea94d41..42e2687 100644 --- a/lisp/org-ctags.el +++ b/lisp/org-ctags.el @@ -162,6 +162,7 @@ (defcustom org-ctags-path-to-ctags (t "ctags-exuberant")) "Full path to the ctags executable file." :group 'org-ctags + :version "24.1" :type 'file) (defcustom org-ctags-open-link-functions @@ -170,6 +171,7 @@ (defcustom org-ctags-open-link-functions org-ctags-ask-append-topic) "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active." :group 'org-ctags + :version "24.1" :type 'hook :options '(org-ctags-find-tag org-ctags-ask-rebuild-tags-file-then-find-tag @@ -191,6 +193,7 @@ (defcustom org-ctags-new-topic-template The following patterns are replaced in the string: `%t' - replaced with the capitalized title of the hyperlink" :group 'org-ctags + :version "24.1" :type 'string) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index 499ab5d..5dfc160 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -150,6 +150,7 @@ (defcustom org-export-docbook-footnote-id-prefix "fn-" (defcustom org-export-docbook-footnote-separator ", " "Text used to separate footnotes." :group 'org-export-docbook + :version "24.1" :type 'string) (defcustom org-export-docbook-emphasis-alist @@ -195,6 +196,7 @@ (defcustom org-export-docbook-xslt-stylesheet nil Object (FO) files. You can use either `fo/docbook.xsl' that comes with DocBook, or any customization layer you may have." :group 'org-export-docbook + :version "24.1" :type 'string) (defcustom org-export-docbook-xslt-proc-command nil diff --git a/lisp/org-entities.el b/lisp/org-entities.el index fe3c528..8b5b3f3 100644 --- a/lisp/org-entities.el +++ b/lisp/org-entities.el @@ -44,6 +44,7 @@ (defcustom org-entities-ascii-explanatory nil 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) (defcustom org-entities-user nil @@ -68,6 +69,7 @@ (defcustom org-entities-user nil If you define new entities here that require specific LaTeX packages to be loaded, add these packages to `org-export-latex-packages-alist'." :group 'org-entities + :version "24.1" :type '(repeat (list (string :tag "name ") diff --git a/lisp/org-eshell.el b/lisp/org-eshell.el index de6f9fb..f572095 100644 --- a/lisp/org-eshell.el +++ b/lisp/org-eshell.el @@ -45,7 +45,7 @@ (defun org-eshell-open (link) (if (get-buffer eshell-buffer-name) (org-pop-to-buffer-same-window eshell-buffer-name) (eshell)) - (end-of-buffer) + (goto-char (point-max)) (eshell-kill-input) (insert command) (eshell-send-input))) diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el index 020eefb..78eaa15 100644 --- a/lisp/org-exp-blocks.el +++ b/lisp/org-exp-blocks.el @@ -135,6 +135,7 @@ (defcustom org-export-blocks-witheld (defcustom org-export-blocks-postblock-hook nil "Run after blocks have been processed with `org-export-blocks-preprocess'." :group 'org-export-general + :version "24.1" :type 'hook) (defun org-export-blocks-html-quote (body &optional open close) @@ -224,7 +225,7 @@ (defun org-export-blocks-preprocess () ;;-------------------------------------------------------------------------------- ;; ditaa: create images from ASCII art using the ditaa utility -(defvar org-ditaa-jar-path (expand-file-name +(defcustom org-ditaa-jar-path (expand-file-name "ditaa.jar" (file-name-as-directory (expand-file-name @@ -233,7 +234,9 @@ (defvar org-ditaa-jar-path (expand-file-name (expand-file-name "../contrib" (file-name-directory (or load-file-name buffer-file-name))))))) - "Path to the ditaa jar executable.") + "Path to the ditaa jar executable." + :group 'org-babel + :type 'string) (defvar org-export-current-backend) ; dynamically bound in org-exp.el (defun org-export-blocks-format-ditaa (body &rest headers) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index a2f0cfc..fef6c33 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -98,6 +98,7 @@ (defcustom org-export-kill-product-buffer-when-displayed nil This applied to the commands `org-export-as-html-and-open' and `org-export-as-pdf-and-open'." :group 'org-export-general + :version "24.1" :type 'boolean) (defcustom org-export-run-in-background nil @@ -120,6 +121,7 @@ (defcustom org-export-initial-scope 'buffer "The initial scope when exporting with `org-export'. This variable can be either set to 'buffer or 'subtree." :group 'org-export-general + :version "24.1" :type '(choice (const :tag "Export current buffer" 'buffer) (const :tag "Export current subtree" 'subtree))) @@ -229,6 +231,7 @@ (defcustom org-export-default-language "en" (defcustom org-export-date-timestamp-format "%Y-%m-%d" "Time string format for Org timestamps in the #+DATE option." :group 'org-export-general + :version "24.1" :type 'string) (defvar org-export-page-description "" @@ -326,6 +329,7 @@ (defcustom org-export-with-tasks t nil remove all tasks before export list of TODO kwds keep only tasks with these keywords" :group 'org-export-general + :version "24.1" :type '(choice (const :tag "All tasks" t) (const :tag "No tasks" nil) @@ -376,6 +380,7 @@ (defcustom org-export-email-info nil This option can also be set with the +OPTIONS line, e.g. \"email:t\"." :group 'org-export-general + :version "24.1" :type 'boolean) (defcustom org-export-creator-info t @@ -603,6 +608,7 @@ (defcustom org-export-table-remove-empty-lines t This is the global equivalent of the :remove-nil-lines option when locally sending a table with #+ORGTBL." :group 'org-export-tables + :version "24.1" :type 'boolean) (defcustom org-export-prefer-native-exporter-for-tables nil diff --git a/lisp/org-faces.el b/lisp/org-faces.el index e71ce23..481d662 100644 --- a/lisp/org-faces.el +++ b/lisp/org-faces.el @@ -351,6 +351,7 @@ (defcustom org-faces-easy-properties color." :group 'org-faces :group 'org-todo + :version "24.1" :type '(repeat (cons (choice (const todo) (const tag) (const priority)) (choice (const :foreground) (const :background))))) @@ -547,6 +548,7 @@ (defcustom org-fontify-quote-and-verse-blocks nil When nil, format these as normal Org. This is the default, because the content of these blocks will still be treated as Org syntax." :group 'org-faces + :version "24.1" :type 'boolean) (defface org-clock-overlay ;; copied from secondary-selection @@ -732,6 +734,7 @@ (defcustom org-cycle-level-faces t level org-n-level-faces" :group 'org-appearance :group 'org-faces + :version "24.1" :type 'boolean) (defface org-latex-and-export-specials diff --git a/lisp/org-feed.el b/lisp/org-feed.el index f5186aa..6901ffa 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -80,7 +80,7 @@ ;; that received the input of the feed. You should add FEEDSTATUS ;; to your list of drawers in the files that receive feed input: ;; -;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS +;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS ;; ;; Acknowledgments ;; --------------- diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 196dd99..3be853e 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -57,6 +57,7 @@ (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") (defvar org-outline-regexp-bol) ; defined in org.el diff --git a/lisp/org-freemind.el b/lisp/org-freemind.el index 8b77400..3b94d92 100644 --- a/lisp/org-freemind.el +++ b/lisp/org-freemind.el @@ -414,6 +414,7 @@ (defcustom org-freemind-node-css-style ;; with this setting now, but not before??? Was this perhaps a java ;; bug or is it a windows xp bug (some resource gets exhausted if you ;; use sticky keys which I do). + :version "24.1" :group 'org-freemind) (defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp) diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index 2a3f946..5b855c2 100644 --- a/lisp/org-gnus.el +++ b/lisp/org-gnus.el @@ -62,6 +62,7 @@ (defcustom org-gnus-nnimap-query-article-no-from-file nil So if following a link to a Gnus article takes ages, try setting this variable to `t'." :group 'org-link-store + :version "24.1" :type 'boolean) @@ -175,7 +176,7 @@ (defun org-gnus-store-link () (setq to (or to (gnus-fetch-original-field "To")) newsgroups (gnus-fetch-original-field "Newsgroups") x-no-archive (gnus-fetch-original-field "x-no-archive"))) - (org-store-link-props :type "gnus" :from from :subject subject + (org-store-link-props :type "gnus" :from from :subject subject :message-id message-id :group group :to to) (when date (org-add-link-props :date date :date-timestamp date-ts diff --git a/lisp/org-habit.el b/lisp/org-habit.el index be0efff..4274aae 100644 --- a/lisp/org-habit.el +++ b/lisp/org-habit.el @@ -70,11 +70,13 @@ (defcustom org-habit-show-habits-only-for-today t (defcustom org-habit-today-glyph ?! "Glyph character used to identify today." :group 'org-habit + :version "24.1" :type 'character) (defcustom org-habit-completed-glyph ?* "Glyph character used to show completed days on which a task was done." :group 'org-habit + :version "24.1" :type 'character) (defface org-habit-clear-face diff --git a/lisp/org-html.el b/lisp/org-html.el index 69d88fe..5cecc44 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -64,6 +64,7 @@ (defcustom org-export-html-footnote-format "%s" (defcustom org-export-html-footnote-separator ", " "Text used to separate footnotes." :group 'org-export-html + :version "24.1" :type 'string) (defcustom org-export-html-coding-system nil @@ -252,6 +253,7 @@ (defcustom org-export-html-mathjax-options #+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" :group 'org-export-html + :version "24.1" :type '(list :greedy t (list :tag "path (the path from where to load MathJax.js)" (const :format " " path) (string)) @@ -335,6 +337,7 @@ (defcustom org-export-html-mathjax-template " "The MathJax setup for XHTML files." :group 'org-export-html + :version "24.1" :type 'string) (defcustom org-export-html-tag-class-prefix "" @@ -361,6 +364,7 @@ (defcustom org-export-html-headline-anchor-format " to the headline (e.g. \"sec-2\"). When set to `nil', don't insert HTML anchors in headlines." :group 'org-export-html + :version "24.1" :type 'string) (defcustom org-export-html-preamble t @@ -392,6 +396,7 @@ (defcustom org-export-html-preamble-format '(("en" "")) If you need to use a \"%\" character, you need to escape it like that: \"%%\"." :group 'org-export-html + :version "24.1" :type 'string) (defcustom org-export-html-postamble 'auto @@ -432,6 +437,7 @@ (defcustom org-export-html-postamble-format If you need to use a \"%\" character, you need to escape it like that: \"%%\"." :group 'org-export-html + :version "24.1" :type 'string) (defcustom org-export-html-home/up-format @@ -548,6 +554,7 @@ (defcustom org-export-html-table-align-individual-fields t is ignored by some browsers (like Firefox, Safari). Opera does it right though." :group 'org-export-tables + :version "24.1" :type 'boolean) (defcustom org-export-html-table-use-header-tags-for-first-column nil @@ -578,6 +585,7 @@ (defcustom org-export-html-protect-char-alist (">" . ">")) "Alist of characters to be converted by `org-html-protect'." :group 'org-export-html + :version "24.1" :type '(repeat (cons (string :tag "Character") (string :tag "HTML equivalent")))) @@ -639,6 +647,7 @@ (defcustom org-export-html-divs '("preamble" "content" "postamble") DIV, the second one for the content DIV and the third one for the postamble DIV." :group 'org-export-html + :version "24.1" :type '(list (string :tag " Div for the preamble:") (string :tag " Div for the content:") diff --git a/lisp/org-icalendar.el b/lisp/org-icalendar.el index 29f6c74..d73a619 100644 --- a/lisp/org-icalendar.el +++ b/lisp/org-icalendar.el @@ -54,6 +54,7 @@ (defcustom org-icalendar-alarm-time 0 - The alarm will go off N minutes before the event - only a DISPLAY action is defined." :group 'org-export-icalendar + :version "24.1" :type 'integer) (defcustom org-icalendar-combined-name "OrgMode" @@ -64,6 +65,7 @@ (defcustom org-icalendar-combined-name "OrgMode" (defcustom org-icalendar-combined-description nil "Calendar description for the combined iCalendar (all agenda files)." :group 'org-export-icalendar + :version "24.1" :type 'string) (defcustom org-icalendar-use-plain-timestamp t @@ -74,6 +76,7 @@ (defcustom org-icalendar-use-plain-timestamp t (defcustom org-icalendar-honor-noexport-tag nil "Non-nil means don't export entries with a tag in `org-export-exclude-tags'." :group 'org-export-icalendar + :version "24.1" :type 'boolean) (defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) @@ -213,6 +216,7 @@ (defcustom org-icalendar-date-time-format - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" :group 'org-export-icalendar + :version "24.1" :type '(choice (const :tag "Local time" ":%Y%m%dT%H%M%S") (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") diff --git a/lisp/org-id.el b/lisp/org-id.el index 0b829d6..55e826f 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -73,7 +73,7 @@ (require 'org) (declare-function message-make-fqdn "message" ()) -(declare-function org-pop-to-buffer-same-window +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) ;;; Customization @@ -641,7 +641,3 @@ (defun org-id-open (id) (provide 'org-id) ;;; org-id.el ends here - - - - diff --git a/lisp/org-indent.el b/lisp/org-indent.el index 99a7584..056c22b 100644 --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -45,6 +45,7 @@ (declare-function org-inlinetask-get-task-level "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) (declare-function org-list-item-body-column "org-list" (item)) +(defvar org-inlinetask-show-first-star) (defgroup org-indent nil "Options concerning dynamic virtual outline indentation." @@ -293,8 +294,10 @@ (defsubst org-indent-set-line-properties (l w h) (let ((stars (aref org-indent-stars (min l org-indent-max-levels)))) (and stars - (concat org-indent-inlinetask-first-star - (substring stars 1))))) + (if (org-bound-and-true-p org-inlinetask-show-first-star) + (concat org-indent-inlinetask-first-star + (substring stars 1)) + stars)))) (h (aref org-indent-stars (min l org-indent-max-levels))) (t (aref org-indent-strings diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index a14e404..dbb9b22 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -90,6 +90,9 @@ (defgroup org-inlinetask nil (defcustom org-inlinetask-min-level 15 "Minimum level a headline must have before it is treated as an inline task. +Don't set it to something higher than `29' or clocking will break since this +is the hardcoded maximum number of stars `org-clock-sum' will work with. + It is strongly recommended that you set `org-cycle-max-level' not at all, or to a number smaller than this one. In fact, when `org-cycle-max-level' is not set, it will be assumed to be one less than the value of smaller than @@ -99,6 +102,12 @@ (defcustom org-inlinetask-min-level 15 (const :tag "Off" nil) (integer))) +(defcustom org-inlinetask-show-first-star nil + "Non-nil means display the first star of an inline task as additional marker. +When nil, the first star is not shown." + :tag "Org Inline Tasks" + :group 'org-structure) + (defcustom org-inlinetask-export t "Non-nil means export inline tasks. When nil, they will not be exported." @@ -173,6 +182,7 @@ (defcustom org-inlinetask-default-state nil This should be the state `org-inlinetask-insert-task' should use by default, or nil of no state should be assigned." :group 'org-inlinetask + :version "24.1" :type '(choice (const :tag "No state" nil) (string :tag "Specific state"))) @@ -431,9 +441,12 @@ (defun org-inlinetask-fontify (limit) 'org-hide 'org-warning))) (while (re-search-forward re limit t) - (add-text-properties (match-beginning 1) (match-end 1) - `(face ,start-face font-lock-fontified t)) - (add-text-properties (match-beginning 2) (match-end 2) + (if org-inlinetask-show-first-star + (add-text-properties (match-beginning 1) (match-end 1) + `(face ,start-face font-lock-fontified t))) + (add-text-properties (match-beginning + (if org-inlinetask-show-first-star 2 1)) + (match-end 2) '(face org-hide font-lock-fontified t)) (add-text-properties (match-beginning 3) (match-end 3) '(face org-inlinetask font-lock-fontified t))))) @@ -451,7 +464,7 @@ (defun org-inlinetask-toggle-visibility () ((= end start)) ;; Inlinetask was folded: expand it. ((get-char-property (1+ start) 'invisible) - (outline-flag-region start end nil)) + (org-show-entry)) (t (outline-flag-region start end t))))) (defun org-inlinetask-remove-END-maybe () diff --git a/lisp/org-irc.el b/lisp/org-irc.el index 0dd0512..1074283 100644 --- a/lisp/org-irc.el +++ b/lisp/org-irc.el @@ -59,7 +59,7 @@ (declare-function erc-server-buffer "erc" ()) (declare-function erc-get-server-nickname-list "erc" ()) (declare-function erc-cmd-JOIN "erc" (channel &optional key)) -(declare-function org-pop-to-buffer-same-window +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (defvar org-irc-client 'erc diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 6d46501..03664b4 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -218,6 +218,7 @@ (defcustom org-export-latex-inputenc-alist nil will cause \\usepackage[utf8x]{inputenc} to be used for buffers that are written as utf8 files." :group 'org-export-latex + :version "24.1" :type '(repeat (cons (string :tag "Derived from buffer") @@ -283,6 +284,7 @@ (defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}" (defcustom org-export-latex-tag-markup "\\textbf{%s}" "Markup for tags, as a printf format." :group 'org-export-latex + :version "24.1" :type 'string) (defcustom org-export-latex-timestamp-markup "\\textit{%s}" @@ -293,6 +295,7 @@ (defcustom org-export-latex-timestamp-markup "\\textit{%s}" (defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}" "A printf format string to be applied to inactive time stamps." :group 'org-export-latex + :version "24.1" :type 'string) (defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}" @@ -302,11 +305,12 @@ (defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}" (defcustom org-export-latex-href-format "\\href{%s}{%s}" "A printf format string to be applied to href links. -The format must contain either two %s instances or just one. -If it contains two %s instances, the first will be filled with +The format must contain either two %s instances or just one. +If it contains two %s instances, the first will be filled with the link, the second with the link description. If it contains only one, the %s will be filled with the link." :group 'org-export-latex + :version "24.1" :type 'string) (defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}" @@ -314,11 +318,13 @@ (defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}" The format must contain one or two %s instances. The first one will be filled with the link, the second with its description." :group 'org-export-latex + :version "24.1" :type 'string) (defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\," "Text used to separate footnotes." :group 'org-export-latex + :version "24.1" :type 'string) (defcustom org-export-latex-quotes @@ -336,6 +342,7 @@ (defcustom org-export-latex-quotes for allowed characters before/after the quote, the second string defines the replacement string for this quote." :group 'org-export-latex + :version "24.1" :type '(list (cons :tag "Opening quote" (string :tag "Regexp for char before") @@ -361,6 +368,7 @@ (defcustom org-export-latex-table-caption-above t "When non-nil, the caption is set above the table. When nil, the caption is set below the table." :group 'org-export-latex + :version "24.1" :type 'boolean) (defcustom org-export-latex-tables-column-borders nil @@ -478,6 +486,7 @@ (defcustom org-export-latex-listings-w-names t `org-export-latex-listings' variable) can be named in the style of noweb." :group 'org-export-latex + :version "24.1" :type 'boolean) (defcustom org-export-latex-minted-langs @@ -499,6 +508,7 @@ (defcustom org-export-latex-minted-langs pygmentize -L lexers " :group 'org-export-latex + :version "24.1" :type '(repeat (list (symbol :tag "Major mode ") @@ -522,6 +532,7 @@ (defcustom org-export-latex-listings-options nil Note that the same options will be applied to blocks of all languages." :group 'org-export-latex + :version "24.1" :type '(repeat (list (string :tag "Listings option name ") @@ -545,6 +556,7 @@ (defcustom org-export-latex-minted-options nil as the start of the minted environment. Note that the same options will be applied to blocks of all languages." :group 'org-export-latex + :version "24.1" :type '(repeat (list (string :tag "Minted option name ") @@ -586,11 +598,13 @@ (defcustom org-export-latex-image-default-option "width=.9\\linewidth" (defcustom org-latex-default-figure-position "htb" "Default position for latex figures." :group 'org-export-latex + :version "24.1" :type 'string) (defcustom org-export-latex-tabular-environment "tabular" "Default environment used to build tables." :group 'org-export-latex + :version "24.1" :type 'string) (defcustom org-export-latex-inline-image-extensions @@ -667,6 +681,7 @@ (defcustom org-export-pdf-logfiles '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") "The list of file extensions to consider as LaTeX logfiles." :group 'org-export-pdf + :version "24.1" :type '(repeat (string :tag "Extension"))) (defcustom org-export-pdf-remove-logfiles t @@ -2227,7 +2242,7 @@ (defun org-export-latex-links () ;; a LaTeX issue, but we here implement a work-around anyway. (setq path (org-export-latex-protect-amp path) desc (org-export-latex-protect-amp desc))) - (insert + (insert (if (string-match "%s.*%s" org-export-latex-href-format) (format org-export-latex-href-format path desc) (format org-export-latex-href-format path)))) diff --git a/lisp/org-list.el b/lisp/org-list.el index 2caecff..b865aed 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -215,6 +215,7 @@ (defcustom org-alphabetical-lists nil 26 items will fallback to standard numbering. Alphabetical counters like \"[@c]\" will be recognized." :group 'org-plain-lists + :version "24.1" :type 'boolean) (defcustom org-list-two-spaces-after-bullet-regexp nil @@ -258,6 +259,7 @@ (defcustom org-list-automatic-rules '((bullet . t) outdenting a list whose bullet is * to column 0 will change that bullet to \"-\"." :group 'org-plain-lists + :version "24.1" :type '(alist :tag "Sets of rules" :key-type (choice @@ -277,6 +279,7 @@ (defcustom org-list-use-circular-motion nil \\[org-move-item-down], \\[org-next-item] and \\[org-previous-item]." :group 'org-plain-lists + :version "24.1" :type 'boolean) (defvar org-checkbox-statistics-hook nil @@ -306,6 +309,7 @@ (defcustom org-list-indent-offset 0 By setting this to a small number, usually 1 or 2, one can more clearly distinguish sub-items in a list." :group 'org-plain-lists + :version "24.1" :type 'integer) (defcustom org-list-radio-list-templates @@ -710,15 +714,15 @@ (defun org-list-struct () ;; equally indented than BEG-CELL's cdr. Also, store ending ;; position of items in END-LST-2. (catch 'exit - (while t - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (while t + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) (org-get-indentation)))) - (cond - ((>= (point) lim-down) + (cond + ((>= (point) lim-down) ;; At downward limit: this is de facto the end of the ;; list. Save point as an ending position, and jump to ;; part 3. - (throw 'exit + (throw 'exit (push (cons 0 (funcall end-before-blank)) end-lst-2))) ;; At a verbatim block, move to its end. Point is at bol ;; and 'org-example property is set by whole lines: @@ -1015,6 +1019,41 @@ (defun org-list-get-list-type (item struct prevs) ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) (t 'unordered)))) +(defun org-list-get-item-number (item struct prevs parents) + "Return ITEM's sequence number. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. PARENTS is the +alist of ancestors, as returned by `org-list-parents-alist'. + +Return value is a list of integers. Counters have an impact on +that value." + (let ((get-relative-number + (function + (lambda (item struct prevs) + ;; Return relative sequence number of ITEM in the sub-list + ;; it belongs. STRUCT is the list structure. PREVS is + ;; the alist of previous items. + (let ((seq 0) (pos item) counter) + (while (and (not (setq counter (org-list-get-counter pos struct))) + (setq pos (org-list-get-prev-item pos struct prevs))) + (incf seq)) + (if (not counter) (1+ seq) + (cond + ((string-match "[A-Za-z]" counter) + (+ (- (string-to-char (upcase (match-string 0 counter))) 64) + seq)) + ((string-match "[0-9]+" counter) + (+ (string-to-number (match-string 0 counter)) seq)) + (t (1+ seq))))))))) + ;; Cons each parent relative number into return value (OUT). + (let ((out (list (funcall get-relative-number item struct prevs))) + (parent item)) + (while (setq parent (org-list-get-parent parent struct parents)) + (push (funcall get-relative-number parent struct prevs) out)) + ;; Return value. + out))) + ;;; Searching @@ -1239,9 +1278,8 @@ (defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet) (insert body item-sep) ;; 5. Add new item to STRUCT. (mapc (lambda (e) - (let ((p (car e)) - (end (nth 6 e))) - (cond + (let ((p (car e)) (end (nth 6 e))) + (cond ;; Before inserted item, positions don't change but ;; an item ending after insertion has its end shifted ;; by SIZE-OFFSET. @@ -2129,6 +2167,18 @@ (defun org-insert-item (&optional checkbox) (goto-char (match-end 0)) t))))) +(defun org-mark-list () + "Mark the current list. +If this is a sublist, only mark the sublist." + (interactive) + (let* ((item (org-list-get-item-begin)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (lbeg (org-list-get-list-begin item struct prevs)) + (lend (org-list-get-list-end item struct prevs))) + (push-mark lend nil t) + (goto-char lbeg))) + (defun org-list-repair () "Fix indentation, bullets and checkboxes is the list at point." (interactive) diff --git a/lisp/org-mks.el b/lisp/org-mks.el index 71405de..95223ef 100644 --- a/lisp/org-mks.el +++ b/lisp/org-mks.el @@ -24,7 +24,7 @@ ;;; Commentary: -;; +;; ;;; Code: diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index cc935a3..48253f7 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -37,7 +37,7 @@ (eval-when-compile (require 'cl)) -(declare-function org-pop-to-buffer-same-window +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (defgroup org-mobile nil @@ -68,6 +68,7 @@ (defcustom org-mobile-files '(org-agenda-files) (defcustom org-mobile-files-exclude-regexp "" "A regexp to exclude files from `org-mobile-files'." :group 'org-mobile + :version "24.1" :type 'regexp) (defcustom org-mobile-directory "" @@ -84,6 +85,7 @@ (defcustom org-mobile-use-encryption nil application. Before turning this on, check of MobileOrg does already support it - at the time of this writing it did not yet." :group 'org-mobile + :version "24.1" :type 'boolean) (defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt" @@ -91,6 +93,7 @@ (defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt" This must be local file on your local machine (not on the WebDAV server). You might want to put this file into a directory where only you have access." :group 'org-mobile + :version "24.1" :type 'directory) (defcustom org-mobile-encryption-password "" @@ -111,6 +114,7 @@ (defcustom org-mobile-encryption-password "" this variable empty - Org will then ask for the password once per Emacs session." :group 'org-mobile + :version "24.1" :type '(string :tag "Password")) (defvar org-mobile-encryption-password-session nil) @@ -150,6 +154,7 @@ (defcustom org-mobile-agendas 'all all the custom agendas and the default ones list a list of selection key(s) as string." :group 'org-mobile + :version "24.1" :type '(choice (const :tag "Default Agendas" default) (const :tag "Custom Agendas" custom) @@ -272,7 +277,7 @@ (defun org-mobile-files-alist () (t nil))) org-mobile-files))) (files (delete - nil + nil (mapcar (lambda (f) (unless (and (not (string= org-mobile-files-exclude-regexp "")) (string-match org-mobile-files-exclude-regexp f)) @@ -295,6 +300,8 @@ (defun org-mobile-files-alist () (push (cons file link-name) rtn))) (nreverse rtn))) +(defvar org-agenda-filter) + ;;;###autoload (defun org-mobile-push () "Push the current state of Org affairs to the WebDAV directory. @@ -303,7 +310,7 @@ (defun org-mobile-push () (interactive) (let ((a-buffer (get-buffer org-agenda-buffer-name))) (let ((org-agenda-buffer-name "*SUMO*") - (org-agenda-filter org-agenda-filter) + (org-agenda-tag-filter org-agenda-tag-filter) (org-agenda-redo-command org-agenda-redo-command)) (save-excursion (save-window-excursion @@ -499,7 +506,7 @@ (defun org-mobile-copy-agenda-files () org-mobile-directory)) (save-excursion (setq buf (find-file file)) - (when (and (= (point-min) (point-max))) + (when (and (= (point-min) (point-max))) (insert "\n") (save-buffer) (when org-mobile-use-encryption @@ -1099,4 +1106,3 @@ (defun org-mobile-bodies-same-p (a b) (provide 'org-mobile) ;;; org-mobile.el ends here - diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index 7538dac..7a4dc0d 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -50,6 +50,9 @@ (defgroup org-complete nil :tag "Org" :group 'org) +(defvar org-drawer-regexp) +(defvar org-property-re) + (defun org-thing-at-point () "Examine the thing at point and let the caller know what it is. The return value is a string naming the thing at point." @@ -84,8 +87,16 @@ (defun org-thing-at-point () (equal (char-after (point-at-bol)) ?*)) (cons "tag" nil)) ((and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*))) + (not (equal (char-after (point-at-bol)) ?*)) + (save-excursion + (move-beginning-of-line 1) + (skip-chars-backward "[ \t\n]") + (or (looking-back org-drawer-regexp) + (looking-back org-property-re)))) (cons "prop" nil)) + ((and (equal (char-before beg1) ?:) + (not (equal (char-after (point-at-bol)) ?*))) + (cons "drawer" nil)) (t nil)))) (defun org-command-at-point () @@ -146,7 +157,7 @@ (defun pcomplete/org-mode/file-option () (org-split-string (org-get-current-options) "\n")) org-additional-option-like-keywords))))) (substring pcomplete-stub 2))) - + (defvar org-startup-options) (defun pcomplete/org-mode/file-option/startup () "Complete arguments for the #+STARTUP file option." @@ -239,6 +250,25 @@ (defun pcomplete/org-mode/prop () 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 (delete + 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-publish.el b/lisp/org-publish.el index 057edd7..3590cba 100644 --- a/lisp/org-publish.el +++ b/lisp/org-publish.el @@ -248,6 +248,7 @@ (defcustom org-publish-sitemap-sort-files 'alphabetically You can overwrite this default per project in your `org-publish-project-alist', using `:sitemap-sort-files'." :group 'org-publish + :version "24.1" :type 'symbol) (defcustom org-publish-sitemap-sort-folders 'first @@ -260,6 +261,7 @@ (defcustom org-publish-sitemap-sort-folders 'first You can overwrite this default per project in your `org-publish-project-alist', using `:sitemap-sort-folders'." :group 'org-publish + :version "24.1" :type 'symbol) (defcustom org-publish-sitemap-sort-ignore-case nil @@ -268,12 +270,14 @@ (defcustom org-publish-sitemap-sort-ignore-case nil You can overwrite this default per project in your `org-publish-project-alist', using `:sitemap-ignore-case'." :group 'org-publish + :version "24.1" :type 'boolean) (defcustom org-publish-sitemap-date-format "%Y-%m-%d" "Format for `format-time-string' which is used to print a date in the sitemap." :group 'org-publish + :version "24.1" :type 'string) (defcustom org-publish-sitemap-file-entry-format "%t" @@ -284,6 +288,7 @@ (defcustom org-publish-sitemap-file-entry-format "%t" %a is the author. %d is the date formatted using `org-publish-sitemap-date-format'." :group 'org-publish + :version "24.1" :type 'string) @@ -368,7 +373,7 @@ (defun org-publish-remove-all-timestamps () (declare-function org-publish-delete-dups "org-publish" (list)) (declare-function find-lisp-find-files "find-lisp" (directory regexp)) -(declare-function org-pop-to-buffer-same-window +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1031,7 +1036,7 @@ (defun org-publish-index-generate-theindex (directory) (setq ibuffer (find-file-noselect index-file)) (with-current-buffer ibuffer (erase-buffer) - (insert "\n\n#+include: \"theindex.inc\"\n\n") + (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n") (save-buffer)) (kill-buffer ibuffer))))) @@ -1127,7 +1132,7 @@ (defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-f (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 (filename property value &optional project-name) diff --git a/lisp/org-remember.el b/lisp/org-remember.el index 854562f..65e92ba 100644 --- a/lisp/org-remember.el +++ b/lisp/org-remember.el @@ -39,7 +39,7 @@ (declare-function remember "remember" (&optional initial)) (declare-function remember-buffer-desc "remember" ()) (declare-function remember-finalize "remember" ()) -(declare-function org-pop-to-buffer-same-window +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) (defvar remember-save-after-remembering) @@ -1152,4 +1152,3 @@ (defun org-require-remember () (provide 'org-remember) ;;; org-remember.el ends here - diff --git a/lisp/org-special-blocks.el b/lisp/org-special-blocks.el index fca5dd6..fc882a3 100644 --- a/lisp/org-special-blocks.el +++ b/lisp/org-special-blocks.el @@ -51,7 +51,7 @@ (defvar org-export-current-backend) ; dynamically bound in org-exp.el (defun org-special-blocks-make-special-cookies () "Adds special cookies when #+begin_foo and #+end_foo tokens are seen. This is run after a few special cases are taken care of." - (when (or (eq org-export-current-backend 'html) + (when (or (eq org-export-current-backend 'html) (eq org-export-current-backend 'latex)) (goto-char (point-min)) (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t) diff --git a/lisp/org-src.el b/lisp/org-src.el index 87fb4f0..e975d97 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -41,6 +41,7 @@ (declare-function org-at-table.el-p "org" ()) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-switch-to-buffer-other-window "org" (&rest args)) +(declare-function org-strip-protective-commas "org" (beg end)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) @@ -172,6 +173,7 @@ (defcustom org-src-lang-modes (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-x\C-s" 'org-edit-src-save) (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) @@ -326,6 +328,7 @@ (defun org-edit-src-code (&optional context code edit-buffer-name) (if org-src-preserve-indentation col (max 0 (- col total-nindent)))) (org-src-mode) (set-buffer-modified-p nil) + (setq buffer-file-name nil) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg)) (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) @@ -671,21 +674,33 @@ (defun org-edit-src-exit (&optional context) (set-window-configuration org-edit-src-saved-temp-window-config) (setq org-edit-src-saved-temp-window-config nil)))) +(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)) + (defun org-edit-src-save () "Save parent buffer with current state source-code buffer." (interactive) - (let ((p (point)) (m (mark)) msg) - (save-window-excursion - (org-edit-src-exit 'save) - (save-buffer) - (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))) - (push-mark m 'nomessage) - (goto-char (min p (point-max))) - (message (or msg "")))) + (org-src-in-org-buffer (save-buffer))) + +(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang)) + +(defun org-src-tangle (arg) + "Tangle the parent buffer." + (interactive) + (org-src-in-org-buffer (org-babel-tangle arg))) (defun org-src-mode-configure-edit-buffer () (when (org-bound-and-true-p org-edit-src-from-org-mode) @@ -759,6 +774,7 @@ (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 () diff --git a/lisp/org-table.el b/lisp/org-table.el index d9e9c30..39cddab 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -169,11 +169,13 @@ (defcustom org-table-exit-follow-field-mode-when-leaving-table t except maybe locally in a special file that has mostly tables with long fields." :group 'org-table + :version "24.1" :type 'boolean) (defcustom org-table-fix-formulas-confirm nil "Whether the user should confirm when Org fixes formulas." :group 'org-table-editing + :version "24.1" :type '(choice (const :tag "with yes-or-no" yes-or-no-p) (const :tag "with y-or-n" y-or-n-p) @@ -236,6 +238,7 @@ (defcustom org-table-duration-custom-format 'hours 'days, and the output will be a fraction of seconds, minutes or days." :group 'org-table-calculation + :version "24.1" :type '(choice (symbol :tag "Seconds" 'seconds) (symbol :tag "Minutes" 'minutes) (symbol :tag "Hours " 'hours) @@ -247,6 +250,7 @@ (defcustom org-table-formula-field-format "%s" characters. Beware that modifying the display can prevent the field from being used in another formula." :group 'org-table-settings + :version "24.1" :type 'string) (defcustom org-table-formula-evaluate-inline t @@ -2436,7 +2440,7 @@ (defun org-table-eval-formula (&optional arg equation (modes (copy-sequence org-calc-default-modes)) (numbers nil) ; was a variable, now fixed default (keep-empty nil) - n form form0 formrpl formrg bw fmt x ev orig c lispp literal + n form form0 formrpl formrg bw fmt x ev orig c lispp literal duration duration-output-format) ;; Parse the format string. Since we have a lot of modes, this is ;; a lot of work. However, I think calc still uses most of the time. @@ -2461,7 +2465,7 @@ (defun org-table-eval-formula (&optional arg equation duration-output-format nil fmt (replace-match "" t t fmt))) (if (string-match "t" fmt) - (setq duration t + (setq duration t duration-output-format org-table-duration-custom-format numbers t fmt (replace-match "" t t fmt))) @@ -2529,7 +2533,7 @@ (defun org-table-eval-formula (&optional arg equation ;; Insert complex ranges (while (and (string-match org-table-range-regexp form) (> (length (match-string 0 form)) 1)) - (setq formrg (save-match-data + (setq formrg (save-match-data (org-table-get-range (match-string 0 form) nil n0))) (setq formrpl (save-match-data @@ -4759,4 +4763,3 @@ (defun org-table-get-remote-range (name-or-id form) (provide 'org-table) ;;; org-table.el ends here - diff --git a/lisp/org-taskjuggler.el b/lisp/org-taskjuggler.el index 56b6f05..4409013 100644 --- a/lisp/org-taskjuggler.el +++ b/lisp/org-taskjuggler.el @@ -166,28 +166,33 @@ (defgroup org-export-taskjuggler nil (defcustom org-export-taskjuggler-extension ".tjp" "Extension of TaskJuggler files." :group 'org-export-taskjuggler + :version "24.1" :type 'string) (defcustom org-export-taskjuggler-project-tag "taskjuggler_project" "Tag, property or todo used to find the tree containing all the tasks for the project." :group 'org-export-taskjuggler + :version "24.1" :type 'string) (defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource" "Tag, property or todo used to find the tree containing all the resources for the project." :group 'org-export-taskjuggler + :version "24.1" :type 'string) (defcustom org-export-taskjuggler-target-version 2.4 "Which version of TaskJuggler the exporter is targeting." :group 'org-export-taskjuggler + :version "24.1" :type 'number) (defcustom org-export-taskjuggler-default-project-version "1.0" "Default version string for the project." :group 'org-export-taskjuggler + :version "24.1" :type 'string) (defcustom org-export-taskjuggler-default-project-duration 280 @@ -195,6 +200,7 @@ (defcustom org-export-taskjuggler-default-project-duration 280 in the root node of the task tree, i.e. the tree that has been marked with `org-export-taskjuggler-project-tag'" :group 'org-export-taskjuggler + :version "24.1" :type 'integer) (defcustom org-export-taskjuggler-default-reports @@ -214,6 +220,7 @@ (defcustom org-export-taskjuggler-default-reports }") "Default reports for the project." :group 'org-export-taskjuggler + :version "24.1" :type '(repeat (string :tag "Report"))) (defcustom org-export-taskjuggler-default-global-properties @@ -230,6 +237,7 @@ (defcustom org-export-taskjuggler-default-global-properties The global properties are inserted after the project declaration but before any resource and task declarations." :group 'org-export-taskjuggler + :version "24.1" :type '(string :tag "Preamble")) ;;; Hooks @@ -355,8 +363,8 @@ (defun org-taskjuggler-components () (let* ((props (org-entry-properties)) (components (org-heading-components)) (level (nth 1 components)) - (headline - (replace-regexp-in-string + (headline + (replace-regexp-in-string "\"" "\\\"" (nth 4 components) t t)) ; quote double quotes in headlines (parent-ordered (org-taskjuggler-parent-is-ordered-p))) (push (cons "level" level) props) @@ -406,10 +414,10 @@ (defun org-taskjuggler-compute-task-leafiness (tasks) (successor (car (cdr tasks)))) (cond ;; if a task has no successors it is a leaf - ((null successor) + ((null successor) (push (cons (cons "leaf-node" t) task) new-list)) ;; if the successor has a lower level than task it is a leaf - ((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task))) + ((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task))) (push (cons (cons "leaf-node" t) task) new-list)) ;; otherwise examine the rest of the tasks (t (push task new-list)))) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 44a53ad..a3bde0f 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -53,6 +53,7 @@ (defcustom org-timer-default-timer 0 "The default timer when a timer is set. When 0, the user is prompted for a value." :group 'org-time + :version "24.1" :type 'number) (defvar org-timer-start-hook nil diff --git a/lisp/org-vm.el b/lisp/org-vm.el index b6975ff..1698749 100644 --- a/lisp/org-vm.el +++ b/lisp/org-vm.el @@ -6,6 +6,10 @@ ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org ;; +;; Support for IMAP folders added +;; by Konrad Hinsen +;; Requires VM 8.2.0a or later. +;; ;; This file is part of GNU Emacs. ;; ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -42,11 +46,17 @@ (declare-function vm-su-message-id "ext:vm-summary" (m)) (declare-function vm-su-subject "ext:vm-summary" (m)) (declare-function vm-summarize "ext:vm-summary" (&optional display raise)) +(declare-function vm-imap-folder-p "ext:vm-save" ()) +(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer)) +(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec)) +(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec)) +(declare-function vm-imap-spec-for-account "ext:vm-imap" (account)) (defvar vm-message-pointer) (defvar vm-folder-directory) ;; Install the link type (org-add-link-type "vm" 'org-vm-open) +(org-add-link-type "vm-imap" 'org-vm-imap-open) (add-hook 'org-store-link-functions 'org-vm-store-link) ;; Implementation @@ -61,11 +71,11 @@ (defun org-vm-store-link () (save-excursion (vm-select-folder-buffer) (let* ((message (car vm-message-pointer)) - (folder buffer-file-name) - (subject (vm-su-subject message)) + (subject (vm-su-subject message)) (to (vm-get-header-contents message "To")) (from (vm-get-header-contents message "From")) - (message-id (vm-su-message-id message)) + (message-id (vm-su-message-id message)) + (link-type (if (vm-imap-folder-p) "vm-imap" "vm")) (date (vm-get-header-contents message "Date")) (date-ts (and date (format-time-string (org-time-stamp-format t) @@ -73,20 +83,24 @@ (defun org-vm-store-link () (date-ts-ia (and date (format-time-string (org-time-stamp-format t t) (date-to-time date)))) - desc link) - (org-store-link-props :type "vm" :from from :to to :subject subject + folder desc link) + (if (vm-imap-folder-p) + (let ((spec (vm-imap-find-spec-for-buffer (current-buffer)))) + (setq folder (vm-imap-folder-for-spec spec))) + (progn + (setq folder (abbreviate-file-name buffer-file-name)) + (if (and vm-folder-directory + (string-match (concat "^" (regexp-quote vm-folder-directory)) + folder)) + (setq folder (replace-match "" t t folder))))) + (setq message-id (org-remove-angle-brackets message-id)) + (org-store-link-props :type link-type :from from :to to :subject subject :message-id message-id) (when date (org-add-link-props :date date :date-timestamp date-ts :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) - (setq folder (abbreviate-file-name folder)) - (if (and vm-folder-directory - (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder)) - (setq folder (replace-match "" t t folder))) (setq desc (org-email-link-description)) - (setq link (org-make-link "vm:" folder "#" message-id)) + (setq link (org-make-link (concat link-type ":") folder "#" message-id)) (org-add-link-props :link link :description desc) link)))) @@ -121,21 +135,46 @@ (defun org-vm-follow-link (&optional folder article readonly) (setq folder (format "/%s@%s:%s" user host file)))))) (when folder (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) - (sit-for 0.1) (when article - (require 'vm-search) - (vm-select-folder-buffer) - (widen) - (let ((case-fold-search t)) - (goto-char (point-min)) - (if (not (re-search-forward - (concat "^" "message-id: *" (regexp-quote article)))) - (error "Could not find the specified message in this folder")) - (vm-isearch-update) - (vm-isearch-narrow) - (vm-preview-current-message) - (vm-summarize))))) + (org-vm-select-message (org-add-angle-brackets article))))) + +(defun org-vm-imap-open (path) + "Follow a VM link to an IMAP folder" + (require 'vm-imap) + (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path) + (let* ((account-name (match-string 1 path)) + (mailbox-name (match-string 2 path)) + (message-id (match-string 3 path)) + (account-spec (vm-imap-parse-spec-to-list + (vm-imap-spec-for-account account-name))) + (mailbox-spec (mapconcat 'identity + (append (butlast account-spec 4) + (cons mailbox-name + (last account-spec 3))) + ":"))) + (funcall (cdr (assq 'vm-imap org-link-frame-setup)) + mailbox-spec) + (when message-id + (org-vm-select-message (org-add-angle-brackets message-id)))))) + +(defun org-vm-select-message (message-id) + "Go to the message with message-id in the current folder." + (require 'vm-search) + (sit-for 0.1) + (vm-select-folder-buffer) + (widen) + (let ((case-fold-search t)) + (goto-char (point-min)) + (if (not (re-search-forward + (concat "^" "message-id: *" (regexp-quote message-id)))) + (error "Could not find the specified message in this folder")) + (vm-isearch-update) + (vm-isearch-narrow) + (vm-preview-current-message) + (vm-summarize))) (provide 'org-vm) + + ;;; org-vm.el ends here diff --git a/lisp/org-wl.el b/lisp/org-wl.el index 6d23706..8a79ec0 100644 --- a/lisp/org-wl.el +++ b/lisp/org-wl.el @@ -46,11 +46,13 @@ (defcustom org-wl-link-to-refile-destination t (defcustom org-wl-link-remove-filter nil "Remove filter condition if message is filter folder." :group 'org-wl + :version "24.1" :type 'boolean) (defcustom org-wl-shimbun-prefer-web-links nil "If non-nil create web links for shimbun messages." :group 'org-wl + :version "24.1" :type 'boolean) (defcustom org-wl-nntp-prefer-web-links nil @@ -58,16 +60,19 @@ (defcustom org-wl-nntp-prefer-web-links nil When folder name contains string \"gmane\" link to gmane, googlegroups otherwise." :type 'boolean + :version "24.1" :group 'org-wl) (defcustom org-wl-disable-folder-check t "Disable check for new messages when open a link." :type 'boolean + :version "24.1" :group 'org-wl) (defcustom org-wl-namazu-default-index nil "Default namazu search index." :type 'directory + :version "24.1" :group 'org-wl) ;; Declare external functions and variables diff --git a/lisp/org.el b/lisp/org.el index 04c5c62..c22c39d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1,4 +1,5 @@ ;;; org.el --- Outline-based notes management and organizer + ;; Carstens outline-mode for keeping track of everything. ;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; @@ -75,6 +76,7 @@ (defvar org-table-formula-constants-local nil (require 'gnus-sum)) (require 'calendar) +(require 'format-spec) ;; Emacs 22 calendar compatibility: Make sure the new variables are available (when (fboundp 'defvaralias) @@ -151,6 +153,7 @@ (defcustom org-babel-load-languages '((emacs-lisp . t)) requirements) is loaded." :group 'org-babel :set 'org-babel-do-load-languages + :version "24.1" :type '(alist :tag "Babel Languages" :key-type (choice @@ -167,9 +170,10 @@ (defcustom org-babel-load-languages '((emacs-lisp . t)) (const :tag "Fortran" fortran) (const :tag "Gnuplot" gnuplot) (const :tag "Haskell" haskell) + (const :tag "IO" io) (const :tag "Java" java) (const :tag "Javascript" js) - (const :tag "Latex" latex) + (const :tag "LaTeX" latex) (const :tag "Ledger" ledger) (const :tag "Lilypond" lilypond) (const :tag "Maxima" maxima) @@ -184,6 +188,7 @@ (defcustom org-babel-load-languages '((emacs-lisp . t)) (const :tag "Python" python) (const :tag "Ruby" ruby) (const :tag "Sass" sass) + (const :tag "Scala" scala) (const :tag "Scheme" scheme) (const :tag "Screen" screen) (const :tag "Shell Script" sh) @@ -199,6 +204,7 @@ (defcustom org-clone-delete-id nil Otherwise they inherit the ID property with a new unique identifier." :type 'boolean + :version "24.1" :group 'org-id) ;;; Version @@ -258,6 +264,7 @@ (defcustom org-load-hook nil (defcustom org-log-buffer-setup-hook nil "Hook that is run after an Org log buffer is created." :group 'org + :version "24.1" :type 'hook) (defvar org-modules) ; defined below @@ -427,6 +434,7 @@ (defcustom org-loop-over-headlines-in-active-region nil (const :tag "All headlines in active region" t) (const :tag "In active region, headlines at the same level than the first one" 'start-level) (string :tag "Tags/Property/Todo matcher")) + :version "24.1" :group 'org-todo :group 'org-archive) @@ -495,6 +503,7 @@ (defcustom org-use-sub-superscripts t This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." :group 'org-startup :group 'org-export-translation + :version "24.1" :type '(choice (const :tag "Always interpret" t) (const :tag "Only with braces" {}) @@ -511,6 +520,7 @@ (defcustom org-startup-with-beamer-mode nil #+STARTUP: beamer" :group 'org-startup + :version "24.1" :type 'boolean) (defcustom org-startup-align-all-tables nil @@ -531,6 +541,7 @@ (defcustom org-startup-with-inline-images nil #+STARTUP: inlineimages #+STARTUP: noinlineimages" :group 'org-startup + :version "24.1" :type 'boolean) (defcustom org-insert-mode-line-in-empty-file nil @@ -1015,23 +1026,25 @@ (defcustom org-special-ctrl-a/e nil "Non-nil means `C-a' and `C-e' behave specially in headlines and items. When t, `C-a' will bring back the cursor to the beginning of the -headline text, i.e. after the stars and after a possible TODO keyword. -In an item, this will be the position after the bullet. -When the cursor is already at that position, another `C-a' will bring -it to the beginning of the line. - -`C-e' will jump to the end of the headline, ignoring the presence of tags -in the headline. A second `C-e' will then jump to the true end of the -line, after any tags. This also means that, when this variable is -non-nil, `C-e' also will never jump beyond the end of the heading of a -folded section, i.e. not after the ellipses. - -When set to the symbol `reversed', the first `C-a' or `C-e' works normally, -going to the true line boundary first. Only a directly following, identical -keypress will bring the cursor to the special positions. - -This may also be a cons cell where the behavior for `C-a' and `C-e' is -set separately." +headline text, i.e. after the stars and after a possible TODO +keyword. In an item, this will be the position after bullet and +check-box, if any. When the cursor is already at that position, +another `C-a' will bring it to the beginning of the line. + +`C-e' will jump to the end of the headline, ignoring the presence +of tags in the headline. A second `C-e' will then jump to the +true end of the line, after any tags. This also means that, when +this variable is non-nil, `C-e' also will never jump beyond the +end of the heading of a folded section, i.e. not after the +ellipses. + +When set to the symbol `reversed', the first `C-a' or `C-e' works +normally, going to the true line boundary first. Only a directly +following, identical keypress will bring the cursor to the +special positions. + +This may also be a cons cell where the behavior for `C-a' and +`C-e' is set separately." :group 'org-edit-structure :type '(choice (const :tag "off" nil) @@ -1068,6 +1081,7 @@ (defcustom org-ctrl-k-protect-subtree nil Any other non-nil value will result in a query to the user, if it is OK to kill that hidden subtree. When nil, kill without remorse." :group 'org-edit-structure + :version "24.1" :type '(choice (const :tag "Do not protect hidden subtrees" nil) (const :tag "Protect hidden subtrees with a security query" t) @@ -1088,6 +1102,7 @@ (defcustom org-catch-invisible-edits nil allows insertion and backward-delete right before ellipses. FIXME: maybe in this case we should not even show?" :group 'org-edit-structure + :version "24.1" :type '(choice (const :tag "Do not check" nil) (const :tag "Throw error when trying to edit" error) @@ -1541,6 +1556,7 @@ (defcustom org-link-search-must-match-exact-headline 'query-to-create When nil, the link search tries to match a phrase with all words in the search text." :group 'org-link-follow + :version "24.1" :type '(choice (const :tag "Use fuzzy text search" nil) (const :tag "Match only exact headline" t) @@ -1549,6 +1565,7 @@ (defcustom org-link-search-must-match-exact-headline 'query-to-create (defcustom org-link-frame-setup '((vm . vm-visit-folder-other-frame) + (vm-imap . vm-visit-imap-folder-other-frame) (gnus . org-gnus-no-new-news) (file . find-file-other-window) (wl . wl-other-frame)) @@ -1660,6 +1677,7 @@ (defcustom org-confirm-shell-link-function 'yes-or-no-p (defcustom org-confirm-shell-link-not-regexp "" "A regexp to skip confirmation for shell links." :group 'org-link-follow + :version "24.1" :type 'regexp) (defcustom org-confirm-elisp-link-function 'yes-or-no-p @@ -1685,6 +1703,7 @@ (defcustom org-confirm-elisp-link-function 'yes-or-no-p (defcustom org-confirm-elisp-link-not-regexp "" "A regexp to skip confirmation for Elisp links." :group 'org-link-follow + :version "24.1" :type 'regexp) (defconst org-file-apps-defaults-gnu @@ -1907,6 +1926,7 @@ (defcustom org-log-refile nil will temporarily be changed to `time'." :group 'org-refile :group 'org-progress + :version "24.1" :type '(choice (const :tag "No logging" nil) (const :tag "Record timestamp" time) @@ -1982,6 +2002,7 @@ (defcustom org-refile-use-cache nil you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you find that easier, `C-u C-u C-u C-c C-w'." :group 'org-refile + :version "24.1" :type 'boolean) (defcustom org-refile-use-outline-path nil @@ -2037,6 +2058,7 @@ (defcustom org-refile-active-region-within-subtree nil do so sometimes: in that case, the first line of the region is converted to a headline before refiling." :group 'org-refile + :version "24.1" :type 'boolean) (defgroup org-todo nil @@ -2513,6 +2535,7 @@ (defcustom org-todo-repeat-to-state nil in a TODO_TYP set. But you can specify another task here. alternatively, set the :REPEAT_TO_STATE: property of the entry." :group 'org-todo + :version "24.1" :type '(choice (const :tag "Head of sequence" nil) (string :tag "Specific state"))) @@ -2597,6 +2620,7 @@ (defcustom org-get-priority-function nil The user can set a different function here, which should take a string as an argument and return the numeric priority." :group 'org-priorities + :version "24.1" :type 'function) (defgroup org-time nil @@ -2738,6 +2762,7 @@ (defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future This may t or nil, or the symbol `org-read-date-prefer-future'." :group 'org-agenda :group 'org-time + :version "24.1" :type '(choice (const :tag "Use org-read-date-prefer-future" org-read-date-prefer-future) @@ -2772,6 +2797,7 @@ (defcustom org-read-date-force-compatible-dates t A workaround for this problem is to use diary sexp dates for time stamps outside of this range." :group 'org-time + :version "24.1" :type 'boolean) (defcustom org-read-date-display-live t @@ -2819,6 +2845,7 @@ (defcustom org-use-effective-time nil \"effective time\" of any timestamps between midnight and 8am will be 23:59 of the previous day." :group 'boolean + :version "24.1" :type 'integer) (defcustom org-edit-timestamp-down-means-later nil @@ -2892,6 +2919,7 @@ (defcustom org-complete-tags-always-offer-all-agenda-tags nil 'org-complete-tags-always-offer-all-agenda-tags) t)))" :group 'org-tags + :version "24.1" :type 'boolean) (defvar org-file-tags nil @@ -3060,6 +3088,7 @@ (defcustom org-properties-postprocess-alist nil (org-entry-get (point) \"Effort\")))) (org-minutes-to-hh:mm-string (- effort clocksum))))))" :group 'org-properties + :version "24.1" :type 'alist) (defcustom org-use-property-inheritance nil @@ -3331,7 +3360,9 @@ (defcustom org-format-latex-signal-error t "Non-nil means signal an error when image creation of LaTeX snippets fails. When nil, just push out a message." :group 'org-latex + :version "24.1" :type 'boolean) + (defcustom org-latex-to-mathml-jar-file nil "Value of\"%j\" in `org-latex-to-mathml-convert-command'. Use this to specify additional executable file say a jar file. @@ -3339,6 +3370,7 @@ (defcustom org-latex-to-mathml-jar-file nil When using MathToWeb as the converter, specify the full-path to your mathtoweb.jar file." :group 'org-latex + :version "24.1" :type '(choice (const :tag "None" nil) (file :tag "JAR file" :must-match t))) @@ -3356,6 +3388,7 @@ (defcustom org-latex-to-mathml-convert-command nil When using MathToWeb as the converter, set this to \"java -jar %j -unicode -force -df %o %I\"." :group 'org-latex + :version "24.1" :type '(choice (const :tag "None" nil) (string :tag "\nShell command"))) @@ -3465,6 +3498,7 @@ (defcustom org-export-latex-default-packages-alist :group 'org-export-latex :set 'org-set-packages-alist :get 'org-get-packages-alist + :version "24.1" :type '(repeat (choice (list :tag "options/package pair" @@ -3530,6 +3564,7 @@ (defcustom org-hidden-keywords nil For example, a value '(title) for this list will make the document's title appear in the buffer without the initial #+TITLE: keyword." :group 'org-appearance + :version "24.1" :type '(set (const :tag "#+AUTHOR" author) (const :tag "#+DATE" date) (const :tag "#+EMAIL" email) @@ -3570,11 +3605,13 @@ (defcustom org-pretty-entities nil "Non-nil means show entities as UTF8 characters. When nil, the \\name form remains in the buffer." :group 'org-appearance + :version "24.1" :type 'boolean) (defcustom org-pretty-entities-include-sub-superscripts t "Non-nil means, pretty entity display includes formatting sub/superscripts." :group 'org-appearance + :version "24.1" :type 'boolean) (defvar org-emph-re nil @@ -4544,7 +4581,7 @@ (defun org-set-regexps-and-options () (mapcar (lambda (x) (org-split-string x ":")) (org-split-string value))))))) ((equal key "DRAWERS") - (setq drawers (org-split-string value splitre))) + (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) ((equal key "CONSTANTS") (setq const (append const (org-split-string value splitre)))) ((equal key "STARTUP") @@ -4894,6 +4931,8 @@ (defconst org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" "Matches an headline, putting stars and text into groups. Stars are put in group 1 and the trimmed body in group 2.") +(defvar bidi-paragraph-direction) + ;;;###autoload (define-derived-mode org-mode outline-mode "Org" "Outline-based notes management and organizer, alias @@ -5355,6 +5394,7 @@ (defun org-activate-code (limit) (defcustom org-src-fontify-natively nil "When non-nil, fontify code in code blocks." :type 'boolean + :version "24.1" :group 'org-appearance :group 'org-babel) @@ -6223,34 +6263,36 @@ (defun org-cycle (&optional arg) (defun org-cycle-internal-global () "Do the global cycling action." - (cond - ((and (eq last-command this-command) - (eq org-cycle-global-status 'overview)) - ;; We just created the overview - now do table of contents - ;; This can be slow in very large buffers, so indicate action - (run-hook-with-args 'org-pre-cycle-hook 'contents) - (message "CONTENTS...") - (org-content) - (message "CONTENTS...done") - (setq org-cycle-global-status 'contents) - (run-hook-with-args 'org-cycle-hook 'contents)) - - ((and (eq last-command this-command) - (eq org-cycle-global-status 'contents)) - ;; We just showed the table of contents - now show everything - (run-hook-with-args 'org-pre-cycle-hook 'all) - (show-all) - (message "SHOW ALL") - (setq org-cycle-global-status 'all) - (run-hook-with-args 'org-cycle-hook 'all)) + ;; Hack to avoid display of messages for .org attachments in Gnus + (let ((ga (string-match "\\*fontification" (buffer-name)))) + (cond + ((and (eq last-command this-command) + (eq org-cycle-global-status 'overview)) + ;; We just created the overview - now do table of contents + ;; This can be slow in very large buffers, so indicate action + (run-hook-with-args 'org-pre-cycle-hook 'contents) + (unless ga (message "CONTENTS...")) + (org-content) + (unless ga (message "CONTENTS...done")) + (setq org-cycle-global-status 'contents) + (run-hook-with-args 'org-cycle-hook 'contents)) + + ((and (eq last-command this-command) + (eq org-cycle-global-status 'contents)) + ;; We just showed the table of contents - now show everything + (run-hook-with-args 'org-pre-cycle-hook 'all) + (show-all) + (unless ga (message "SHOW ALL")) + (setq org-cycle-global-status 'all) + (run-hook-with-args 'org-cycle-hook 'all)) - (t - ;; Default action: go to overview - (run-hook-with-args 'org-pre-cycle-hook 'overview) - (org-overview) - (message "OVERVIEW") - (setq org-cycle-global-status 'overview) - (run-hook-with-args 'org-cycle-hook 'overview)))) + (t + ;; Default action: go to overview + (run-hook-with-args 'org-pre-cycle-hook 'overview) + (org-overview) + (unless ga (message "OVERVIEW")) + (setq org-cycle-global-status 'overview) + (run-hook-with-args 'org-cycle-hook 'overview))))) (defun org-cycle-internal-local () "Do the local cycling action." @@ -9861,6 +9903,22 @@ (defun org-link-search (s &optional type avoid-pos stealth) 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]*#\\+TARGET: %s" (regexp-quote s0)) nil t) + (setq type 'dedicated pos (match-beginning 0)))) + ;; Found an invisible target. + (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)) @@ -11042,11 +11100,11 @@ (defconst org-additional-option-like-keywords (defcustom org-structure-template-alist '( - ("s" "#+begin_src ?\n\n#+end_src" + ("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "\n\n") - ("e" "#+begin_example\n?\n#+end_example" + ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "\n?\n") - ("q" "#+begin_quote\n?\n#+end_quote" + ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "\n?\n") ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "\n?\n") @@ -11054,17 +11112,17 @@ (defcustom org-structure-template-alist "
\n?\n
") ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" "\n?\n") - ("L" "#+latex: " + ("L" "#+LaTeX: " "?") - ("h" "#+begin_html\n?\n#+end_html" + ("h" "#+BEGIN_HTML\n?\n#+END_HTML" "\n?\n") - ("H" "#+html: " + ("H" "#+HTML: " "?") - ("a" "#+begin_ascii\n?\n#+end_ascii") - ("A" "#+ascii: ") - ("i" "#+index: ?" - "#+index: ?") - ("I" "#+include %file ?" + ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII") + ("A" "#+ASCII: ") + ("i" "#+INDEX: ?" + "#+INDEX: ?") + ("I" "#+INCLUDE %file ?" "") ) "Structure completion elements. @@ -11076,8 +11134,7 @@ (defcustom org-structure-template-alist 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 -variable `org-mtags-prefer-muse-templates'. -This is an experimental feature, it is undecided if it is going to stay in." +variable `org-mtags-prefer-muse-templates'." :group 'org-completion :type '(repeat (string :tag "Key") @@ -12852,7 +12909,8 @@ (defun org-scan-tags (action matcher &optional todo-only start-level) ;; eval matcher only when the todo condition is OK (and (or (not todo-only) (member todo org-not-done-keywords)) - (let ((case-fold-search t)) (eval matcher))) + (let ((case-fold-search t) (org-trust-scanner-tags t)) + (eval matcher))) ;; Call the skipper, but return t if it does not skip, ;; so that the `and' form continues evaluating @@ -12891,8 +12949,7 @@ (defun org-scan-tags (action matcher &optional todo-only start-level) (make-string (1- level) ?.) "") (org-get-heading)) category - tags-list - ) + tags-list) priority (org-get-priority txt)) (goto-char lspos) (setq marker (org-agenda-new-marker)) @@ -13292,7 +13349,7 @@ (defun org-align-tags-here (to-col) (defun org-set-tags-command (&optional arg just-align) "Call the set-tags command for the current entry." (interactive "P") - (if (org-at-heading-p) + (if (or (org-at-heading-p) (and arg (org-before-first-heading-p))) (org-set-tags arg just-align) (save-excursion (org-back-to-heading t) @@ -13346,7 +13403,7 @@ (defun org-set-tags (&optional arg just-align) With prefix ARG, realign all tags in headings in the current buffer." (interactive "P") (let* ((re org-outline-regexp-bol) - (current (org-get-tags-string)) + (current (unless arg (org-get-tags-string))) (col (current-column)) (org-setting-tags t) table current-tags inherited-tags ; computed below when needed @@ -14418,11 +14475,10 @@ (defun org-property-values (key) (defun org-insert-property-drawer () "Insert a property drawer into the current entry." - (interactive) (org-back-to-heading t) (looking-at org-outline-regexp) (let ((indent (if org-adapt-indentation - (- (match-end 0)(match-beginning 0)) + (- (match-end 0) (match-beginning 0)) 0)) (beg (point)) (re (concat "^[ \t]*" org-keyword-time-regexp)) @@ -14456,6 +14512,70 @@ (defun org-insert-property-drawer () (hide-entry)) (org-flag-drawer t)))) +(defun org-insert-drawer (&optional arg drawer) + "Insert a drawer at point. + +Optional argument DRAWER, when non-nil, is a string representing +drawer's name. Otherwise, the user is prompted for a name. + +If a region is active, insert the drawer around that region +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)))))))) + (cond + ;; With C-u, fall back on `org-insert-property-drawer' + (arg (org-insert-property-drawer)) + ;; With an active region, insert a drawer at point. + ((not (org-region-active-p)) + (progn + (unless (bolp) (insert "\n")) + (insert (format ":%s:\n\n:END:\n" drawer)) + (forward-line -2))) + ;; Otherwise, insert the drawer at point + (t + (let ((rbeg (region-beginning)) + (rend (copy-marker (region-end)))) + (unwind-protect + (progn + (goto-char rbeg) + (beginning-of-line) + (when (save-excursion + (re-search-forward org-outline-regexp-bol rend t)) + (error "Drawers cannot contain headlines")) + ;; Position point at the beginning of the first + ;; non-blank line in region. Insert drawer's opening + ;; there, then indent it. + (org-skip-whitespace) + (beginning-of-line) + (insert ":" drawer ":\n") + (forward-line -1) + (indent-for-tab-command) + ;; Move point to the beginning of the first blank line + ;; after the last non-blank line in region. Insert + ;; drawer's closing, then indent it. + (goto-char rend) + (skip-chars-backward " \r\t\n") + (insert "\n:END:") + (indent-for-tab-command) + (unless (eolp) (insert "\n"))) + ;; Clear marker, whatever the outcome of insertion is. + (set-marker rend nil))))))) + (defvar org-property-set-functions-alist nil "Property set function alist. Each entry should have the following format: @@ -14804,11 +14924,11 @@ (defun org-time-stamp (arg &optional inactive) (insert "--") (setq time (let ((this-command this-command)) (org-read-date arg 'totime nil nil - default-time default-input))) + 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))) + (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 "") @@ -14823,7 +14943,7 @@ (defun org-time-stamp (arg &optional inactive) (message "Timestamp updated")) (t (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input))) + (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)))))) @@ -14869,9 +14989,10 @@ (defvar org-read-date-history nil) (defvar org-read-date-final-answer nil) (defvar org-read-date-analyze-futurep nil) (defvar org-read-date-analyze-forced-year nil) +(defvar org-read-date-inactive) (defun org-read-date (&optional with-time to-time from-string prompt - default-time default-input) + default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything which will at least partially be understood by `parse-time-string'. @@ -15020,6 +15141,7 @@ (defun org-read-date (&optional with-time to-time from-string prompt (unwind-protect (progn (use-local-map map) + (setq org-read-date-inactive inactive) (add-hook 'post-command-hook 'org-read-date-display) (setq org-ans0 (read-string prompt default-input 'org-read-date-history nil)) @@ -15090,7 +15212,9 @@ (defun org-read-date-display () (and (boundp 'org-time-was-given) org-time-was-given)) (cdr fmts) (car fmts))) - (txt (concat "=> " (format-time-string fmt (apply 'encode-time f))))) + (txt (format-time-string fmt (apply 'encode-time f))) + (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt)) + (txt (concat "=> " txt))) (when (and org-end-time-was-given (string-match org-plain-time-of-day-regexp txt)) (setq txt (concat (substring txt 0 (match-end 0)) "-" @@ -16176,6 +16300,7 @@ (defcustom org-effort-durations 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" :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) @@ -16886,6 +17011,8 @@ (defun org-format-latex (prefix &optional dir overlays msg at (error "Unknown conversion type %s for latex fragments" processing-type))))))))) +(declare-function format-spec "format-spec" (format specification)) + (defun org-create-math-formula (latex-frag &optional mathml-file) "Convert LATEX-FRAG to MathML and store it in MATHML-FILE. Use `org-latex-to-mathml-convert-command'. If the conversion is @@ -17328,6 +17455,7 @@ (defun org-remove-inline-images () (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-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) (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) @@ -17392,6 +17520,7 @@ (defun org-remove-inline-images () (org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) (org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) (org-defkey org-mode-map "\C-c@" 'org-mark-subtree) +(org-defkey org-mode-map "\C-c\C-@" 'org-mark-list) (org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) ;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) @@ -17563,6 +17692,7 @@ (defcustom org-speed-command-hook Set `org-use-speed-commands' to non-nil value to enable this hook. The default setting is `org-speed-command-default-hook'." :group 'org-structure + :version "24.1" :type 'hook) (defun org-self-insert-command (N) @@ -17996,14 +18126,16 @@ (defun org-metaleft (&optional arg) (t (call-interactively 'backward-word)))) (defun org-metaright (&optional arg) - "Demote subtree or move table column to right. -Calls `org-do-demote' or `org-table-move-column', depending on context. + "Demote a subtree, a list item or move table column to right. +In front of a drawer or a block keyword, indent it correctly. With no specific context, calls the Emacs default `forward-word'. See the individual commands for more information." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metaright-hook)) ((org-at-table-p) (call-interactively 'org-table-move-column)) + ((org-at-drawer-p) (call-interactively 'org-indent-drawer)) + ((org-at-block-p) (call-interactively 'org-indent-block)) ((org-with-limited-levels (or (org-at-heading-p) (and (org-region-active-p) @@ -18526,7 +18658,8 @@ (defun org-return (&optional indent) See the individual commands for more information." (interactive) (cond - ((bobp) (if indent (newline-and-indent) (newline))) + ((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)) @@ -18821,6 +18954,8 @@ (defun org-meta-return (&optional arg) (interactive "P") (cond ((run-hook-with-args-until-success 'org-metareturn-hook)) + ((or (org-at-drawer-p) (org-at-property-p)) + (newline-and-indent)) ((org-at-table-p) (call-interactively 'org-table-wrap-region)) (t (call-interactively 'org-insert-heading)))) @@ -19547,6 +19682,14 @@ (defun org-uuidgen-p (s) "Is S an ID created by UUIDGEN?" (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) +(defun org-in-src-block-p nil + "Whether point is in a code source block." + (let (ov) + (when (setq ov (overlays-at (point))) + (memq 'org-block-background + (overlay-properties + (car ov)))))) + (defun org-context () "Return a list of contexts of the current cursor position. If several contexts apply, all are returned. @@ -19565,8 +19708,10 @@ (defun org-context () :table in an org-mode table :table-special on a special filed in a table :table-table in a table.el table +: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, QUOTE. :target on a <> :radio-target on a <<>> :latex-fragment on a LaTeX fragment @@ -19577,6 +19722,7 @@ (defun org-context () and :keyword." (let* ((f (get-text-property (point) 'face)) (faces (if (listp f) f (list f))) + (case-fold-search t) (p (point)) clist o) ;; First the large context (cond @@ -19611,6 +19757,23 @@ (defun org-context () (push (list :table-table) clist))) (goto-char p) + ;; 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) + (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 (search-forward "#+END_SRC" nil t) + (match-beginning 0))) clist))) + (goto-char p) + ;; Now the small context (cond ((org-at-timestamp-p) @@ -20147,6 +20310,47 @@ (defun org-indent-line-function () t t)) (org-move-to-column column))) +(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))) + (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))) + (message "Block at point indented")) + (defvar org-adaptive-fill-regexp-backup adaptive-fill-regexp "Variable to store copy of `adaptive-fill-regexp'. Since `adaptive-fill-regexp' is set to never match, we need to @@ -20191,10 +20395,11 @@ (defun org-set-autofill-regexps () (org-set-local 'fill-paragraph-function 'org-fill-paragraph) ;; Prevent auto-fill from inserting unwanted new items. (if (boundp 'fill-nobreak-predicate) - (org-set-local 'fill-nobreak-predicate - (if (memq 'org-fill-item-nobreak-p fill-nobreak-predicate) - fill-nobreak-predicate - (cons 'org-fill-item-nobreak-p fill-nobreak-predicate)))) + (org-set-local + 'fill-nobreak-predicate + (org-uniquify + (append fill-nobreak-predicate + '(org-fill-item-nobreak-p org-fill-line-break-nobreak-p))))) ;; Adaptive filling: To get full control, first make sure that ;; `adaptive-fill-regexp' never matches. Then install our own matcher. (unless (local-variable-p 'adaptive-fill-regexp (current-buffer)) @@ -20214,6 +20419,13 @@ (defun org-fill-item-nobreak-p () "Non-nil when a line break at point would insert a new item." (and (looking-at (org-item-re)) (org-list-in-valid-context-p))) +(defun org-fill-line-break-nobreak-p () + "Non-nil when a line break at point would create an Org line break." + (save-excursion + (skip-chars-backward "[ \t]") + (skip-chars-backward "\\\\") + (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)"))) + (defun org-fill-paragraph (&optional justify) "Re-align a table, pass through to fill-paragraph if no table." (let ((table-p (org-at-table-p)) @@ -20551,7 +20763,8 @@ (defun org-kill-line (&optional arg) (if (or (eq org-ctrl-k-protect-subtree 'error) (not (y-or-n-p "Kill hidden subtree along with headline? "))) (error "C-k aborted - would kill hidden subtree"))) - (call-interactively 'kill-line)) + (call-interactively + (if visual-line-mode 'kill-visual-line 'kill-line))) ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) (kill-region (point) (match-beginning 1)) (org-set-tags nil t)) @@ -20706,11 +20919,17 @@ (defun org-at-heading-p (&optional ignored) (defalias 'org-on-heading-p 'org-at-heading-p) (defun org-at-drawer-p nil - "Whether point is at a drawer." + "Is cursor at a drawer keyword?" (save-excursion (move-beginning-of-line 1) (looking-at org-drawer-regexp))) +(defun org-at-block-p nil + "Is cursor at a block keyword?" + (save-excursion + (move-beginning-of-line 1) + (looking-at org-block-regexp))) + (defun org-point-at-end-of-empty-headline () "If point is at the end of an empty headline, return t, else nil. If the heading only contains a TODO keyword, it is still still considered diff --git a/testing/examples/babel.org b/testing/examples/babel.org index c551828..4d89707 100644 --- a/testing/examples/babel.org +++ b/testing/examples/babel.org @@ -7,40 +7,70 @@ :END: #+name: noweb-example -#+begin_src emacs-lisp - (message "expanded") +#+begin_src emacs-lisp :results silent :exports code + (message "expanded1") #+end_src -#+begin_src emacs-lisp :noweb yes - ;; noweb-yes-start - <> - ;; noweb-yes-end +#+name: noweb-example2 +#+begin_src emacs-lisp :results silent + (message "expanded2") #+end_src -#+begin_src emacs-lisp :noweb no - ;; noweb-no-start +#+begin_src emacs-lisp :noweb yes :results silent +;; noweb-1-yes-start <> - ;; noweb-no-end #+end_src -#+begin_src emacs-lisp :noweb tangle +#+begin_src emacs-lisp :noweb no :results silent +;; noweb-no-start + <> +#+end_src + +#+begin_src emacs-lisp :noweb yes :results silent +;; noweb-2-yes-start + <> +#+end_src + +#+begin_src emacs-lisp :noweb tangle :results silent ;; noweb-tangle-start - <> - ;; noweb-tangle-end + <> + <> #+end_src -* elisp forms in header arguments +* =:noweb= header argument expansion using :exports results :PROPERTIES: - :ID: 22d67284-bf14-4cdc-8319-f4bd876829d7 - :var: prop=(+ 2 2) + :ID: 8701beb4-13d9-468c-997a-8e63e8b66f8d :END: -#+begin_src emacs-lisp - prop +#+name: noweb-example +#+begin_src emacs-lisp :exports results + (message "expanded1") #+end_src -#+name: -: 4 +#+name: noweb-example2 +#+begin_src emacs-lisp :exports results + (message "expanded2") +#+end_src + +#+begin_src emacs-lisp :noweb yes :exports results +;; noweb-1-yes-start + <> +#+end_src + +#+begin_src emacs-lisp :noweb no :exports code +;; noweb-no-start + <> +#+end_src + +#+begin_src emacs-lisp :noweb yes :exports results +;; noweb-2-yes-start + <> +#+end_src + +#+begin_src emacs-lisp :noweb tangle :exports code + <> + <> +#+end_src * excessive id links on tangling :PROPERTIES: @@ -59,42 +89,6 @@ #+begin_src emacs-lisp :tangle no (message "for tangling") #+end_src -* simple variable resolution - :PROPERTIES: - :ID: f68821bc-7f49-4389-85b5-914791ee3718 - :END: - -#+name: four -#+begin_src emacs-lisp - (list 1 2 3 4) -#+end_src - -#+begin_src emacs-lisp :var four=four - (length four) -#+end_src - -#+name: -: 4 - -* multi-line header arguments - :PROPERTIES: - :ID: b77c8857-6c76-4ea9-8a61-ddc2648d96c4 - :END: - -#+headers: :var letters='(a b c d e f g) -#+begin_src emacs-lisp :var numbers='(1 2 3 4 5 6 7) - (map 'list #'list numbers letters) -#+end_src - -#+name: -| 1 | a | -| 2 | b | -| 3 | c | -| 4 | d | -| 5 | e | -| 6 | f | -| 7 | g | - * simple named code block :PROPERTIES: :ID: 0d82b52d-1bb9-4916-816b-2c67c8108dbb @@ -111,7 +105,7 @@ #+name: i-have-a-name : 42 -* Pascal's Triangle -- export test +* Pascal's Triangle -- exports both test :PROPERTIES: :ID: 92518f2a-a46a-4205-a3ab-bcce1008a4bb :END: @@ -202,29 +196,24 @@ Here is one in the middle src_sh{echo 1} of a line. Here is one at the end of a line. src_sh{echo 2} src_sh{echo 3} Here is one at the beginning of a line. -* parsing header arguments - :PROPERTIES: - :ID: 7eb0dc6e-1c53-4275-88b3-b22f3113b9c3 - :END: - -#+begin_src example-lang :session :results output :var num=9 - the body -#+end_src -* conflicting blocks on export +* mixed blocks with exports both :PROPERTIES: :ID: 5daa4d03-e3ea-46b7-b093-62c1b7632df3 :END: + #+name: a-list - a - b - c -#+begin_src emacs-lisp :results wrap :exports both +#+begin_src emacs-lisp :exports both "code block results" #+end_src -#+begin_src emacs-lisp :var lst=a-list :results list + +#+begin_src emacs-lisp :var lst=a-list :results list :exports both (reverse lst) #+end_src + * using the =:noweb-ref= header argument :PROPERTIES: :ID: 54d68d4b-1544-4745-85ab-4f03b3cbd8a0 @@ -282,32 +271,43 @@ this is simple has length 14 * org-babel-get-inline-src-block-matches - :PROPERTIES: + :PROPERTIES: :results: silent :ID: 0D0983D4-DE33-400A-8A05-A225A567BC74 :END: src_sh{echo "One"} block at start of line - One spaced block in src_sh{ echo "middle" } of line + One spaced block in src_sh{ echo "middle" } of line src_sh{echo 2} blocks on the src_emacs-lisp{"same"} line Inline block with src_sh[:results silent]{ echo "parameters" }. -* returning file names -- interpreted as lists +* exporting a code block with a name :PROPERTIES: - :ID: a73a2ab6-b8b2-4c0e-ae7f-23ad14eab7bc + :ID: b02ddd8a-eeb8-42ab-8664-8a759e6f43d9 :END: -#+begin_src sh :results scalar - echo "[[file:./cv.cls]]" +exporting a code block with a name +#+name: qux +#+begin_src sh :foo "baz" + echo bar #+end_src +* noweb no-export and exports both + :PROPERTIES: + :ID: 8a820f6c-7980-43db-8a24-0710d33729c9 + :END: +Weird interaction. -#+name: -: [[file:./cv.cls]] +here is one block -#+begin_src sh :results raw scalar - echo "[[file:./cv.cls]]" -#+end_src +#+name: noweb-no-export-and-exports-both-1 +#+BEGIN_SRC sh :exports none + echo 1 +#+END_SRC -#+name: -[[file:./cv.cls]] +and another + +#+BEGIN_SRC sh :noweb no-export :exports both + # I am inside the code block + <> +#+END_SRC * in order evaluation on export :PROPERTIES: @@ -335,3 +335,23 @@ Fifth #+begin_src emacs-lisp (push 5 *evaluation-collector*) #+end_src +* exporting more than just results from a call line + :PROPERTIES: + :ID: bec63a04-491e-4caa-97f5-108f3020365c + :END: +Here is a call line with more than just the results exported. +#+call: double(8) +* strip noweb references on export + :PROPERTIES: + :ID: 8e7bd234-99b2-4b14-8cd6-53945e409775 + :END: + +#+name: strip-export-1 +#+BEGIN_SRC sh :exports none + i="10" +#+END_SRC + +#+BEGIN_SRC sh :noweb strip-export :exports code :results silent + <> + echo "1$i" +#+END_SRC diff --git a/testing/examples/normal.org b/testing/examples/normal.org index af6e4ea..c0d95a4 100644 --- a/testing/examples/normal.org +++ b/testing/examples/normal.org @@ -16,3 +16,13 @@ Here are a couple of code blocks. ;; 94839181-184f-4ff4-a72f-94214df6f5ba (message "I am code") #+end_src +* accumulating properties in drawers + :PROPERTIES: + :var+: bar=2 + :var: foo=1 + :ID: 75282ba2-f77a-4309-a970-e87c149fe125 + :END: + +#+begin_src emacs-lisp :results silent + (list bar foo) +#+end_src diff --git a/testing/lisp/test-ob-C.el b/testing/lisp/test-ob-C.el index dfadedb..5b5e0b4 100644 --- a/testing/lisp/test-ob-C.el +++ b/testing/lisp/test-ob-C.el @@ -1,5 +1,15 @@ -(require 'ob-C) - +;;; test-ob-awk.el --- tests for ob-awk.el + +;; Copyright (c) 2010-2012 Sergey Litvinov +;; Authors: Sergey Litvinov + +;; Released under the GNU General Public License version 3 +;; see: http://www.gnu.org/licenses/gpl-3.0.html + +;;; Code: +(unless (featurep 'ob-C) + (signal 'missing-test-dependency "Support for C code blocks")) + (ert-deftest ob-C/assert () (should t)) diff --git a/testing/lisp/test-ob-R.el b/testing/lisp/test-ob-R.el index 2dfd141..0ebf4d9 100644 --- a/testing/lisp/test-ob-R.el +++ b/testing/lisp/test-ob-R.el @@ -1,23 +1,17 @@ ;;; test-ob-R.el --- tests for ob-R.el -;; Copyright (c) 2011 Eric Schulte +;; Copyright (c) 2011-2012 Eric Schulte ;; Authors: Eric Schulte ;; Released under the GNU General Public License version 3 ;; see: http://www.gnu.org/licenses/gpl-3.0.html +;;; Code: (org-test-for-executable "R") (unless (featurep 'ess) (signal 'missing-test-dependency "ESS")) - -(let ((load-path (cons (expand-file-name - ".." (file-name-directory - (or load-file-name buffer-file-name))) - load-path))) - (require 'org-test) - (require 'org-test-ob-consts)) - -(require 'ob-R) +(unless (featurep 'ob-R) + (signal 'missing-test-dependency "Support for R code blocks")) (ert-deftest test-ob-R/simple-session () (org-test-with-temp-text diff --git a/testing/lisp/test-ob-awk.el b/testing/lisp/test-ob-awk.el index e372fef..d925b7b 100644 --- a/testing/lisp/test-ob-awk.el +++ b/testing/lisp/test-ob-awk.el @@ -1,21 +1,15 @@ ;;; test-ob-awk.el --- tests for ob-awk.el -;; Copyright (c) 2010 Sergey Litvinov +;; Copyright (c) 2010-2012 Sergey Litvinov ;; Authors: Sergey Litvinov ;; Released under the GNU General Public License version 3 ;; see: http://www.gnu.org/licenses/gpl-3.0.html +;;; Code: (org-test-for-executable "awk") - -(let ((load-path (cons (expand-file-name - ".." (file-name-directory - (or load-file-name buffer-file-name))) - load-path))) - (require 'org-test) - (require 'org-test-ob-consts)) - -(require 'ob-awk) +(unless (featurep 'ob-awk) + (signal 'missing-test-dependency "Support for Awk code blocks")) (ert-deftest ob-awk/input-none () "Test with no input file" diff --git a/testing/lisp/test-ob-emacs-lisp.el b/testing/lisp/test-ob-emacs-lisp.el index a83e8e9..f262ff7 100644 --- a/testing/lisp/test-ob-emacs-lisp.el +++ b/testing/lisp/test-ob-emacs-lisp.el @@ -10,19 +10,7 @@ ;; Org-mode tests for ob-emacs-lisp.el live here - ;;; Code: - -(let ((load-path (cons (expand-file-name - ".." (file-name-directory - (or load-file-name buffer-file-name))) - load-path))) - (require 'org-test) - (require 'org-test-ob-consts)) - - -;;; Tests - (ert-deftest ob-emacs-lisp/commented-last-block-line-no-var () (org-test-with-temp-text-in-file " #+begin_src emacs-lisp diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el index 8899e0d..f86d84a 100644 --- a/testing/lisp/test-ob-exp.el +++ b/testing/lisp/test-ob-exp.el @@ -1,6 +1,6 @@ ;;; test-ob-exp.el -;; Copyright (c) 2010 Eric Schulte +;; Copyright (c) 2010-2012 Eric Schulte ;; Authors: Eric Schulte ;; Released under the GNU General Public License version 3 @@ -10,17 +10,7 @@ ;; Template test file for Org-mode tests - ;;; Code: -(let ((load-path (cons (expand-file-name - ".." (file-name-directory - (or load-file-name buffer-file-name))) - load-path))) - (require 'org-test) - (require 'org-test-ob-consts)) - - -;;; Tests (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers () "Testing export without any headlines in the org-mode file." (let ((html-file (concat (file-name-sans-extension org-test-no-heading-file) @@ -65,43 +55,164 @@ (should-not (file-exists-p (concat org-test-link-in-heading-file "::"))) (when (file-exists-p html-file) (delete-file html-file)))) -;; TODO -;; (ert-deftest ob-exp/noweb-on-export () -;; "Noweb header arguments export correctly. -;; - yes expand on both export and tangle -;; - no expand on neither export or tangle -;; - tangle expand on only tangle not export" -;; (let (html) -;; (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7" -;; (org-narrow-to-subtree) -;; (let ((arg nil) -;; ) -;; (mapcar (lambda (x) -;; (should (equal "" -;; (org-export-as-html nil -;; nil -;; nil -;; 'string)))) -;; '("yes" "no" "tangle")))))) - - -;; TODO Test broken (args-out-of-range 1927 3462) -;; (ert-deftest ob-exp/exports-both () -;; "Test the :exports both header argument. -;; The code block should create both 
 and 

-;; elements in the final html."
-;;   (let (html)
-;;     (org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb"
-;;       (org-narrow-to-subtree)
-;;       (setq html (org-export-as-html nil nil nil 'string))
-;;       (should (string-match "[^\000]*" html))
-;;       (should (string-match "[^\000]*" html)))))
-
-;; TODO Test Broken - causes ert to go off into the weeds
-;; (ert-deftest ob-exp/export-subtree ()
-;;   (org-test-at-id "5daa4d03-e3ea-46b7-b093-62c1b7632df3"
-;;     (org-mark-subtree)
-;;     (org-export-as-latex nil)))
+(ert-deftest ob-exp/noweb-on-export ()
+  "Noweb header arguments export correctly.
+- yes      expand on both export and tangle
+- no       expand on neither export or tangle
+- tangle   expand on only tangle not export"
+  (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7"
+    (org-narrow-to-subtree)
+    (let ((exported-html
+	   (org-export-as-html nil nil nil 'string 'body-only))
+	  (test-point 0))
+
+      (org-test-with-temp-text-in-file
+	  exported-html
+
+	;; check following ouput exists and in order
+	(mapcar (lambda (x)
+		  (should (< test-point
+			     (re-search-forward
+			      x
+			      nil t)))
+		  (setq test-point (point)))
+		'(":noweb header argument expansion"
+		  "message" "expanded1"
+		  "message" "expanded2"
+		  "noweb-1-yes-start"
+		  "message" "expanded1"
+		  "noweb-no-start"
+		  "<<noweb-example1>>"
+		  "noweb-2-yes-start"
+		  "message" "expanded2"
+		  "noweb-tangle-start"
+		  "<<noweb-example1>>"
+		  "<<noweb-example2>>"))))))
+
+(ert-deftest ob-exp/noweb-on-export-with-exports-results ()
+  "Noweb header arguments export correctly using :exports results.
+- yes      expand on both export and tangle
+- no       expand on neither export or tangle
+- tangle   expand on only tangle not export"
+  (org-test-at-id "8701beb4-13d9-468c-997a-8e63e8b66f8d"
+    (org-narrow-to-subtree)
+    (let ((exported-html
+	   (org-export-as-html nil nil nil 'string 'body-only))
+	  (test-point 0))
+
+      (org-test-with-temp-text-in-file
+	  exported-html
+
+	;; check following ouput exists and in order
+	(mapcar (lambda (x)
+		  (should (< test-point
+			     (re-search-forward
+			      x
+			      nil t)))
+		  (setq test-point (point)))
+		'(":noweb header argument expansion using :exports results"
+		  "expanded1"
+		  "expanded2"
+		  "expanded1"
+		  "noweb-no-start"
+		  "<<noweb-example1>>"
+		  "expanded2"
+		  "<<noweb-example1>>"
+		  "<<noweb-example2>>"))))))
+
+(ert-deftest ob-exp/exports-both ()
+  "Test the :exports both header argument.
+The code block should create both 
 and 

+elements in the final html."
+  (org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb"
+    (org-narrow-to-subtree)
+    (let ((exported-html
+	   (org-export-as-html nil nil nil 'string 'body-only))
+	  (test-point 0))
+      (org-test-with-temp-text-in-file
+	  exported-html
+
+	;; check following ouput exists and in order
+	(mapcar (lambda (x)
+		  (should (< test-point
+			     (re-search-forward
+			      x
+			      nil t)))
+		  (setq test-point (point)))
+		'( "Pascal's Triangle – exports both test"
+		   ""
+		   ""
+		   """>1<"""
+		   """>1<"">1<"""
+		   """>1<"">2<"">1<"""
+		   """>1<"">3<"">3<"">1<"""
+		   """>1<"">4<"">6<"">4<"">1<"""
+		   """>1<"">5<"">10<"">10<"">5<"">1<"""
+		   """"))))))
+
+(ert-deftest ob-exp/mixed-blocks-with-exports-both ()
+    (org-test-at-id "5daa4d03-e3ea-46b7-b093-62c1b7632df3"
+    (org-narrow-to-subtree)
+    (let ((exported-html
+	   (org-export-as-html nil nil nil 'string  'body-only))
+	  (test-point 0))
+      (org-test-with-temp-text-in-file
+	  exported-html
+
+	;; check following ouput exists and in order
+	(mapcar (lambda (x)
+		  (should (< test-point
+			     (re-search-forward
+			      x
+			      nil t)))
+		  (setq test-point (point)))
+		'("mixed blocks with exports both"
+		  "
    "
+		  "
  • ""a""
    • "
+		  "
  • ""b""
    • "
+		  "
  • ""c""
    • "
+		  "
"
+		  ""
+		  "
"
+		  "code block results"
+		  "
"))))))
+
+(ert-deftest ob-exp/export-with-name ()
+  (let ((org-babel-exp-code-template
+	 "=%name=\n#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
+    (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
+      (org-narrow-to-subtree)
+      (let ((ascii (org-export-as-ascii nil nil nil 'string 'body-only)))
+	(should (string-match "qux" ascii))))))
+
+(ert-deftest ob-exp/export-with-header-argument ()
+  (let ((org-babel-exp-code-template
+	 "
+| header  | value    |
+|---------+----------|
+| foo     | %foo     |
+| results | %results |
+#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC"))
+    (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9"
+      (org-narrow-to-subtree)
+      (let ((ascii (org-export-as-ascii nil nil nil 'string 'body-only)))
+	(should (string-match "baz" ascii))
+	(should (string-match "replace" ascii))))))
+
+(ert-deftest ob-exp/noweb-no-export-and-exports-both ()
+  (org-test-at-id "8a820f6c-7980-43db-8a24-0710d33729c9"
+    (org-narrow-to-subtree)
+    (let ((html (org-export-as-html nil nil nil 'string 'body-only)))
+      (should (string-match (regexp-quote "noweb-no-export-and-exports-both-1")
+			    html)))))
 
 (ert-deftest ob-exp/evaluate-all-executables-in-order ()
   (org-test-at-id "96cc7073-97ec-4556-87cf-1f9bffafd317"
@@ -110,6 +221,49 @@
       (org-export-as-ascii nil nil nil 'string)
       (should (equal '(5 4 3 2 1) *evaluation-collector*)))))
 
+(ert-deftest ob-exp/export-call-line-information ()
+  (org-test-at-id "bec63a04-491e-4caa-97f5-108f3020365c"
+    (org-narrow-to-subtree)
+    (let* ((org-babel-exp-call-line-template "\n: call: %line special-token")
+	   (html (org-export-as-html nil nil nil 'string t)))
+      (should (string-match "double" html))
+      (should (string-match "16" html))
+      (should (string-match "special-token" html)))))
+
+(ert-deftest ob-exp/noweb-strip-export-ensure-strips ()
+  (org-test-at-id "8e7bd234-99b2-4b14-8cd6-53945e409775"
+    (org-narrow-to-subtree)
+    (org-babel-next-src-block 2)
+    (should (= 110 (org-babel-execute-src-block)))
+    (let ((ascii (org-export-as-ascii nil nil nil 'string t)))
+      (should-not (string-match (regexp-quote "<>") ascii))
+      (should-not (string-match (regexp-quote "i=\"10\"") ascii)))))
+
+(ert-deftest ob-exp/export-from-a-temp-buffer ()
+  :expected-result :failed
+  (org-test-with-temp-text
+      "
+#+Title: exporting from a temporary buffer
+
+#+name: foo
+#+BEGIN_SRC emacs-lisp
+  :foo
+#+END_SRC
+
+#+name: bar
+#+BEGIN_SRC emacs-lisp
+  :bar
+#+END_SRC
+
+#+BEGIN_SRC emacs-lisp :var foo=foo :noweb yes :exports results
+  (list foo <>)
+#+END_SRC
+"
+    (let* ((org-current-export-file (current-buffer))
+	   (ascii (org-export-as-ascii nil nil nil 'string)))
+      (should (string-match (regexp-quote (format nil "%S" '(:foo :bar)))
+			    ascii)))))
+
 (provide 'test-ob-exp)
 
 ;;; test-ob-exp.el ends here
diff --git a/testing/lisp/test-ob-fortran.el b/testing/lisp/test-ob-fortran.el
index 8be3287..c18cb64 100644
--- a/testing/lisp/test-ob-fortran.el
+++ b/testing/lisp/test-ob-fortran.el
@@ -1,35 +1,15 @@
 ;;; test-ob-fortran.el --- tests for ob-fortran.el
 
-;; Copyright (c) 2010 Sergey Litvinov
+;; Copyright (c) 2010-2012 Sergey Litvinov
 ;; Authors: Sergey Litvinov
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
 
+;;; Code:
 (org-test-for-executable "gfortran")
-
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-(let ((load-path (cons (expand-file-name
-			"langs"
-			(expand-file-name
-			 "babel"
-			 (expand-file-name
-			  "contrib"
-			  (expand-file-name
-			   ".."
-			   (expand-file-name
-			    ".."
-			    (file-name-directory
-			     (or load-file-name buffer-file-name)))))))
-		       load-path)))
-
-  (require 'ob-fortran))
+(unless (featurep 'ob-fortran)
+  (signal 'missing-test-dependency "Support for Fortran code blocks"))
 
 (ert-deftest ob-fortran/assert ()
   (should t))
@@ -38,15 +18,13 @@
   "Test of hello world program."
   (org-test-at-id "459384e8-1797-4f11-867e-dde0473ea7cc"
     (org-babel-next-src-block)
-    (should (equal "Hello world" (org-babel-execute-src-block))))
-)
+    (should (equal "Hello world" (org-babel-execute-src-block)))))
 
 (ert-deftest ob-fortran/fortran-var-program ()
   "Test a fortran variable"
   (org-test-at-id "459384e8-1797-4f11-867e-dde0473ea7cc"
     (org-babel-next-src-block 2)
-    (should (= 10 (org-babel-execute-src-block))))
-)
+    (should (= 10 (org-babel-execute-src-block)))))
 
 (ert-deftest ob-fortran/input-var ()
   "Test :var"
diff --git a/testing/lisp/test-ob-lilypond.el b/testing/lisp/test-ob-lilypond.el
index 2ca0597..306c48a 100644
--- a/testing/lisp/test-ob-lilypond.el
+++ b/testing/lisp/test-ob-lilypond.el
@@ -1,19 +1,14 @@
 ;;; test-ob-lilypond.el --- tests for ob-lilypond.el
 
-;; Copyright (c) 2010 Martyn Jago
+;; Copyright (c) 2010-2012 Martyn Jago
 ;; Authors: Martyn Jago
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
 
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-(require 'ob-lilypond)
+;;; Code:
+(unless (featurep 'ob-lilypond)
+  (signal 'missing-test-dependency "Support for Lilypond code blocks"))
 
 (save-excursion
   (set-buffer (get-buffer-create "test-ob-lilypond.el"))
@@ -47,10 +42,10 @@
   (should (boundp 'ly-version)))
 
 (ert-deftest ob-lilypond/ly-version-command ()
-  (should (equal "ob-lilypond version 0.3" (ly-version)))
+  (should (equal "ob-lilypond version 7.6" (ly-version)))
   (with-temp-buffer
     (ly-version t)
-    (should (equal "ob-lilypond version 0.3"
+    (should (equal "ob-lilypond version 7.6"
                    (buffer-substring (point-min) (point-max))))))
 
 (ert-deftest ob-lilypond/ly-compile-lilyfile ()
@@ -61,6 +56,7 @@
              t                          ;display
              ,(if ly-gen-png  "--png"  "") ;&rest...
              ,(if ly-gen-html "--html" "")   
+             ,(if ly-gen-pdf "--pdf" "")
              ,(if ly-use-eps  "-dbackend=eps" "")
              ,(if ly-gen-svg  "-dbackend=svg" "")
              "--output=test-file"
@@ -121,6 +117,9 @@
 (ert-deftest ob-lilypond/ly-gen-html ()
   (should (boundp 'ly-gen-html)))
 
+(ert-deftest ob-lilypond/ly-gen-html ()
+  (should (boundp 'ly-gen-pdf)))
+
 (ert-deftest ob-lilypond/use-eps ()
   (should (boundp 'ly-use-eps)))
 
@@ -301,6 +300,18 @@
     (ly-toggle-pdf-display)
     (should (not ly-display-pdf-post-tangle))))
 
+(ert-deftest ob-lilypond/ly-toggle-pdf-generation-toggles-flag ()
+  (if ly-gen-pdf
+      (progn
+        (ly-toggle-pdf-generation)
+         (should (not ly-gen-pdf))
+        (ly-toggle-pdf-generation)
+        (should ly-gen-pdf))
+    (ly-toggle-pdf-generation)
+    (should ly-gen-pdf)
+    (ly-toggle-pdf-generation)
+    (should (not ly-gen-pdf))))
+
 (ert-deftest ob-lilypond/ly-toggle-arrange-mode ()
   (if ly-arrange-mode
       (progn
@@ -353,6 +364,7 @@
   (should (equal '((:tangle . "yes")
                    (:noweb . "yes")
                    (:results . "silent")
+                   (:cache . "yes")
                    (:comments . "yes"))
                  (ly-set-header-args t)))
   (should (equal '((:results . "file")
@@ -364,6 +376,7 @@
   (should (equal '((:tangle . "yes")
                    (:noweb . "yes")
                    (:results . "silent")
+                   (:cache . "yes")
                    (:comments . "yes"))
                  org-babel-default-header-args:lilypond))
   (ly-set-header-args nil)
diff --git a/testing/lisp/test-ob-lob.el b/testing/lisp/test-ob-lob.el
index 5d362d8..2cb49ca 100644
--- a/testing/lisp/test-ob-lob.el
+++ b/testing/lisp/test-ob-lob.el
@@ -1,6 +1,6 @@
 ;;; test-ob-lob.el
 
-;; Copyright (c) 2010 Eric Schulte
+;; Copyright (c) 2010-2012 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; Released under the GNU General Public License version 3
diff --git a/testing/lisp/test-ob-maxima.el b/testing/lisp/test-ob-maxima.el
index a63908c..4c92af0 100644
--- a/testing/lisp/test-ob-maxima.el
+++ b/testing/lisp/test-ob-maxima.el
@@ -1,35 +1,13 @@
 ;;; test-ob-maxima.el --- tests for ob-maxima.el
 
-;; Copyright (c) 2010 Sergey Litvinov
+;; Copyright (c) 2010-2012 Sergey Litvinov
 ;; Authors: Sergey Litvinov
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
-
 (org-test-for-executable "maxima")
-
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-(let ((load-path (cons (expand-file-name
-			"langs"
-			(expand-file-name
-			 "babel"
-			 (expand-file-name
-			  "contrib"
-			  (expand-file-name
-			   ".."
-			   (expand-file-name
-			    ".."
-			    (file-name-directory
-			     (or load-file-name buffer-file-name)))))))
-		       load-path)))
-
-  (require 'ob-maxima))
+(unless (featurep 'ob-maxima)
+  (signal 'missing-test-dependency "Support for Maxima code blocks"))
 
 (ert-deftest ob-maxima/assert ()
   (should t))
diff --git a/testing/lisp/test-ob-octave.el b/testing/lisp/test-ob-octave.el
index 528a94a..e642679 100644
--- a/testing/lisp/test-ob-octave.el
+++ b/testing/lisp/test-ob-octave.el
@@ -1,21 +1,13 @@
 ;;; test-ob-octave.el --- tests for ob-octave.el
 
-;; Copyright (c) 2010 Sergey Litvinov
+;; Copyright (c) 2010-2012 Sergey Litvinov
 ;; Authors: Sergey Litvinov
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
-
 (org-test-for-executable "octave")
-
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-(require 'ob-octave)
+(unless (featurep 'ob-octave)
+  (signal 'missing-test-dependency "Support for Octave code blocks"))
 
 (ert-deftest ob-octave/input-none ()
   "Number output"
diff --git a/testing/lisp/test-ob-python.el b/testing/lisp/test-ob-python.el
index e2990bc..d6a4133 100644
--- a/testing/lisp/test-ob-python.el
+++ b/testing/lisp/test-ob-python.el
@@ -1,21 +1,15 @@
 ;;; test-ob-python.el --- tests for ob-python.el
 
-;; Copyright (c) 2011 Eric Schulte
+;; Copyright (c) 2011-2012 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
 
+;;; Code:
 (org-test-for-executable "python")
-
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-(require 'ob-python)
+(unless (featurep 'ob-python)
+  (signal 'missing-test-dependency "Support for Python code blocks"))
 
 (ert-deftest test-ob-python/colnames-yes-header-argument ()
   (org-test-with-temp-text "#+name: eg
diff --git a/testing/lisp/test-ob-sh.el b/testing/lisp/test-ob-sh.el
index 8ff7081..297c86e 100644
--- a/testing/lisp/test-ob-sh.el
+++ b/testing/lisp/test-ob-sh.el
@@ -1,6 +1,6 @@
 ;;; test-ob-sh.el
 
-;; Copyright (c) 2010 Eric Schulte
+;; Copyright (c) 2010-2012 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; Released under the GNU General Public License version 3
@@ -8,17 +8,10 @@
 
 ;; Template test file for Org-mode tests
 
-
 ;;; Code:
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-
-;;; Tests
+(unless (featurep 'ob-sh)
+  (signal 'missing-test-dependency "Support for Sh code blocks"))
+
 (ert-deftest test-ob-sh/dont-insert-spaces-on-expanded-bodies ()
   "Expanded shell bodies should not start with a blank line
 unless the body of the tangled block does."
diff --git a/testing/lisp/test-ob-table.el b/testing/lisp/test-ob-table.el
index 65fd7af..d25c7a1 100644
--- a/testing/lisp/test-ob-table.el
+++ b/testing/lisp/test-ob-table.el
@@ -1,6 +1,6 @@
 ;;; test-ob-table.el
 
-;; Copyright (c) ߚ Eric Schulte
+;; Copyright (c) 2011-2012 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; Released under the GNU General Public License version 3
@@ -10,17 +10,7 @@
 
 ;; Template test file for Org-mode tests
 
-
 ;;; Code:
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-
-;;; Tests
 
 ;; TODO Test Broken (wrong-type-argument number-or-marker-p "2.0")
 ;; (ert-deftest test-ob-table/sbe ()
diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el
index 5f0385e..17bb433 100644
--- a/testing/lisp/test-ob-tangle.el
+++ b/testing/lisp/test-ob-tangle.el
@@ -1,6 +1,6 @@
 ;;; test-ob-tangle.el
 
-;; Copyright (c) 2010 Eric Schulte
+;; Copyright (c) 2010-2012 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; Released under the GNU General Public License version 3
@@ -12,15 +12,6 @@
 
 
 ;;; Code:
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-
-;;; Tests
 
 ;; TODO
 ;; (ert-deftest ob-tangle/noweb-on-tangle ()
diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el
index 3f4186e..5f9e29c 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -1,18 +1,10 @@
 ;;; test-ob.el --- tests for ob.el
 
-;; Copyright (c) 2010, 2011 Eric Schulte
+;; Copyright (c) 2010-2012 Eric Schulte
 ;; Authors: Eric Schulte, Martyn Jago
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
-
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
 (ert-deftest test-org-babel/multi-line-header-regexp ()
   (should(equal "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
 		org-babel-multi-line-header-regexp))
@@ -26,7 +18,7 @@
     (match-string
      1
      "   \t #+headers: blah1 blah2 blah3 \t\n\t\n blah4 blah5 blah6 \n")))
-  
+
   ;;TODO Check - should this fail?
   (should
    (not (org-test-string-exact-match
@@ -114,11 +106,21 @@
 
 (ert-deftest test-org-babel/elisp-in-header-arguments ()
   "Test execution of elisp forms in header arguments."
-  ;; at the babel.org:elisp-forms-in-header-arguments header
-  (org-test-at-id "22d67284-bf14-4cdc-8319-f4bd876829d7"
-    (org-babel-next-src-block)
-    (let ((info (org-babel-get-src-block-info)))
-      (should (= 4 (org-babel-execute-src-block))))))
+  (org-test-with-temp-text-in-file "
+
+* elisp forms in header arguments
+  :PROPERTIES:
+  :var:      prop = (* 7 6)
+  :END:
+#+begin_src emacs-lisp
+  prop
+#+end_src"
+
+    (progn
+      (goto-char (point-min))
+      (org-babel-next-src-block)
+      (let ((info (org-babel-get-src-block-info)))
+	(should (= 42 (org-babel-execute-src-block)))))))
 
 (ert-deftest test-org-babel/simple-named-code-block ()
   "Test that simple named code blocks can be evaluated."
@@ -135,37 +137,84 @@
 
 (ert-deftest test-org-babel/simple-variable-resolution ()
   "Test that simple variable resolution is working."
-  (org-test-at-id "f68821bc-7f49-4389-85b5-914791ee3718"
-    (org-babel-next-src-block 2)
-    (should (= 4 (org-babel-execute-src-block)))))
+  (org-test-with-temp-text-in-file "
+
+#+name: four
+#+begin_src emacs-lisp
+  (list 1 2 3 4)
+#+end_src
+
+#+begin_src emacs-lisp :var four=four
+  (length four)
+#+end_src"
+
+    (progn
+      (org-babel-next-src-block 2)
+      (should (= 4 (org-babel-execute-src-block)))
+      (forward-line 5)
+      (should (string= ": 4" (buffer-substring
+			      (point-at-bol)
+			      (point-at-eol)))))))
 
 (ert-deftest test-org-babel/multi-line-header-arguments ()
   "Test that multi-line header arguments and can be read."
-  (org-test-at-id "b77c8857-6c76-4ea9-8a61-ddc2648d96c4"
-    (org-babel-next-src-block)
-    (let ((results (org-babel-execute-src-block)))
-      (should(equal 'a (cadr (assoc 1 results))))
-      (should(equal 'd (cadr (assoc 4 results)))))))
+  (org-test-with-temp-text-in-file "
+
+#+headers: :var letters='(a b c d e f g)
+#+begin_src emacs-lisp :var numbers='(1 2 3 4 5 6 7)
+  (map 'list #'list numbers letters)
+#+end_src"
+
+    (progn
+      (org-babel-next-src-block)
+      (let ((results (org-babel-execute-src-block)))
+	(should(equal 'a (cadr (assoc 1 results))))
+	(should(equal 'd (cadr (assoc 4 results))))))))
 
 (ert-deftest test-org-babel/parse-header-args ()
-  (org-test-at-id "7eb0dc6e-1c53-4275-88b3-b22f3113b9c3"
-    (org-babel-next-src-block)
-    (let* ((info (org-babel-get-src-block-info))
-	   (params (nth 2 info)))
-      (message "%S" params)
-      (should(equal "example-lang" (nth 0 info)))
-      (should(string= "the body" (org-babel-trim (nth 1 info))))
-      (should-not (member '(:session\ \ \ \ ) params))
-      (should(equal '(:session) (assoc :session params)))
-      (should(equal '(:result-type . output) (assoc :result-type params)))
-      (should(equal '(num . 9) (cdr (assoc :var params)))))))
+  (org-test-with-temp-text-in-file "
+
+#+begin_src example-lang :session     :results output :var num=9
+  the body
+#+end_src"
+
+    (progn
+      (org-babel-next-src-block)
+      (let* ((info (org-babel-get-src-block-info))
+	     (params (nth 2 info)))
+	(message "%S" params)
+	(should(equal "example-lang" (nth 0 info)))
+	(should(string= "the body" (org-babel-trim (nth 1 info))))
+	(should-not (member '(:session\ \ \ \ ) params))
+	(should(equal '(:session) (assoc :session params)))
+	(should(equal '(:result-type . output) (assoc :result-type params)))
+	(should(equal '(num . 9) (cdr (assoc :var params))))))))
 
 (ert-deftest test-org-babel/parse-header-args2 ()
-  (org-test-at-id "2409e8ba-7b5f-4678-8888-e48aa02d8cb4"
-    (should (string-match (regexp-quote "this is simple")
-			  (org-babel-ref-resolve "simple-subtree")))
-    (org-babel-next-src-block)
-    (should (= 14 (org-babel-execute-src-block)))))
+  (org-test-with-temp-text-in-file "
+
+* resolving sub-trees as references
+
+#+begin_src emacs-lisp :var text=d4faa7b3-072b-4dcf-813c-dd7141c633f3
+  (length text)
+#+end_src
+
+#+begin_src org :noweb yes
+  <>
+  <>
+#+end_src
+
+** simple subtree with custom ID
+   :PROPERTIES:
+   :CUSTOM_ID: simple-subtree
+   :END:
+this is simple"
+
+    (progn
+      (should (string-match (regexp-quote "this is simple")
+			    (org-babel-ref-resolve "simple-subtree")))
+      (org-babel-next-src-block)
+      (should (= 14 (org-babel-execute-src-block))))))
 
 (ert-deftest test-org-babel/inline-src-blocks ()
   (org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18"
@@ -199,8 +248,7 @@
       (should (re-search-forward ":results" nil t)) ;; 4
       (should (org-babel-get-inline-src-block-matches))
       (end-of-line)
-      (should-not (org-babel-get-inline-src-block-matches))
-    )))
+      (should-not (org-babel-get-inline-src-block-matches)))))
 
 (ert-deftest test-org-babel/inline-src_blk-default-results-replace-line-1 ()
   (let ((test-line "src_sh{echo 1}"))
@@ -227,7 +275,7 @@
     (org-test-with-temp-text
 	test-line
       (should-error (org-ctrl-c-ctrl-c))
-      (forward-char) (org-ctrl-c-ctrl-c) 
+      (forward-char) (org-ctrl-c-ctrl-c)
       (should (string=
 	       (concat test-line " =1=")
 	       (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
@@ -284,7 +332,7 @@
       	       (concat test-line " =x=")
       	       (buffer-substring-no-properties
 		(point-at-bol) (point-at-eol))))))
-    
+
   (let ((test-line (concat " Some text prior to block "
 			   "src_emacs-lisp[:results replace]{ \"y\" }")))
     (org-test-with-temp-text test-line
@@ -375,12 +423,25 @@
 			(point-min) (point-max)))))))
 
 (ert-deftest test-org-babel/combining-scalar-and-raw-result-types ()
-  (flet ((next-result ()
-		      (org-babel-next-src-block)
-		      (org-babel-execute-src-block)
-		      (goto-char (org-babel-where-is-src-block-result))
-		      (forward-line 1)))
-    (org-test-at-id "a73a2ab6-b8b2-4c0e-ae7f-23ad14eab7bc"
+  (org-test-with-temp-text-in-file "
+
+#+begin_src sh :results scalar
+echo \"[[file:./cv.cls]]\"
+#+end_src
+
+#+name:
+: [[file:./cv.cls]]
+
+#+begin_src sh :results raw scalar
+   echo \"[[file:./cv.cls]]\"
+#+end_src
+"
+    (flet ((next-result ()
+			(org-babel-next-src-block)
+			(org-babel-execute-src-block)
+			(goto-char (org-babel-where-is-src-block-result))
+			(forward-line 1)))
+      (goto-char (point-min))
       (next-result)
       (should (org-babel-in-example-or-verbatim))
       (next-result)
@@ -558,7 +619,7 @@
       (check-eval "never-export" nil)
       (check-eval "no-export" nil))))
 
-(ert-deftest test-ob/noweb-expansion ()
+(ert-deftest test-ob/noweb-expansion-1 ()
   (org-test-with-temp-text "#+begin_src sh :results output :tangle yes
   <>
 #+end_src
@@ -567,7 +628,9 @@
 #+begin_src sh
   bar
 #+end_src"
-    (should (string= (org-babel-expand-noweb-references) "bar")))
+    (should (string= (org-babel-expand-noweb-references) "bar"))))
+
+(ert-deftest test-ob/noweb-expansion-2 ()
   (org-test-with-temp-text "#+begin_src sh :results output :tangle yes
   <>
 #+end_src
@@ -594,6 +657,7 @@
 	   '(":a 1" "b [2 3]" "c (4 :d (5 6))")
 	   (org-babel-balanced-split ":a 1 :b [2 3] :c (4 :d (5 6))"
 				     '((32 9) . 58)))))
+
 (ert-deftest test-ob/commented-last-block-line-no-var ()
   (org-test-with-temp-text-in-file "
 #+begin_src emacs-lisp
@@ -791,6 +855,213 @@ (defun test-ob-verify-result-and-removed-result (result buffer-text)
 
 * next heading"))
 
+(ert-deftest test-org-babel/inline-src_blk-preceded-punct-preceded-by-point ()
+  (let ((test-line ".src_emacs-lisp[ :results verbatim ]{ \"x\"  }"))
+    (org-test-with-temp-text
+	test-line
+      (forward-char 1)
+      (org-ctrl-c-ctrl-c)
+      (should (re-search-forward "=\"x\"=" nil t))
+      (forward-line))))
+
+(ert-deftest test-ob/commented-last-block-line-with-var ()
+  (org-test-with-temp-text-in-file "
+#+begin_src emacs-lisp :var a=1
+;;
+#+end_src"
+    (progn
+      (org-babel-next-src-block)
+      (org-ctrl-c-ctrl-c)
+      (re-search-forward "\\#\\+results:" nil t)
+      (forward-line)
+      (should (string=
+	       ""
+	       (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))
+  (org-test-with-temp-text-in-file "
+#+begin_src emacs-lisp :var a=2
+2;;
+#+end_src"
+    (progn
+      (org-babel-next-src-block)
+      (org-ctrl-c-ctrl-c)
+      (re-search-forward "\\#\\+results:" nil t)
+      (forward-line)
+      (should (string=
+	       ": 2"
+	       (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))))
+
+(defun test-ob-verify-result-and-removed-result (result buffer-text)
+  "Test helper function to test `org-babel-remove-result'.
+A temp buffer is populated with BUFFER-TEXT, the first block is executed,
+and the result of execution is verified against RESULT.
+
+The block is actually executed /twice/ to ensure result
+replacement happens correctly."
+  (org-test-with-temp-text
+      buffer-text
+    (progn
+      (org-babel-next-src-block) (org-ctrl-c-ctrl-c) (org-ctrl-c-ctrl-c)
+      (should (re-search-forward "\\#\\+results:" nil t))
+      (forward-line)
+      (should (string= result
+		       (buffer-substring-no-properties
+			(point-at-bol)
+			(- (point-max) 16))))
+      (org-babel-previous-src-block) (org-babel-remove-result)
+      (should (string= buffer-text
+		       (buffer-substring-no-properties
+			(point-min) (point-max)))))))
+
+(ert-deftest test-ob/org-babel-remove-result--results-default ()
+  "Test `org-babel-remove-result' with default :results."
+  (mapcar (lambda (language)
+	    (test-ob-verify-result-and-removed-result
+	     "\n"
+	     (concat
+"* org-babel-remove-result
+#+begin_src " language "
+#+end_src
+
+* next heading")))
+	  '("sh" "emacs-lisp")))
+
+(ert-deftest test-ob/org-babel-remove-result--results-list ()
+  "Test `org-babel-remove-result' with :results list."
+  (test-ob-verify-result-and-removed-result
+   "- 1
+- 2
+- 3
+- (quote (4 5))"
+
+"* org-babel-remove-result
+#+begin_src emacs-lisp :results list
+'(1 2 3 '(4 5))
+#+end_src
+
+* next heading"))
+
+(ert-deftest test-ob/org-babel-remove-result--results-wrap ()
+  "Test `org-babel-remove-result' with :results wrap."
+  (test-ob-verify-result-and-removed-result
+   ":RESULTS:
+hello there
+:END:"
+
+ "* org-babel-remove-result
+
+#+begin_src emacs-lisp :results wrap
+\"hello there\"
+#+end_src
+
+* next heading"))
+
+(ert-deftest test-ob/org-babel-remove-result--results-org ()
+  "Test `org-babel-remove-result' with :results org."
+  (test-ob-verify-result-and-removed-result
+   "#+BEGIN_ORG
+* heading
+** subheading
+content
+#+END_ORG"
+
+"* org-babel-remove-result
+#+begin_src emacs-lisp :results org
+\"* heading
+** subheading
+content\"
+#+end_src
+
+* next heading"))
+
+(ert-deftest test-ob/org-babel-remove-result--results-html ()
+  "Test `org-babel-remove-result' with :results html."
+  (test-ob-verify-result-and-removed-result
+   "#+BEGIN_HTML
+
+#+END_HTML"
+
+"* org-babel-remove-result
+#+begin_src emacs-lisp :results html
+\"\"
+#+end_src
+
+* next heading"))
+
+(ert-deftest test-ob/org-babel-remove-result--results-latex ()
+  "Test `org-babel-remove-result' with :results latex."
+  (test-ob-verify-result-and-removed-result
+   "#+BEGIN_LaTeX
+Line 1
+Line 2
+Line 3
+#+END_LaTeX"
+
+"* org-babel-remove-result
+#+begin_src emacs-lisp :results latex
+\"Line 1
+Line 2
+Line 3\"
+#+end_src
+
+* next heading"))
+
+(ert-deftest test-ob/org-babel-remove-result--results-code ()
+  "Test `org-babel-remove-result' with :results code."
+
+  (test-ob-verify-result-and-removed-result
+   "#+BEGIN_SRC emacs-lisp
+\"I am working!\"
+#+END_SRC"
+
+"* org-babel-remove-result
+#+begin_src emacs-lisp :results code
+(message \"I am working!\")
+#+end_src
+
+* next heading"))
+
+(ert-deftest test-ob/org-babel-remove-result--results-pp ()
+  "Test `org-babel-remove-result' with :results pp."
+  (test-ob-verify-result-and-removed-result
+   ": \"I /am/ working!\""
+
+"* org-babel-remove-result
+#+begin_src emacs-lisp :results pp
+\"I /am/ working!\")
+#+end_src
+
+* next heading"))
+
+(ert-deftest test-ob/results-do-not-replace-code-blocks ()
+  (org-test-with-temp-text "Block two has a space after the name.
+
+  #+name: foo
+  #+begin_src emacs-lisp
+    1
+  #+end_src emacs-lisp
+
+#+name: foo 
+#+begin_src emacs-lisp
+  2
+#+end_src
+
+#+name: foo
+#+begin_src emacs-lisp
+  3
+#+end_src
+
+#+RESULTS: foo
+: foo
+"
+    (dolist (num '(1 2 3))
+      ;; execute the block
+      (goto-char (point-min))
+      (org-babel-next-src-block num) (org-babel-execute-src-block)
+      ;; check the results
+      (goto-char (point-max))
+      (move-beginning-of-line 0)
+      (should (looking-at (format ": %d" num))))))
+
 (provide 'test-ob)
 
 ;;; test-ob ends here
diff --git a/testing/lisp/test-org-exp.el b/testing/lisp/test-org-exp.el
index 0ed8d68..1f01499 100644
--- a/testing/lisp/test-org-exp.el
+++ b/testing/lisp/test-org-exp.el
@@ -1,19 +1,12 @@
 ;;; test-org-exp.el --- tests for org-exp.el
 
-;; Copyright (c) 2010 Eric Schulte
+;; Copyright (c) 2010-2012 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
 
-(let ((load-path (cons (expand-file-name
-                        ".." (file-name-directory
-                              (or load-file-name buffer-file-name)))
-                       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts)
-  (require 'org-ascii))
-
+;;; Code:
 (ert-deftest test-org-exp/stripping-commas ()
   "Test the stripping of commas from within blocks during export."
   (org-test-at-id "76d3a083-67fa-4506-a41d-837cc48158b5"
diff --git a/testing/lisp/test-org-html.el b/testing/lisp/test-org-html.el
index c2cc067..74780bd 100644
--- a/testing/lisp/test-org-html.el
+++ b/testing/lisp/test-org-html.el
@@ -10,18 +10,9 @@
 
 ;; Template test file for Org-mode tests
 
-
 ;;; Code:
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-
-;;; Tests
-(require 'org-html)
+(unless (featurep 'org-html)
+  (signal 'missing-test-dependency "Support for Org-html"))
 
 (defmacro org-test-html/export-link (name link expected &optional desc opt-plist)
   `(ert-deftest ,(intern (concat "test-org-html/export-link/" name)) ()
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index 3ecc384..92c136d 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -10,17 +10,7 @@
 
 ;; Template test file for Org-mode tests
 
-
 ;;; Code:
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
-
-;;; Tests
 (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
   "Simple reference @1$1."
   (should
@@ -54,12 +44,28 @@
 ;;    (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
 
 (ert-deftest test-org-table/simple-formula ()
-  (org-test-at-id "563523f7-3f3e-49c9-9622-9216cc9a5d95"
-    (re-search-forward (regexp-quote "#+tblname: simple-formula") nil t)
-    (forward-line 1)
-    (should (org-at-table-p))
-    (should (org-table-recalculate 'all))
-    (should (string= "10" (first (nth 5 (org-table-to-lisp)))))))
+  (org-test-with-temp-text-in-file "
+
+* simple formula
+  :PROPERTIES:
+  :ID:       563523f7-3f3e-49c9-9622-9216cc9a5d95
+  :END:
+
+#+tblname: simple-formula
+|  1 |
+|  2 |
+|  3 |
+|  4 |
+|----|
+|    |
+  #+TBLFM: $1=vsum(@1..@-1)
+"
+    (progn
+      (re-search-forward (regexp-quote "#+tblname: simple-formula") nil t)
+      (forward-line 1)
+      (should (org-at-table-p))
+      (should (org-table-recalculate 'all))
+      (should (string= "10" (first (nth 5 (org-table-to-lisp))))))))
 
 (provide 'test-org-table)
 
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 00ccd81..5edc401 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -10,17 +10,7 @@
 
 ;; Template test file for Org-mode tests
 
-
 ;;; Code:
-(let* ((testing-lisp-dir (file-name-directory
-			  (or load-file-name buffer-file-name)))
-       (load-path (cons testing-lisp-dir load-path)))
-  (dolist (file (directory-files testing-lisp-dir 'full
-				 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
-    (require (intern (substring file 0 (- (length file) 3))))))
-
-
-;;; Tests
 (ert-deftest test-org/org-link-escape-ascii-character ()
   "Escape an ascii character."
   (should
@@ -92,6 +82,53 @@
     "http://some.host.com/form?&id=blah%2Bblah25"
     (org-link-unescape (org-link-escape "http://some.host.com/form?&id=blah%2Bblah25")))))
 
+(ert-deftest test-org/accumulated-properties-in-drawers ()
+  "Ensure properties accumulate in subtree drawers."
+  (org-test-at-id "75282ba2-f77a-4309-a970-e87c149fe125"
+    (org-babel-next-src-block)
+    (should (equal '(2 1) (org-babel-execute-src-block)))))
+
+
+
+;;; Links
+
+;;;; Fuzzy links
+
+;; Fuzzy links [[text]] encompass links to a target (<>), to
+;; a target keyword (aka an invisible target: #+TARGET: text), to
+;; a named element (#+name: text) and to headlines (* Text).
+
+(ert-deftest test-org-export/fuzzy-links ()
+  "Test fuzzy links specifications."
+  ;; 1. Fuzzy link goes in priority to a matching target.
+  (org-test-with-temp-text
+      "#+TARGET: Test\n#+NAME: Test\n|a|b|\n<>\n* Test\n[[Test]]"
+    (goto-line 6)
+    (org-open-at-point)
+    (should (looking-at "<>")))
+  ;; 2. Fuzzy link should then go to a matching target keyword.
+  (org-test-with-temp-text
+      "#+NAME: Test\n|a|b|\n#+TARGET: Test\n* Test\n[[Test]]"
+    (goto-line 5)
+    (org-open-at-point)
+    (should (looking-at "#\\+TARGET: Test")))
+  ;; 3. Then fuzzy link points to an element with a given name.
+  (org-test-with-temp-text "Test\n#+NAME: Test\n|a|b|\n* Test\n[[Test]]"
+    (goto-line 5)
+    (org-open-at-point)
+    (should (looking-at "#\\+NAME: Test")))
+  ;; 4. A target still lead to a matching headline otherwise.
+  (org-test-with-temp-text "* Head1\n* Head2\n*Head3\n[[Head2]]"
+    (goto-line 4)
+    (org-open-at-point)
+    (should (looking-at "\\* Head2")))
+  ;; 5. With a leading star in link, enforce heading match.
+  (org-test-with-temp-text "#+TARGET: Test\n* Test\n<>\n[[*Test]]"
+    (goto-line 4)
+    (org-open-at-point)
+    (should (looking-at "\\* Test"))))
+
+
 (provide 'test-org)
 
 ;;; test-org.el ends here
diff --git a/testing/lisp/test-property-inheritance.el b/testing/lisp/test-property-inheritance.el
index 60e955d..a68d7c6 100644
--- a/testing/lisp/test-property-inheritance.el
+++ b/testing/lisp/test-property-inheritance.el
@@ -1,24 +1,19 @@
 ;;; test-ob-R.el --- tests for ob-R.el
 
-;; Copyright (c) 2011 Eric Schulte
+;; Copyright (c) 2011-2012 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; Released under the GNU General Public License version 3
 ;; see: http://www.gnu.org/licenses/gpl-3.0.html
 
-(let ((load-path (cons (expand-file-name
-			".." (file-name-directory
-			      (or load-file-name buffer-file-name)))
-		       load-path)))
-  (require 'org-test)
-  (require 'org-test-ob-consts))
-
+;;; Code:
 (defmacro test-org-in-property-buffer (&rest body)
   `(with-temp-buffer
      (insert-file-contents (expand-file-name "property-inheritance.org"
 					     org-test-example-dir))
      (org-mode)
      ,@body))
+(def-edebug-spec test-org-in-property-buffer (body))
 
 (ert-deftest test-org-property-accumulation-top-use ()
   (test-org-in-property-buffer
diff --git a/testing/org-test-ob-consts.el b/testing/org-test-ob-consts.el
index 75b4e3b..c0cb181 100644
--- a/testing/org-test-ob-consts.el
+++ b/testing/org-test-ob-consts.el
@@ -1,6 +1,6 @@
 ;;; org-test-ob-consts.el --- constants for use in code block tests
 
-;; Copyright (c) 2010 Eric Schulte
+;; Copyright (c) 2010-2012 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; Released under the GNU General Public License version 3
@@ -20,4 +20,4 @@ (defconst org-test-link-in-heading-file-ob-anchor
 
 (provide 'org-test-ob-consts)
 
-;;; org-test-ob-consts.el ends here
\ No newline at end of file
+;;; org-test-ob-consts.el ends here
diff --git a/testing/org-test.el b/testing/org-test.el
index 255cb96..f255584 100644
--- a/testing/org-test.el
+++ b/testing/org-test.el
@@ -1,6 +1,6 @@
 ;;;; org-test.el --- Tests for Org-mode
 
-;; Copyright (c) 2010 Sebastian Rose, Eric Schulte
+;; Copyright (c) 2010-2012 Sebastian Rose, Eric Schulte
 ;; Authors:
 ;;     Sebastian Rose, Hannover, Germany, sebastian_rose gmx de
 ;;     Eric Schulte, Santa Fe, New Mexico, USA, schulte.eric gmail com
@@ -30,6 +30,8 @@
 
 
 ;;;; Code:
+(require 'org-test-ob-consts)
+
 (let* ((org-test-dir (expand-file-name
 		      (file-name-directory
 		       (or load-file-name buffer-file-name))))
@@ -170,6 +172,7 @@ (defmacro org-test-in-example-file (file &rest body)
 	 (save-restriction ,@body)))
      (unless visited-p
        (kill-buffer to-be-removed))))
+(def-edebug-spec org-test-in-example-file (form body))
 
 (defmacro org-test-at-marker (file marker &rest body)
   "Run body after placing the point at MARKER in FILE.
@@ -198,7 +201,7 @@ (defmacro org-test-with-temp-text (text &rest body)
 		      (goto-char ,(match-beginning 0)))
 	    `(progn (insert ,inside-text)
 		    (goto-char (point-min)))))
-       ,@body)))
+       (prog1 ,@body (kill-buffer)))))
 (def-edebug-spec org-test-with-temp-text (form body))
 
 (defmacro org-test-with-temp-text-in-file (text &rest body)
@@ -223,12 +226,8 @@ (defmacro org-test-with-temp-text-in-file (text &rest body)
   (defjump org-test-jump
     (("lisp/\\1.el" . "testing/lisp/test-\\1.el")
      ("lisp/\\1.el" . "testing/lisp/\\1.el/test.*.el")
-     ("contrib/lisp/\\1.el" . "testing/contrib/lisp/test-\\1.el")
-     ("contrib/lisp/\\1.el" . "testing/contrib/lisp/\\1.el/test.*.el")
      ("testing/lisp/test-\\1.el" . "lisp/\\1.el")
-     ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el")
-     ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el")
-     ("testing/contrib/lisp/test-\\1.el" . "contrib/lisp/\\1.el/test.*.el"))
+     ("testing/lisp/\\1.el" . "lisp/\\1.el/test.*.el"))
     (concat org-base-dir "/")
     "Jump between org-mode files and their tests."
     (lambda (path)
@@ -312,8 +311,7 @@ (defun org-test-load ()
 				 :expected-result :failed (should nil))))))))
 	       (directory-files base 'full
 				"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.el$"))))
-    (rld (expand-file-name "lisp" org-test-dir))
-    (rld (expand-file-name "lisp" (expand-file-name "contrib" org-test-dir)))))
+    (rld (expand-file-name "lisp" org-test-dir))))
 
 (defun org-test-current-defun ()
   "Test the current function."
@@ -328,11 +326,20 @@ (defun org-test-current-file ()
 		(file-name-nondirectory (buffer-file-name)))
 	       "/")))
 
+(defvar org-test-buffers nil
+  "Hold buffers open for running Org-mode tests.")
+
 (defun org-test-touch-all-examples ()
   (dolist (file (directory-files
 		 org-test-example-dir 'full
 		 "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*\\.org$"))
-    (find-file file)))
+    (unless (get-file-buffer file)
+      (add-to-list 'org-test-buffers (find-file file)))))
+
+(defun org-test-kill-all-examples ()
+  (while org-test-buffers
+    (let ((b (pop org-test-buffers)))
+      (when (buffer-live-p b) (kill-buffer b)))))
 
 (defun org-test-update-id-locations ()
   (org-id-update-id-locations
@@ -361,7 +368,8 @@ (defun org-test-run-all-tests ()
   (interactive)
   (org-test-touch-all-examples)
   (org-test-load)
-  (ert "\\(org\\|ob\\)"))
+  (ert "\\(org\\|ob\\)")
+  (org-test-kill-all-examples))
 
 (provide 'org-test)
 
-- 
1.7.9.2