diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el index 71f7bf401..a22099368 100644 --- a/contrib/lisp/org-contacts.el +++ b/contrib/lisp/org-contacts.el @@ -224,7 +224,20 @@ A regexp matching strings of whitespace, `,' and `;'.") (org-find-if (lambda (file) (or (time-less-p org-contacts-last-update (elt (file-attributes file) 5)))) - (org-contacts-files)))) + (org-contacts-files)) + (org-contacts-db-has-dead-markers-p org-contacts-db))) + +(defun org-contacts-db-has-dead-markers-p (org-contacts-db) + "Returns t if at least one dead marker is found in +ORG-CONTACTS-DB. A dead marker in this case is a marker pointing +to dead or no buffer." + ;; Scan contacts list looking for dead markers, and return t at first found. + (catch 'dead-marker-found + (while org-contacts-db + (unless (marker-buffer (nth 1 (car org-contacts-db))) + (throw 'dead-marker-found t)) + (setq org-contacts-db (cdr org-contacts-db))) + nil)) (defun org-contacts-db () "Return the latest Org Contacts Database." diff --git a/contrib/lisp/orgtbl-sqlinsert.el b/contrib/lisp/orgtbl-sqlinsert.el index f07a0ba3e..b00c93d39 100644 --- a/contrib/lisp/orgtbl-sqlinsert.el +++ b/contrib/lisp/orgtbl-sqlinsert.el @@ -70,14 +70,14 @@ this function is called." (*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote) (params2 (list - :sqlname name + :sqlname (plist-get params :sqlname) :tstart (lambda () (concat (if nowebname (format "<<%s>>= \n" nowebname) "") "BEGIN TRANSACTION;")) :tend (lambda () (concat "COMMIT;" (if nowebname "\n@ " ""))) - :hfmt (lambda (f) (progn (if firstheader (push f hdrlist)) "")) - :hlfmt (lambda (lst) (setq firstheader nil)) + :hfmt (lambda (f) (progn (if firstheader (push f hdrlist) ""))) + :hlfmt (lambda (&rest cells) (setq firstheader nil)) :lstart (lambda () (concat "INSERT INTO " sqlname "( " (mapconcat 'identity (reverse hdrlist) diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el index 3e6f8e63f..29a97ebea 100644 --- a/contrib/lisp/ox-bibtex.el +++ b/contrib/lisp/ox-bibtex.el @@ -28,6 +28,8 @@ ;; ;; http://www.lri.fr/~filliatr/bibtex2html/ ;; +;; It also introduces "cite" syntax for Org links. +;; ;; The usage is as follows: ;; ;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options @@ -64,9 +66,18 @@ ;; into the TeX file when exporting. ;; ;; For HTML export it: -;; 1) converts all \cite{foo} to links to the bibliography, +;; 1) converts all \cite{foo} and [[cite:foo]] to links to the +;; bibliography, ;; 2) creates a foo.html and foo_bib.html, ;; 3) includes the contents of foo.html in the exported HTML file. +;; +;; For LaTeX export it: +;; 1) converts all [[cite:foo]] to \cite{foo}. + +;; Initialization + +(eval-when-compile (require 'cl)) +(org-add-link-type "cite" 'ebib) ;;; Internal Functions @@ -109,18 +120,22 @@ contains a list of strings to be passed as options ot (setq limit (not (equal "nil" value)))) ((equal "option" key) (push value options))))))))) -(defun org-bibtex-citation-p (fragment) - "Non-nil when a LaTeX macro is a citation. -FRAGMENT is a `latex-fragment' type object." - (string-match "\\`\\\\cite{" (org-element-property :value fragment))) +(defun org-bibtex-citation-p (object) + "Non-nil when OBJECT is a citation." + (case (org-element-type object) + (link (equal (org-element-property :type object) "cite")) + (latex-fragment + (string-match "\\`\\\\cite{" (org-element-property :value object))))) (defun org-bibtex-get-citation-key (citation) "Return key for a given citation, as a string. -CITATION is a `latex-fragment' type object satisfying to -`org-bibtex-citation-p' predicate." - (let ((value (org-element-property :value citation))) - (and (string-match "\\`\\\\cite{" value) - (substring value (match-end 0) -1)))) +CITATION is a `latex-fragment' or `link' type object satisfying +to `org-bibtex-citation-p' predicate." + (if (eq (org-element-type citation) 'link) + (org-element-property :path citation) + (let ((value (org-element-property :value citation))) + (and (string-match "\\`\\\\cite{" value) + (substring value (match-end 0) -1))))) @@ -139,7 +154,16 @@ Fallback to `latex' back-end for other keywords." (concat (and style (format "\\bibliographystyle{%s}\n" style)) (format "\\bibliography{%s}" file)))))))) +(defadvice org-latex-link (around bibtex-link) + "Translate \"cite\" type links into LaTeX syntax. +Fallback to `latex' back-end for other keywords." + (let ((link (ad-get-arg 0))) + (if (not (org-bibtex-citation-p link)) ad-do-it + (setq ad-return-value + (format "\\cite{%s}" (org-bibtex-get-citation-key link)))))) + (ad-activate 'org-latex-keyword) +(ad-activate 'org-latex-link) @@ -176,8 +200,25 @@ Fallback to `html' back-end for other keywords." (org-split-string (org-bibtex-get-citation-key fragment) ",") ""))))) +(defadvice org-html-link (around bibtex-link) + "Translate \"cite:\" type links into HTML syntax. +Fallback to `html' back-end for other types." + (let ((link (ad-get-arg 0))) + (if (not (org-bibtex-citation-p link)) ad-do-it + (setq ad-return-value + (mapconcat + (lambda (key) + (format "[%s]" + key + (or (cdr (assoc key org-bibtex-html-entries-alist)) + key))) + (org-split-string (org-bibtex-get-citation-key link) + "[ \t]*,[ \t]*") + ""))))) + (ad-activate 'org-html-keyword) (ad-activate 'org-html-latex-fragment) +(ad-activate 'org-html-link) ;;;; Filter @@ -202,10 +243,10 @@ Return new parse tree. This function assumes current back-end is HTML." ;; argument. (when (plist-get arguments :limit) (let ((citations - (org-element-map tree 'latex-fragment - (lambda (fragment) - (and (org-bibtex-citation-p fragment) - (org-bibtex-get-citation-key fragment)))))) + (org-element-map tree '(latex-fragment link) + (lambda (object) + (and (org-bibtex-citation-p object) + (org-bibtex-get-citation-key object)))))) (with-temp-file (setq temp-file (make-temp-file "ox-bibtex")) (insert (mapconcat 'identity citations "\n"))) (setq arguments diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el index 4e90eff24..cbdfb1f0c 100644 --- a/contrib/lisp/ox-freemind.el +++ b/contrib/lisp/ox-freemind.el @@ -314,14 +314,13 @@ will result in following node: (plist-get info :title)) (t (error "Shouldn't come here.")))) (element-contents (org-element-contents element)) - (section (assoc 'section element-contents)) + (section (assq 'section element-contents)) (section-contents - (let* ((translations - (nconc (list (cons 'section - (lambda (section contents info) - contents))) - (plist-get info :translate-alist)))) - (org-export-data-with-translations section translations info))) + (let ((backend (org-export-create-backend + :parent (org-export-backend-name + (plist-get info :back-end)) + :transcoders '((section . (lambda (e c i) c)))))) + (org-export-data-with-backend section backend info))) (itemized-contents-p (let ((first-child-headline (org-element-map element-contents 'headline 'identity info t))) diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el index 708008a26..44626a973 100644 --- a/contrib/lisp/ox-koma-letter.el +++ b/contrib/lisp/ox-koma-letter.el @@ -499,27 +499,27 @@ holding export options." (and (plist-get info :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) ;; Document class and packages. - (let ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options))) - (org-element-normalize-string - (let* ((header (nth 1 (assoc class org-latex-classes))) - (document-class-string - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))))) - (if (not document-class-string) - (user-error "Unknown LaTeX class `%s'" class) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-splice-latex-header - document-class-string - org-latex-default-packages-alist ; defined in org.el - org-latex-packages-alist nil ; defined in org.el - (concat (plist-get info :latex-header) - (plist-get info :latex-header-extra)))) - info))))) + (let* ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class org-latex-classes))) + (document-class-string + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1))))) + (if (not document-class-string) + (user-error "Unknown LaTeX class `%s'" class) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-element-normalize-string + (org-splice-latex-header + document-class-string + org-latex-default-packages-alist ; Defined in org.el. + org-latex-packages-alist nil ; Defined in org.el. + (concat (org-element-normalize-string (plist-get info :latex-header)) + (plist-get info :latex-header-extra))))) + info))) (let ((lco (plist-get info :lco)) (author (plist-get info :author)) (from-address (org-koma-letter--determine-special-value info 'from)) @@ -578,8 +578,8 @@ holding export options." (dotimes (x l y) (setq y (concat (if (> x 0) "%s," "%s") y))) subject-format) "}\n")) - (when (and subject with-subject) - (format "\\setkomavar{subject}{%s}\n\n" subject)))) + (when (and subject with-subject) + (format "\\setkomavar{subject}{%s}\n\n" subject)))) ;; Letter start (format "\\begin{letter}{%%\n%s}\n\n" (org-koma-letter--determine-special-value info 'to)) diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el index b50970cc3..d207be6e8 100644 --- a/contrib/lisp/ox-rss.el +++ b/contrib/lisp/ox-rss.el @@ -25,6 +25,8 @@ ;; This library implements a RSS 2.0 back-end for Org exporter, based on ;; the `html' back-end. ;; +;; It requires Emacs 24.1 at least. +;; ;; It provides two commands for export, depending on the desired output: ;; `org-rss-export-as-rss' (temporary buffer) and `org-rss-export-to-rss' ;; (as a ".xml" file). @@ -48,7 +50,7 @@ ;; :base-directory "~/myhomepage/" ;; :base-extension "org" ;; :rss-image-url "http://lumiere.ens.fr/~guerry/images/faces/15.png" -;; :home-link-home "http://lumiere.ens.fr/~guerry/" +;; :html-link-home "http://lumiere.ens.fr/~guerry/" ;; :rss-extension "xml" ;; :publishing-directory "/home/guerry/public_html/" ;; :publishing-function (org-rss-publish-to-rss) @@ -58,6 +60,10 @@ ;; :table-of-contents nil)) ;; ;; ... then rsync /home/guerry/public_html/ with your server. +;; +;; By default, the permalink for a blog entry points to the headline. +;; You can specify a different one by using the :RSS_PERMALINK: +;; property within an entry. ;;; Code: @@ -213,6 +219,14 @@ is the property list for the given project. PUB-DIR is the publishing directory. Return output file name." + (let ((bf (get-file-buffer filename))) + (if bf + (with-current-buffer bf + (org-rss-add-pubdate-property) + (write-file filename)) + (find-file filename) + (org-rss-add-pubdate-property) + (write-file filename) (kill-buffer))) (org-publish-org-to 'rss filename (concat "." org-rss-extension) plist pub-dir)) @@ -227,6 +241,9 @@ communication channel." (> (org-export-get-relative-level headline info) 1)) (let* ((htmlext (plist-get info :html-extension)) (hl-number (org-export-get-headline-number headline info)) + (hl-home (file-name-as-directory (plist-get info :html-link-home))) + (hl-pdir (plist-get info :publishing-directory)) + (hl-perm (org-element-property :RSS_PERMALINK headline)) (anchor (org-export-solidify-link-text (or (org-element-property :CUSTOM_ID headline) @@ -236,20 +253,18 @@ communication channel." (pubdate (let ((system-time-locale "C")) (format-time-string - "%a, %d %h %Y %H:%M:%S %Z" + "%a, %d %h %Y %H:%M:%S %z" (org-time-string-to-time (or (org-element-property :PUBDATE headline) (error "Missing PUBDATE property")))))) - (title (org-rss-plain-text - (org-element-property :raw-value headline) info)) + (title (org-element-property :raw-value headline)) (publink - (concat - (file-name-as-directory - (or (plist-get info :html-link-home) - (plist-get info :publishing-directory))) - (file-name-nondirectory - (file-name-sans-extension - (buffer-file-name))) "." htmlext "#" anchor)) + (or (and hl-perm (concat (or hl-home hl-pdir) hl-perm)) + (concat + (or hl-home hl-pdir) + (file-name-nondirectory + (file-name-sans-extension + (plist-get info :input-file))) "." htmlext "#" anchor))) (guid (if org-rss-use-entry-url-as-guid publink (org-rss-plain-text @@ -305,12 +320,12 @@ as a communication channel." (defun org-rss-build-channel-info (info) "Build the RSS channel information." (let* ((system-time-locale "C") - (title (org-export-data (plist-get info :title) info)) + (title (plist-get info :title)) (email (org-export-data (plist-get info :email) info)) (author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) (and auth (org-export-data auth info))))) - (date (format-time-string "%a, %d %h %Y %H:%M:%S %Z")) ;; RFC 882 + (date (format-time-string "%a, %d %h %Y %H:%M:%S %z")) ;; RFC 882 (description (org-export-data (plist-get info :description) info)) (lang (plist-get info :language)) (keywords (plist-get info :keywords)) @@ -318,10 +333,11 @@ as a communication channel." (blogurl (or (plist-get info :html-link-home) (plist-get info :publishing-directory))) (image (url-encode-url (plist-get info :rss-image-url))) + (ifile (plist-get info :input-file)) (publink (concat (file-name-as-directory blogurl) (file-name-nondirectory - (file-name-sans-extension (buffer-file-name))) + (file-name-sans-extension ifile)) "." rssext))) (format "\n%s @@ -332,7 +348,7 @@ as a communication channel." %s %s %s -%s +%s (%s) %s %s @@ -344,7 +360,7 @@ as a communication channel." emacs-major-version emacs-minor-version) " Org-mode " (org-version)) - email image title blogurl))) + email author image title blogurl))) (defun org-rss-section (section contents info) "Transcode SECTION element into RSS format. diff --git a/doc/org.texi b/doc/org.texi index 6053bea1e..55c421d3b 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -1832,9 +1832,11 @@ This command also cycles bullet styles when the cursor in on the bullet or anywhere in an item line, details depending on @code{org-support-shift-select}. @kindex C-c ^ +@cindex sorting, of plain list @item C-c ^ Sort the plain list. You will be prompted for the sorting method: -numerically, alphabetically, by time, or by custom function. +numerically, alphabetically, by time, by checked status for check lists, +or by a custom function. @end table @node Drawers, Blocks, Plain lists, Document Structure @@ -5056,7 +5058,7 @@ tags---beware that all whitespaces are mandatory so that Org can parse this line correctly: @example -#+TAGS: @{ @@read : @@read_book @@read_ebook @} +#+TAGS: @{ @@read : @@read_book @@read_ebook @} @end example In this example, @samp{@@read} is a @emph{group tag} for a set of three @@ -7381,6 +7383,7 @@ Copying works like refiling, except that the original note is not deleted. @vindex org-refile-allow-creating-parent-nodes @vindex org-log-refile @vindex org-refile-use-cache +@vindex org-refile-keep Refile the entry or region at point. This command offers possible locations for refiling the entry and lets you select one with completion. The item (or all items in the region) is filed below the target heading as a subitem. @@ -7404,6 +7407,10 @@ Use the refile interface to jump to a heading. Jump to the location where @code{org-refile} last moved a tree to. @item C-2 C-c C-w Refile as the child of the item currently being clocked. +@item C-3 C-c C-w +Refile and keep the entry in place. Also see @code{org-refile-keep} to make +this the default behavior, and beware that this may result in duplicated +@code{ID} properties. @orgcmdtkc{C-0 C-c C-w @ @r{or} @ C-u C-u C-u C-c C-w,C-0 C-c C-w,org-refile-cache-clear} Clear the target cache. Caching of refile targets can be turned on by setting @code{org-refile-use-cache}. To make the command see new possible @@ -8049,15 +8056,18 @@ You may also test for properties (@pxref{Properties and Columns}) at the same time as matching tags. The properties may be real properties, or special properties that represent other metadata (@pxref{Special properties}). For example, the ``property'' @code{TODO} represents the TODO keyword of the -entry. Or, the ``property'' @code{LEVEL} represents the level of an entry. -So a search @samp{+LEVEL=3+boss-TODO="DONE"} lists all level three headlines -that have the tag @samp{boss} and are @emph{not} marked with the TODO keyword -DONE@. In buffers with @code{org-odd-levels-only} set, @samp{LEVEL} does not -count the number of stars, but @samp{LEVEL=2} will correspond to 3 stars etc. -The ITEM special property cannot currently be used in tags/property +entry and the ``propety'' @code{PRIORITY} represents the PRIORITY keyword of +the entry. The ITEM special property cannot currently be used in tags/property searches@footnote{But @pxref{x-agenda-skip-entry-regexp, ,skipping entries based on regexp}.}. +Except the @pxref{Special properties}, one other ``property'' can also be +used. @code{LEVEL} represents the level of an entry. So a search +@samp{+LEVEL=3+boss-TODO="DONE"} lists all level three headlines that have +the tag @samp{boss} and are @emph{not} marked with the TODO keyword DONE@. +In buffers with @code{org-odd-levels-only} set, @samp{LEVEL} does not count +the number of stars, but @samp{LEVEL=2} will correspond to 3 stars etc. + Here are more examples: @table @samp @@ -10006,7 +10016,7 @@ Conversely, backslash characters before a comma, and only them, need to be escaped with another backslash character.}. In addition to defined macros, @code{@{@{@{title@}@}@}}, @code{@{@{@{author@}@}@}}, etc., will reference information set by the @code{#+TITLE:}, @code{#+AUTHOR:}, and similar lines. -Also, @code{@{@{@{date(@var{FORMAT})@}@}@}} and +Also, @code{@{@{@{time(@var{FORMAT})@}@}@}} and @code{@{@{@{modification-time(@var{FORMAT})@}@}@}} refer to current date time and to the modification time of the file being exported, respectively. @var{FORMAT} should be a format string understood by @@ -10146,10 +10156,10 @@ snippets will be identified as @LaTeX{} source code: @item Environments of any kind@footnote{When @file{MathJax} is used, only the environments recognized by @file{MathJax} will be processed. When -@file{dvipng} is used to create images, any @LaTeX{} environment will be -handled.}. The only requirement is that the @code{\begin} and @code{\end} -statements appear on a new line, at the beginning of the line or after -whitespaces only. +@file{dvipng} program or @file{imagemagick} suite is used to create images, +any @LaTeX{} environment will be handled.}. The only requirement is that the +@code{\begin} and @code{\end} statements appear on a new line, at the +beginning of the line or after whitespaces only. @item Text within the usual @LaTeX{} math delimiters. To avoid conflicts with currency specifications, single @samp{$} characters are only recognized as @@ -10187,7 +10197,6 @@ lines: @example #+OPTIONS: tex:t @r{Do the right thing automatically (MathJax)} -#+OPTIONS: tex:dvipng @r{Force using dvipng images} #+OPTIONS: tex:nil @r{Do not process @LaTeX{} fragments at all} #+OPTIONS: tex:verbatim @r{Verbatim export, for jsMath or so} @end example @@ -11247,6 +11256,7 @@ You could use @code{http} addresses just as well. @subsection Math formatting in HTML export @cindex MathJax @cindex dvipng +@cindex imagemagick @LaTeX{} math snippets (@pxref{@LaTeX{} fragments}) can be displayed in two different ways on HTML pages. The default is to use the @@ -11272,13 +11282,19 @@ this line. If you prefer, you can also request that @LaTeX{} fragments are processed into small images that will be inserted into the browser page. Before the availability of MathJax, this was the default method for Org files. This -method requires that the @file{dvipng} program is available on your system. -You can still get this processing with +method requires that the @file{dvipng} program or @file{imagemagick} suite is +available on your system. You can still get this processing with @example #+OPTIONS: tex:dvipng @end example +or: + +@example +#+OPTIONS: tex:imagemagick +@end example + @node Text areas in HTML export, CSS support, Math formatting in HTML export, HTML export @subsection Text areas in HTML export @@ -11335,6 +11351,9 @@ p.creator @r{creator info, about org mode version} div.outline-N @r{div for outline level N (headline plus text))} div.outline-text-N @r{extra div for text at outline level N} .section-number-N @r{section number in headlines, different for each level} +.figure-number @r{label like "Figure 1:"} +.table-number @r{label like "Table 1:"} +.listing-number @r{label like "Listing 1:"} div.figure @r{how to format an inlined image} pre.src @r{formatted source code} pre.example @r{normal example} @@ -11599,6 +11618,11 @@ Environment used for the table. It can be set to any @LaTeX{} table environment, like @code{tabularx}, @code{longtable}, @code{array}, @code{tabu}, @code{bmatrix}@enddots{} It defaults to @code{org-latex-default-table-environment} value. +@item :caption +@code{#+CAPTION} keyword is the simplest way to set a caption for a table +(@pxref{Images and tables}). If you need more advanced commands for that +task, you can use @code{:caption} attribute instead. Its value should be raw +@LaTeX{} code. It has precedence over @code{#+CAPTION}. @item :float @itemx :placement Float environment for the table. Possible values are @code{sidewaystable}, @@ -11651,6 +11675,16 @@ a table that will span over multiple pages, or a matrix product: | 3 | 4 | @end example +In the example below, @LaTeX{} command +@code{\bicaption@{HeadingA@}@{HeadingB@}} will set the caption. + +@example +#+ATTR_LATEX: :caption \bicaption@{HeadingA@}@{HeadingB@} +| ..... | ..... | +| ..... | ..... | +@end example + + @subsubheading Images in @LaTeX{} export @cindex images, inline in @LaTeX{} @cindex inlining images in @LaTeX{} @@ -11672,6 +11706,14 @@ example: [[./img/sed-hr4049.pdf]] @end example +If you need a specific command for the caption, use @code{:caption} +attribute. It will override standard @code{#+CAPTION} value, if any. + +@example +#+ATTR_LATEX: :caption \bicaption@{HeadingA@}@{HeadingB@} +[[./img/sed-hr4049.pdf]] +@end example + If you have specified a caption as described in @ref{Images and tables}, the picture will be wrapped into a @code{figure} environment and thus become a floating element. You can also ask Org to export an image as a float @@ -11768,6 +11810,17 @@ Therefore, any even number greater than 2 is the sum of two primes. \end@{proof@} @end example +If you need to insert a specific caption command, use @code{:caption} +attribute. It will override standard @code{#+CAPTION} value, if any. For +example: + +@example +#+ATTR_LATEX: :caption \MyCaption@{HeadingA@} +#+BEGIN_PROOF +... +#+END_PROOF +@end example + @subsubheading Horizontal rules @cindex horizontal rules, in @LaTeX{} export @@ -12218,17 +12271,25 @@ and open the formula file with the system-registered application. @end table @cindex dvipng +@cindex imagemagick @item PNG images This option is activated on a per-file basis with @example -#+OPTIONS: LaTeX:dvipng +#+OPTIONS: tex:dvipng +@end example + +or: + +@example +#+OPTIONS: tex:imagemagick @end example With this option, @LaTeX{} fragments are processed into PNG images and the resulting images are embedded in the exported document. This method requires -that the @file{dvipng} program be available on your system. +that the @file{dvipng} program or @file{imagemagick} suite be available on +your system. @end enumerate @node Working with MathML or OpenDocument formula files, , Working with @LaTeX{} math snippets, Math formatting in ODT export @@ -12957,7 +13018,7 @@ the Org buffer and get them translated into @LaTeX{} without using the @end group @end lisp -Three arguments must be provided to a fiter: the code being changed, the +Three arguments must be provided to a filter: the code being changed, the back-end used, and some information about the export process. You can safely ignore the third argument for most purposes. Note the use of @code{org-export-derived-backend-p}, which ensures that the filter will only @@ -13260,8 +13321,8 @@ string of these options for details. @vindex org-html-preamble @vindex org-html-postamble @vindex org-html-table-default-attributes -@vindex org-html-style-include-default -@vindex org-html-style-include-scripts +@vindex org-html-head-include-default-style +@vindex org-html-head-include-scripts @multitable @columnfractions 0.32 0.68 @item @code{:html-doctype} @tab @code{org-html-doctype} @item @code{:html-xml-declaration} @tab @code{org-html-xml-declaration} @@ -13275,8 +13336,8 @@ string of these options for details. @item @code{:html-preamble} @tab @code{org-html-preamble} @item @code{:html-postamble} @tab @code{org-html-postamble} @item @code{:html-table-attributes} @tab @code{org-html-table-default-attributes} -@item @code{:html-head-include-default-style} @tab @code{org-html-style-include-default} -@item @code{:html-head-include-scripts} @tab @code{org-html-style-include-scripts} +@item @code{:html-head-include-default-style} @tab @code{org-html-head-include-default-style} +@item @code{:html-head-include-scripts} @tab @code{org-html-head-include-scripts} @end multitable Most of the @code{org-export-with-*} variables have the same effect in each @@ -14809,7 +14870,7 @@ 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. +references will 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. @@ -15185,7 +15246,7 @@ argument. @end example @node prologue, epilogue, post, Specific header arguments - +@subsubsection @code{:prologue} The value of the @code{prologue} header argument will be prepended to the code block body before execution. For example, @code{:prologue "reset"} may be used to reset a gnuplot session before execution of a particular code @@ -15198,7 +15259,7 @@ code blocks. Also see @ref{epilogue}. @end lisp @node epilogue, , prologue, Specific header arguments - +@subsubsection @code{:epilogue} The value of the @code{epilogue} header argument will be appended to the code block body before execution. Also see @ref{prologue}. diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 2c6afd818..74d7513df 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -93,8 +93,13 @@ inside (list "dev.off()")) inside)) - (append (org-babel-variable-assignments:R params) - (list body))) "\n"))) + (append + (when (cdr (assoc :prologue params)) + (list (cdr (assoc :prologue params)))) + (org-babel-variable-assignments:R params) + (list body) + (when (cdr (assoc :epilogue params)) + (list (cdr (assoc :epilogue params)))))) "\n"))) (defun org-babel-execute:R (body params) "Execute a block of R code. diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 79df71fe2..b213c2a48 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -301,10 +301,10 @@ name of the code block." (noeval (or ,eval-no ,eval-no-export)) (query (or (equal ,eval "query") (and ,export (equal ,eval "query-export")) - (when (functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate - ,lang ,block-body)) - org-confirm-babel-evaluate)) + (if (functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + ,lang ,block-body) + org-confirm-babel-evaluate))) (code-block (if ,info (format " %s " ,lang) " ")) (block-name (if ,name (format " (%s) " ,name) " "))) ,@body))) @@ -562,7 +562,11 @@ Optionally supply a value for PARAMS which will be merged with the header arguments specified at the front of the source code block." (interactive) - (let* ((info (if info + (let* ((org-babel-current-src-block-location + (or org-babel-current-src-block-location + (nth 6 info) + (org-babel-where-is-src-block-head))) + (info (if info (copy-tree info) (org-babel-get-src-block-info))) (merged-params (org-babel-merge-params (nth 2 info) params))) @@ -571,8 +575,6 @@ block." (let* ((params (if params (org-babel-process-params merged-params) (nth 2 info))) - (org-babel-current-src-block-location - (or org-babel-current-src-block-location (nth 6 info))) (cachep (and (not arg) (cdr (assoc :cache params)) (string= "yes" (cdr (assoc :cache params))))) (new-hash (when cachep (org-babel-sha1-hash info))) @@ -1167,9 +1169,12 @@ the current subtree." (defun org-babel-set-current-result-hash (hash) "Set the current in-buffer hash to HASH." (org-babel-where-is-src-block-result) - (save-excursion (goto-char (match-beginning 3)) - ;; (mapc #'delete-overlay (overlays-at (point))) - (replace-match hash nil nil nil 3) + (save-excursion (goto-char (match-beginning 5)) + (mapc #'delete-overlay (overlays-at (point))) + (forward-char org-babel-hash-show) + (mapc #'delete-overlay (overlays-at (point))) + (replace-match hash nil nil nil 5) + (goto-char (point-at-bol)) (org-babel-hide-hash))) (defun org-babel-hide-hash () @@ -1511,22 +1516,18 @@ names." (defun org-babel-get-rownames (table) "Return the row names of TABLE. Return a cons cell, the `car' of which contains the TABLE less -colnames, and the `cdr' of which contains a list of the column -names. Note: this function removes any hlines in TABLE." - (let* ((trans (lambda (table) (apply #'mapcar* #'list table))) - (width (apply 'max - (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) - (table (funcall trans (mapcar (lambda (row) - (if (not (equal row 'hline)) - row - (setq row '()) - (dotimes (n width) - (setq row (cons 'hline row))) - row)) - table)))) - (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row)) - (funcall trans (cdr table))) - (remove 'hline (car table))))) +rownames, and the `cdr' of which contains a list of the rownames. +Note: this function removes any hlines in TABLE." + (let* ((table (org-babel-del-hlines table)) + (rownames (funcall (lambda () + (let ((tp table)) + (mapcar + (lambda (row) + (prog1 + (pop (car tp)) + (setq tp (cdr tp)))) + table)))))) + (cons table rownames))) (defun org-babel-put-colnames (table colnames) "Add COLNAMES to TABLE if they exist." @@ -1719,7 +1720,8 @@ buffer or nil if no such result exists." (when (and (string= "name" (downcase (match-string 1))) (or (beginning-of-line 1) (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp))) + (looking-at org-babel-multi-line-header-regexp) + (looking-at org-babel-lob-one-liner-regexp))) (throw 'is-a-code-block (org-babel-find-named-result name (point)))) (beginning-of-line 0) (point)))))) @@ -1796,9 +1798,13 @@ region is not active then the point is demarcated." (move-end-of-line 2)) (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) (let ((start (point)) - (lang (org-icompleting-read "Lang: " - (mapcar (lambda (el) (symbol-name (car el))) - org-babel-load-languages))) + (lang (org-icompleting-read + "Lang: " + (mapcar #'symbol-name + (delete-dups + (append (mapcar #'car org-babel-load-languages) + (mapcar (lambda (el) (intern (car el))) + org-src-lang-modes)))))) (body (delete-and-extract-region (if (org-region-active-p) (mark) (point)) (point)))) (insert (concat (if (looking-at "^") "" "\n") @@ -1824,10 +1830,7 @@ following the source block." (looking-at org-babel-lob-one-liner-regexp))) (inlinep (when (org-babel-get-inline-src-block-matches) (match-end 0))) - (name (if on-lob-line - (mapconcat #'identity (butlast (org-babel-lob-get-info)) - "") - (nth 4 (or info (org-babel-get-src-block-info 'light))))) + (name (nth 4 (or info (org-babel-get-src-block-info 'light)))) (head (unless on-lob-line (org-babel-where-is-src-block-head))) found beg end) (when head (goto-char head)) diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index d3d76e57a..60ab8c598 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -58,6 +58,11 @@ :group 'org-babel :type 'string) +(defcustom org-babel-ditaa-java-cmd "java" + "Java executable to use when evaluating ditaa blocks." + :group 'org-babel + :type 'string) + (defcustom org-ditaa-eps-jar-path (expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path)) "Path to the DitaaEps.jar executable." @@ -86,7 +91,8 @@ This function is called by `org-babel-execute-src-block'." (java (cdr (assoc :java params))) (in-file (org-babel-temp-file "ditaa-")) (eps (cdr (assoc :eps params))) - (cmd (concat "java " java " " org-ditaa-jar-option " " + (cmd (concat org-babel-ditaa-java-cmd + " " java " " org-ditaa-jar-option " " (shell-quote-argument (expand-file-name (if eps org-ditaa-eps-jar-path org-ditaa-jar-path))) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 12aa380d2..c8479e36d 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -217,9 +217,9 @@ this template." (concat ":var results=" (mapconcat 'identity - (butlast lob-info) + (butlast lob-info 2) " "))))))) - "" nil (car (last lob-info))) + "" (nth 3 lob-info) (nth 2 lob-info)) 'lob)) (rep (org-fill-template org-babel-exp-call-line-template diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index 94d513321..f9216e10c 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -50,6 +50,17 @@ '((:results . "latex") (:exports . "results")) "Default arguments to use when evaluating a LaTeX source block.") +(defcustom org-babel-latex-htlatex nil + "The htlatex command to enable conversion of latex to SVG or HTML." + :group 'org-babel + :type 'string) + +(defcustom org-babel-latex-htlatex-packages + '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}") + "Packages to use for htlatex export." + :group 'org-babel + :type '(list string)) + (defun org-babel-expand-body:latex (body params) "Expand BODY according to PARAMS, return the expanded body." (mapc (lambda (pair) ;; replace variables @@ -84,7 +95,11 @@ This function is called by `org-babel-execute-src-block'." ((and (string-match "\\.png$" out-file) (not imagemagick)) (org-create-formula-image body out-file org-format-latex-options in-buffer)) - ((or (string-match "\\.pdf$" out-file) imagemagick) + ((string-match "\\.tikz$" out-file) + (when (file-exists-p out-file) (delete-file out-file)) + (with-temp-file out-file + (insert body))) + ((or (string-match "\\.pdf$" out-file) imagemagick) (with-temp-file tex-file (require 'ox-latex) (insert @@ -124,6 +139,39 @@ This function is called by `org-babel-execute-src-block'." transient-pdf-file out-file im-in-options im-out-options) (when (file-exists-p transient-pdf-file) (delete-file transient-pdf-file)))))) + ((and (or (string-match "\\.svg$" out-file) + (string-match "\\.html$" out-file)) + org-babel-latex-htlatex) + (with-temp-file tex-file + (insert (concat + "\\documentclass[preview]{standalone} +\\def\\pgfsysdriver{pgfsys-tex4ht.def} +" + (mapconcat (lambda (pkg) + (concat "\\usepackage" pkg)) + org-babel-latex-htlatex-packages + "\n") + "\\begin{document}" + body + "\\end{document}"))) + (when (file-exists-p out-file) (delete-file out-file)) + (let ((default-directory (file-name-directory tex-file))) + (shell-command (format "%s %s" org-babel-latex-htlatex tex-file))) + (cond + ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg")) + (if (string-match "\\.svg$" out-file) + (progn + (shell-command "pwd") + (shell-command (format "mv %s %s" + (concat (file-name-sans-extension tex-file) "-1.svg") + out-file))) + (error "SVG file produced but HTML file requested."))) + ((file-exists-p (concat (file-name-sans-extension tex-file) ".html")) + (if (string-match "\\.html$" out-file) + (shell-command "mv %s %s" + (concat (file-name-base tex-file) ".html") + out-file) + (error "HTML file produced but SVG file requested."))))) ((string-match "\\.\\([^\\.]+\\)$" out-file) (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" (match-string 1 out-file)))) diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index f9b7b4cfb..d37940a18 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -114,12 +114,20 @@ if so then run the appropriate source block from the Library." (or (funcall nonempty 8 19) "")) (funcall nonempty 9 18))) (list (length (if (= (length (match-string 12)) 0) - (match-string 2) (match-string 11))))))))) + (match-string 2) (match-string 11))) + (save-excursion + (forward-line -1) + (and (looking-at (concat org-babel-src-name-regexp + "\\([^\n]*\\)$")) + (org-no-properties (match-string 1)))))))))) (defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el (defun org-babel-lob-execute (info) "Execute the lob call specified by INFO." - (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info)))) + (let* ((mkinfo (lambda (p) + (list "emacs-lisp" "results" p nil + (nth 3 info) ;; name + (nth 2 info)))) (pre-params (apply #'org-babel-merge-params org-babel-default-header-args org-babel-default-header-args:emacs-lisp @@ -130,7 +138,7 @@ if so then run the appropriate source block from the Library." (org-no-properties (concat ":var results=" - (mapconcat #'identity (butlast info) + (mapconcat #'identity (butlast info 2) " ")))))))) (pre-info (funcall mkinfo pre-params)) (cache-p (and (cdr (assoc :cache pre-params)) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index a2814eae3..5a3c8ba2e 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -83,7 +83,10 @@ the variable." (let ((var (match-string 1 assignment)) (ref (match-string 2 assignment))) (cons (intern var) - (let ((out (org-babel-read ref))) + (let ((out (save-excursion + (when org-babel-current-src-block-location + (goto-char org-babel-current-src-block-location)) + (org-babel-read ref)))) (if (equal out ref) (if (string-match "^\".*\"$" ref) (read ref) diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index 89dd00331..f979640a5 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2010-2013 Free Software Foundation, Inc. -;; Author: Eric Schulte +;; Authors: Eric Schulte, Michael Gauland ;; Keywords: literate programming, reproducible research, scheme ;; Homepage: http://orgmode.org @@ -33,27 +33,25 @@ ;; - a working scheme implementation ;; (e.g. guile http://www.gnu.org/software/guile/guile.html) ;; -;; - for session based evaluation cmuscheme.el is required which is -;; included in Emacs +;; - for session based evaluation geiser is required, which is available from +;; ELPA. ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) +(require 'geiser nil t) +(defvar geiser-repl--repl) ; Defined in geiser-repl.el +(defvar geiser-impl--implementation) ; Defined in geiser-impl.el +(defvar geiser-default-implementation) ; Defined in geiser-impl.el +(defvar geiser-active-implementations) ; Defined in geiser-impl.el -(declare-function run-scheme "ext:cmuscheme" (cmd)) +(declare-function run-geiser "geiser-repl" (impl)) +(declare-function geiser-mode "geiser-mode" ()) +(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg)) +(declare-function geiser-repl-exit "geiser-repl" (&optional arg)) (defvar org-babel-default-header-args:scheme '() "Default header arguments for scheme code blocks.") -(defvar org-babel-scheme-eoe "org-babel-scheme-eoe" - "String to indicate that evaluation has completed.") - -(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) "Expand BODY according to PARAMS, return the expanded body." (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) @@ -65,72 +63,127 @@ ")\n" body ")") body))) -(defvar scheme-program-name) + +(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal) + "Map of scheme sessions to session names.") + +(defun org-babel-scheme-cleanse-repl-map () + "Remove dead buffers from the REPL map." + (maphash + (lambda (x y) + (when (not (buffer-name y)) + (remhash x org-babel-scheme-repl-map))) + org-babel-scheme-repl-map)) + +(defun org-babel-scheme-get-session-buffer (session-name) + "Look up the scheme buffer for a session; return nil if it doesn't exist." + (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions + (gethash session-name org-babel-scheme-repl-map)) + +(defun org-babel-scheme-set-session-buffer (session-name buffer) + "Record the scheme buffer used for a given session." + (puthash session-name buffer org-babel-scheme-repl-map)) + +(defun org-babel-scheme-get-buffer-impl (buffer) + "Returns the scheme implementation geiser associates with the buffer." + (with-current-buffer (set-buffer buffer) + geiser-impl--implementation)) + +(defun org-babel-scheme-get-repl (impl name) + "Switch to a scheme REPL, creating it if it doesn't exist:" + (let ((buffer (org-babel-scheme-get-session-buffer name))) + (or buffer + (progn + (run-geiser impl) + (if name + (progn + (rename-buffer name t) + (org-babel-scheme-set-session-buffer name (current-buffer)))) + (current-buffer))))) + +(defun org-babel-scheme-make-session-name (buffer name impl) + "Generate a name for the session buffer. + +For a named session, the buffer name will be the session name. + +If the session is unnamed (nil), generate a name. + +If the session is 'none', use nil for the session name, and +org-babel-scheme-execute-with-geiser will use a temporary session." + (let ((result + (cond ((not name) + (concat buffer " " (symbol-name impl) " REPL")) + ((string= name "none") nil) + (name)))) + result)) + +(defun org-babel-scheme-execute-with-geiser (code output impl repl) + "Execute code in specified REPL. If the REPL doesn't exist, create it +using the given scheme implementation. + +Returns the output of executing the code if the output parameter +is true; otherwise returns the last value." + (let ((result nil)) + (with-temp-buffer + (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) + (newline) + (insert (if output + (format "(with-output-to-string (lambda () %s))" code) + code)) + (geiser-mode) + (let ((repl-buffer (save-current-buffer + (org-babel-scheme-get-repl impl repl)))) + (when (not (eq impl (org-babel-scheme-get-buffer-impl + (current-buffer)))) + (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) + (org-babel-scheme-get-buffer-impl (current-buffer)) + (symbolp (org-babel-scheme-get-buffer-impl + (current-buffer))))) + (setq geiser-repl--repl repl-buffer) + (setq geiser-impl--implementation nil) + (geiser-eval-region (point-min) (point-max)) + (setq result + (if (equal (substring (current-message) 0 3) "=> ") + (replace-regexp-in-string "^=> " "" (current-message)) + "\"An error occurred.\"")) + (when (not repl) + (save-current-buffer (set-buffer repl-buffer) + (geiser-repl-exit)) + (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) + (kill-buffer repl-buffer)) + (setq result (if (or (string= result "#") + (string= result "#")) + nil + (read result))))) + result)) + (defun org-babel-execute:scheme (body params) "Execute a block of Scheme code with org-babel. This function is called by `org-babel-execute-src-block'" - (let* ((result-type (cdr (assoc :result-type params))) - (org-babel-scheme-cmd (or (cdr (assoc :scheme params)) - org-babel-scheme-cmd)) - (full-body (org-babel-expand-body:scheme body params)) - (result (if (not (string= (cdr (assoc :session params)) "none")) - ;; session evaluation - (let ((session (org-babel-prep-session:scheme - (cdr (assoc :session params)) params))) - (org-babel-comint-with-output - (session (format "%S" org-babel-scheme-eoe) t body) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) - (comint-send-input nil t)) - (list body (format "%S" org-babel-scheme-eoe))))) - ;; external evaluation - (let ((script-file (org-babel-temp-file "scheme-script-"))) - (with-temp-file script-file - (insert - ;; return the value or the output - (if (string= result-type "value") - (format "(display %s)" full-body) - full-body))) - (org-babel-eval - (format "%s %s" org-babel-scheme-cmd - (org-babel-process-file-name script-file)) ""))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - result (read result)))) - -(defun org-babel-prep-session:scheme (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (org-babel-scheme-initiate-session session)) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (var-lines - (mapcar - (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var))))) - vars))) - (when session - (org-babel-comint-in-buffer session - (sit-for .5) (goto-char (point-max)) - (mapc (lambda (var) - (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) (goto-char (point-max))) var-lines))) - session)) - -(defun org-babel-scheme-initiate-session (&optional session) - "If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session." - (require 'cmuscheme) - (unless (string= session "none") - (let ((session-buffer (save-window-excursion - (run-scheme org-babel-scheme-cmd) - (rename-buffer session) - (current-buffer)))) - (if (org-babel-comint-buffer-livep session-buffer) - (progn (sit-for .25) session-buffer) - (sit-for .5) - (org-babel-scheme-initiate-session session))))) + (let* ((source-buffer (current-buffer)) + (source-buffer-name (replace-regexp-in-string ;; zap surrounding * + "^ ?\\*\\([^*]+\\)\\*" "\\1" + (buffer-name source-buffer)))) + (save-excursion + (org-babel-reassemble-table + (let* ((result-type (cdr (assoc :result-type params))) + (impl (or (when (cdr (assoc :scheme params)) + (intern (cdr (assoc :scheme params)))) + geiser-default-implementation + (car geiser-active-implementations))) + (session (org-babel-scheme-make-session-name + source-buffer-name (cdr (assoc :session params)) impl)) + (full-body (org-babel-expand-body:scheme body params))) + (org-babel-scheme-execute-with-geiser + full-body ; code + (string= result-type "output") ; output? + impl ; implementation + (and (not (string= session "none")) session))) ; session + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))))) (provide 'ob-scheme) - - ;;; ob-scheme.el ends here diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el index 7eda1b5ef..ec1306b3b 100644 --- a/lisp/ob-sh.el +++ b/lisp/ob-sh.el @@ -106,7 +106,7 @@ var of the same value." "Convert an elisp value to a string." (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) (cond - ((and (listp var) (or (listp (car var)) 'hline)) + ((and (listp var) (or (listp (car var)) (equal (car var) 'hline))) (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) ((listp var) (mapconcat echo-var var "\n")) diff --git a/lisp/ob-table.el b/lisp/ob-table.el index 869d99206..8b3e36d73 100644 --- a/lisp/ob-table.el +++ b/lisp/ob-table.el @@ -97,9 +97,11 @@ as shown in the example below. (lambda (el) (if (eq '$ el) (prog1 nil (setq quote t)) - (prog1 (if quote - (format "\"%s\"" el) - (org-no-properties el)) + (prog1 + (cond + (quote (format "\"%s\"" el)) + ((stringp el) (org-no-properties el)) + (t el)) (setq quote nil)))) (cdr var))))) variables))) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index c615b5819..c48da911c 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -3130,9 +3130,10 @@ longer string it is used as a tags/todo match string. Parameters are alternating variable names and values that will be bound before running the agenda command." (org-eval-in-environment (org-make-parameter-alist parameters) - (if (> (length cmd-key) 2) - (org-tags-view nil cmd-key) - (org-agenda nil cmd-key))) + (let (org-agenda-sticky) + (if (> (length cmd-key) 2) + (org-tags-view nil cmd-key) + (org-agenda nil cmd-key)))) (set-buffer org-agenda-buffer-name) (princ (buffer-string))) @@ -3879,7 +3880,7 @@ continue from there." (throw :skip t)))) (defun org-agenda-skip-eval (form) - "If FORM is a function or a list, call (or eval) is and return result. + "If FORM is a function or a list, call (or eval) it and return the result. `save-excursion' and `save-match-data' are wrapped around the call, so point and match data are returned to the previous state no matter what these functions do." @@ -7308,12 +7309,15 @@ The category is that of the current line." org-agenda-category-filter) (org-agenda-filter-show-all-cat) (let ((cat (org-no-properties (get-text-property (point) 'org-category)))) - (if (and cat (not (string= "" cat))) - (org-agenda-filter-apply - (setq org-agenda-category-filter - (list (concat (if strip "-" "+") cat))) - 'category) - (error "No category at point"))))) + (cond + ((and cat strip) + (org-agenda-filter-apply + (push (concat "-" cat) org-agenda-category-filter) 'category)) + ((and cat) + (org-agenda-filter-apply + (setq org-agenda-category-filter + (list (concat "+" cat))) 'category)) + ((error "No category at point")))))) (defun org-find-top-headline (&optional pos) "Find the topmost parent headline and return it." @@ -8375,7 +8379,7 @@ Point is in the buffer where the item originated.") (if (and confirm (not (y-or-n-p "Archive this subtree or entry? "))) (error "Abort") - (save-excursion + (save-window-excursion (goto-char pos) (let ((org-agenda-buffer-name bufname-orig)) (org-remove-subtree-entries-from-agenda)) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 936883acb..a4f0fd07e 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -909,7 +909,8 @@ Store them in the capture property list." (current-time)))) (org-capture-put :default-time - (cond ((and (not org-time-was-given) + (cond ((and (or (not (boundp 'org-time-was-given)) + (not org-time-was-given)) (not (= (time-to-days prompt-time) (org-today)))) ;; Use 00:00 when no time is given for another date than today? (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time))))) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index a98deecca..f3b8e4291 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -169,8 +169,10 @@ This is the compiled version of the format.") (get-text-property (point-at-bol) 'face)) 'default)) (color (list :foreground (face-attribute ref-face :foreground))) - (face (list color 'org-column ref-face)) - (face1 (list color 'org-agenda-column-dateline ref-face)) + (font (list :height (face-attribute 'default :height) + :family (face-attribute 'default :family))) + (face (list color font 'org-column ref-face)) + (face1 (list color font 'org-agenda-column-dateline ref-face)) (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) pom property ass width f string ov column val modval s2 title calc) ;; Check if the entry is in another buffer. diff --git a/lisp/org-element.el b/lisp/org-element.el index a1ca6e1a4..0a3f5f602 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -1119,7 +1119,11 @@ Assume point is at the beginning of the item." (defun org-element-item-interpreter (item contents) "Interpret ITEM element as Org syntax. CONTENTS is the contents of the element." - (let* ((bullet (org-list-bullet-string (org-element-property :bullet item))) + (let* ((bullet (let ((bullet (org-element-property :bullet item))) + (org-list-bullet-string + (cond ((not (string-match "[0-9a-zA-Z]" bullet)) "- ") + ((eq org-plain-list-ordered-item-terminator ?\)) "1)") + (t "1."))))) (checkbox (org-element-property :checkbox item)) (counter (org-element-property :counter item)) (tag (let ((tag (org-element-property :tag item))) @@ -1138,10 +1142,11 @@ CONTENTS is the contents of the element." (off "[ ] ") (trans "[-] ")) (and tag (format "%s :: " tag)) - (let ((contents (replace-regexp-in-string - "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) - (if item-starts-with-par-p (org-trim contents) - (concat "\n" contents)))))) + (when contents + (let ((contents (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) + (if item-starts-with-par-p (org-trim contents) + (concat "\n" contents))))))) ;;;; Plain List @@ -1256,8 +1261,7 @@ Assume point is at the beginning of the list." (unless (bolp) (forward-line)) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (= (point) limit) limit (line-beginning-position))))) ;; Return value. (list 'plain-list (nconc @@ -3130,42 +3134,42 @@ Assume point is at the beginning of the link." ;; abbreviation in it. raw-link (org-translate-link (org-link-expand-abbrev - (org-match-string-no-properties 1))) - link (org-link-unescape raw-link)) + (org-match-string-no-properties 1)))) ;; Determine TYPE of link and set PATH accordingly. (cond ;; File type. - ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link)) - (setq type "file" path link)) + ((or (file-name-absolute-p raw-link) + (string-match "^\\.\\.?/" raw-link)) + (setq type "file" path raw-link)) ;; Explicit type (http, irc, bbdb...). See `org-link-types'. - ((string-match org-link-re-with-space3 link) - (setq type (match-string 1 link) path (match-string 2 link))) + ((string-match org-link-re-with-space3 raw-link) + (setq type (match-string 1 raw-link) path (match-string 2 raw-link))) ;; Id type: PATH is the id. - ((string-match "^id:\\([-a-f0-9]+\\)" link) - (setq type "id" path (match-string 1 link))) + ((string-match "^id:\\([-a-f0-9]+\\)" raw-link) + (setq type "id" path (match-string 1 raw-link))) ;; Code-ref type: PATH is the name of the reference. - ((string-match "^(\\(.*\\))$" link) - (setq type "coderef" path (match-string 1 link))) + ((string-match "^(\\(.*\\))$" raw-link) + (setq type "coderef" path (match-string 1 raw-link))) ;; Custom-id type: PATH is the name of the custom id. - ((= (aref link 0) ?#) - (setq type "custom-id" path (substring link 1))) + ((= (aref raw-link 0) ?#) + (setq type "custom-id" path (substring raw-link 1))) ;; Fuzzy type: Internal link either matches a target, an ;; headline name or nothing. PATH is the target or ;; headline's name. - (t (setq type "fuzzy" path link)))) + (t (setq type "fuzzy" path raw-link)))) ;; Type 3: Plain link, i.e. http://orgmode.org ((looking-at org-plain-link-re) (setq raw-link (org-match-string-no-properties 0) type (org-match-string-no-properties 1) - path (org-match-string-no-properties 2) - link-end (match-end 0))) + link-end (match-end 0) + path (org-match-string-no-properties 2))) ;; Type 4: Angular link, i.e. ((looking-at org-angle-link-re) (setq raw-link (buffer-substring-no-properties (match-beginning 1) (match-end 2)) type (org-match-string-no-properties 1) - path (org-match-string-no-properties 2) - link-end (match-end 0)))) + link-end (match-end 0) + path (org-match-string-no-properties 2)))) ;; In any case, deduce end point after trailing white space from ;; LINK-END variable. (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) @@ -3182,7 +3186,7 @@ Assume point is at the beginning of the link." (when (string-match "::\\(.*\\)$" path) (setq search-option (match-string 1 path) path (replace-match "" nil nil path))) - ;; Make sure TYPE always report "file". + ;; Make sure TYPE always reports "file". (setq type "file")) (list 'link (list :type type @@ -3900,7 +3904,7 @@ element it has to parse." (cond ;; Jumping over affiliated keywords put point off-limits. ;; Parse them as regular keywords. - ((>= (point) limit) + ((and (cdr affiliated) (>= (point) limit)) (goto-char (car affiliated)) (org-element-keyword-parser limit nil)) ;; LaTeX Environment. diff --git a/lisp/org-faces.el b/lisp/org-faces.el index 54729649d..e96865732 100644 --- a/lisp/org-faces.el +++ b/lisp/org-faces.el @@ -217,12 +217,6 @@ column view defines special faces for each outline level. See the file "Face for column display of entry properties." :group 'org-faces) -(when (fboundp 'set-face-attribute) - ;; Make sure that a fixed-width face is used when we have a column table. - (set-face-attribute 'org-column nil - :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - (defface org-agenda-column-dateline (org-compatible-face 'org-column '((t nil))) diff --git a/lisp/org-list.el b/lisp/org-list.el index 86afe11cd..fab3a2ab8 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2799,13 +2799,14 @@ optional argument WITH-CASE, the sorting considers case as well. The command prompts for the sorting type unless it has been given to the function through the SORTING-TYPE argument, which needs to -be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise -meaning of each character: +be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the +detailed meaning of each character: n Numerically, by converting the beginning of the item to a number. a Alphabetically. Only the first line of item is checked. t By date/time, either the first active time stamp in the entry, if any, or by the first inactive one. In a timer list, sort the timers. +x By \"checked\" status of a check list. Capital letters will reverse the sort order. @@ -2827,7 +2828,7 @@ ignores hidden links." (or sorting-type (progn (message - "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") + "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:") (read-char-exclusive)))) (getkey-func (or getkey-func @@ -2844,7 +2845,8 @@ ignores hidden links." (sort-func (cond ((= dcst ?a) 'string<) ((= dcst ?f) compare-func) - ((= dcst ?t) '<))) + ((= dcst ?t) '<) + ((= dcst ?x) 'string<))) (next-record (lambda () (skip-chars-forward " \r\t\n") (or (eobp) (beginning-of-line)))) @@ -2875,6 +2877,9 @@ ignores hidden links." (point-at-eol) t))) (org-time-string-to-seconds (match-string 0))) (t (org-float-time now)))) + ((= dcst ?x) (or (and (stringp (match-string 1)) + (match-string 1)) + "")) ((= dcst ?f) (if getkey-func (let ((value (funcall getkey-func))) diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index fbdc7fb85..c8a6c86ca 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -656,11 +656,11 @@ This means, between the beginning of line and the point." ["All Clear" (org-mouse-for-each-item (lambda () (when (save-excursion (org-at-item-checkbox-p)) - (replace-match "[ ]"))))] + (replace-match "[ ] "))))] ["All Set" (org-mouse-for-each-item (lambda () (when (save-excursion (org-at-item-checkbox-p)) - (replace-match "[X]"))))] + (replace-match "[X] "))))] ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] ["All Remove" (org-mouse-for-each-item (lambda () diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index 77e2b3b43..4e8ba0ed6 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -153,13 +153,16 @@ When completing for #+STARTUP, for example, this function returns (mapcar (lambda (keyword) (concat keyword ": ")) org-element-affiliated-keywords) (let (block-names) - (mapc (lambda (block-name) - (let ((name (car block-name))) - (push (format "END_%s: " name) block-names) - (push (format "BEGIN_%s: " name) block-names) - (push (format "ATTR_%s: " name) block-names))) - org-element-block-name-alist) - block-names) + (dolist (block-info org-element-block-name-alist block-names) + (let ((name (car block-info))) + (push (format "END_%s" name) block-names) + (push (concat "BEGIN_" + name + ;; Since language is compulsory in + ;; source blocks, add a space. + (and (equal name "SRC") " ")) + block-names) + (push (format "ATTR_%s: " name) block-names)))) (mapcar (lambda (keyword) (concat keyword ": ")) (org-get-export-keywords)))) (substring pcomplete-stub 2))) @@ -254,6 +257,8 @@ When completing for #+STARTUP, for example, this function returns (file-name-nondirectory visited-file))) (buffer-name (buffer-base-buffer))))))) + +(declare-function org-export-backend-options "org-export" (cl-x)) (defun pcomplete/org-mode/file-option/options () "Complete arguments for the #+OPTIONS file option." (while (pcomplete-here @@ -266,9 +271,9 @@ When completing for #+STARTUP, for example, this function returns "|:" "tags:" "tasks:" "<:" "todo:") ;; OPTION items from registered back-ends. (let (items) - (dolist (back-end (org-bound-and-true-p - org-export-registered-backends)) - (dolist (option (plist-get (cdr back-end) :options-alist)) + (dolist (backend (org-bound-and-true-p + org-export--registered-backends)) + (dolist (option (org-export-backend-options backend)) (let ((item (nth 2 option))) (when item (push (concat item ":") items))))) items)))))) diff --git a/lisp/org-src.el b/lisp/org-src.el index 81b8e4053..0f881740b 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -179,7 +179,7 @@ but which mess up the display of a snippet in Org exported files.") (defcustom org-src-lang-modes '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) - ("calc" . fundamental) ("C" . c) ("cpp" . c++) + ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++) ("screen" . shell-script)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should diff --git a/lisp/org-table.el b/lisp/org-table.el index aec016508..c7e7eb867 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -1829,11 +1829,16 @@ will be transposed as Note that horizontal lines disappeared." (interactive) - (let ((contents - (apply #'mapcar* #'list - ;; remove 'hline from list - (delq nil (mapcar (lambda (x) (when (listp x) x)) - (org-table-to-lisp)))))) + (let* ((table (delete 'hline (org-table-to-lisp))) + (contents (mapcar (lambda (p) + (let ((tp table)) + (mapcar + (lambda (rown) + (prog1 + (pop (car tp)) + (setq tp (cdr tp)))) + table))) + (car table)))) (delete-region (org-table-begin) (org-table-end)) (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" )) contents "")) @@ -2064,7 +2069,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." h (floor (/ diff 3600)) diff (mod diff 3600) m (floor (/ diff 60)) diff (mod diff 60) s diff) - (format "%d:%02d:%02d" h m s)))) + (format "%.0f:%02.0f:%02.0f" h m s)))) (kill-new sres) (if (org-called-interactively-p 'interactive) (message "%s" diff --git a/lisp/org.el b/lisp/org.el index d0dffc70f..2f619cc77 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -436,8 +436,9 @@ For export specific modules, see also `org-export-backends'." (const :tag "C wl: Links to Wanderlust folders/messages" org-wl) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) -(defvar org-export-registered-backends) ; From ox.el +(defvar org-export--registered-backends) ; From ox.el. (declare-function org-export-derived-backend-p "ox" (backend &rest backends)) +(declare-function org-export-backend-name "ox" (backend)) (defcustom org-export-backends '(ascii html icalendar latex) "List of export back-ends that should be always available. @@ -451,30 +452,29 @@ needed. This variable needs to be set before org.el is loaded. If you need to make a change while Emacs is running, use the customize -interface or run the following code, where VALUE stands for the -new value of the variable, after updating it: +interface or run the following code, where VAL stands for the new +value of the variable, after updating it: \(progn - \(setq org-export-registered-backends + \(setq org-export--registered-backends \(org-remove-if-not \(lambda (backend) - \(or (memq backend val) - \(catch 'parentp - \(mapc - \(lambda (b) - \(and (org-export-derived-backend-p b (car backend)) - \(throw 'parentp t))) - val) - nil))) - org-export-registered-backends)) - \(let ((new-list (mapcar 'car org-export-registered-backends))) + \(let ((name (org-export-backend-name backend))) + \(or (memq name val) + \(catch 'parentp + \(dolist (b val) + \(and (org-export-derived-backend-p b name) + \(throw 'parentp t))))))) + org-export--registered-backends)) + \(let ((new-list (mapcar 'org-export-backend-name + org-export--registered-backends))) \(dolist (backend val) \(cond \((not (load (format \"ox-%s\" backend) t t)) \(message \"Problems while trying to load export back-end `%s'\" backend)) \((not (memq backend new-list)) (push backend new-list)))) - \(set-default var new-list))) + \(set-default 'org-export-backends new-list))) Adding a back-end to this list will also pull the back-end it depends on, if any." @@ -488,21 +488,20 @@ depends on, if any." ;; Any back-end not required anymore (not present in VAL and not ;; a parent of any back-end in the new value) is removed from the ;; list of registered back-ends. - (setq org-export-registered-backends + (setq org-export--registered-backends (org-remove-if-not (lambda (backend) - (or (memq backend val) - (catch 'parentp - (mapc - (lambda (b) - (and (org-export-derived-backend-p b (car backend)) - (throw 'parentp t))) - val) - nil))) - org-export-registered-backends)) + (let ((name (org-export-backend-name backend))) + (or (memq name val) + (catch 'parentp + (dolist (b val) + (and (org-export-derived-backend-p b name) + (throw 'parentp t))))))) + org-export--registered-backends)) ;; Now build NEW-LIST of both new back-ends and required ;; parents. - (let ((new-list (mapcar 'car org-export-registered-backends))) + (let ((new-list (mapcar 'org-export-backend-name + org-export--registered-backends))) (dolist (backend val) (cond ((not (load (format "ox-%s" backend) t t)) @@ -3765,9 +3764,9 @@ images at the same place." \\usepackage[usenames]{color} \\usepackage{amsmath} \\usepackage[mathscr]{eucal} -\\pagestyle{empty} % do not remove \[PACKAGES] \[DEFAULT-PACKAGES] +\\pagestyle{empty} % do not remove % The settings below are copied from fullpage.sty \\setlength{\\textwidth}{\\paperwidth} \\addtolength{\\textwidth}{-3cm} @@ -4340,8 +4339,8 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-clock-heading "" "The heading of the current clock entry.") (defun org-clock-is-active () - "Return non-nil if clock is currently running. -The return value is actually the clock marker." + "Return the buffer where the clock is currently running. +Return nil if no clock is running." (marker-buffer org-clock-marker)) (eval-and-compile @@ -4804,7 +4803,7 @@ Support for group tags is controlled by the option (if org-group-tags "on" "off"))) (defun org-set-regexps-and-options-for-tags () - "Precompute regular expressions used for tags in the current buffer." + "Precompute variables used for tags." (when (derived-mode-p 'org-mode) (org-set-local 'org-file-tags nil) (let ((re (org-make-options-regexp '("FILETAGS" "TAGS"))) @@ -4836,42 +4835,52 @@ Support for group tags is controlled by the option (mapcar 'org-add-prop-inherited ftags))) (org-set-local 'org-tag-groups-alist nil) ;; Process the tags. - ;; FIXME - (when tags - (let (e tgs g) - (while (setq e (pop tags)) - (cond - ((equal e "{") - (progn (push '(:startgroup) tgs) - (when (equal (nth 1 tags) ":") - (push (list (replace-regexp-in-string - "(.+)$" "" (nth 0 tags))) - org-tag-groups-alist) - (setq g 0)))) - ((equal e ":") (push '(:grouptags) tgs)) - ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil))) - ((equal e "\\n") (push '(:newline) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) - (push (cons (match-string 1 e) - (string-to-char (match-string 2 e))) tgs) + (when (and (not tags) org-tag-alist) + (setq tags + (mapcar + (lambda (tg) (cond ((eq (car tg) :startgroup) "{") + ((eq (car tg) :endgroup) "}") + ((eq (car tg) :grouptags) ":") + ((eq (car tg) :newline) "\n") + (t (concat (car tg) + (if (characterp (cdr tg)) + (format "(%s)" (char-to-string (cdr tg))) ""))))) + org-tag-alist))) + (let (e tgs g) + (while (setq e (pop tags)) + (cond + ((equal e "{") + (progn (push '(:startgroup) tgs) + (when (equal (nth 1 tags) ":") + (push (list (replace-regexp-in-string + "(.+)$" "" (nth 0 tags))) + org-tag-groups-alist) + (setq g 0)))) + ((equal e ":") (push '(:grouptags) tgs)) + ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil))) + ((equal e "\\n") (push '(:newline) tgs)) + ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) + (push (cons (match-string 1 e) + (string-to-char (match-string 2 e))) tgs) + (if (and g (> g 0)) + (setcar org-tag-groups-alist + (append (car org-tag-groups-alist) + (list (match-string 1 e))))) + (if g (setq g (1+ g)))) + (t (push (list e) tgs) (if (and g (> g 0)) (setcar org-tag-groups-alist - (append (car org-tag-groups-alist) - (list (match-string 1 e))))) - (if g (setq g (1+ g)))) - (t (push (list e) tgs) - (if (and g (> g 0)) - (setcar org-tag-groups-alist - (append (car org-tag-groups-alist) (list e)))) - (if g (setq g (1+ g)))))) - (org-set-local 'org-tag-alist nil) - (while (setq e (pop tgs)) - (or (and (stringp (car e)) - (assoc (car e) org-tag-alist)) - (push e org-tag-alist))) - ;; Return a list with tag variables - (list org-file-tags org-tag-alist org-tag-groups-alist)))))) + (append (car org-tag-groups-alist) (list e)))) + (if g (setq g (1+ g)))))) + (org-set-local 'org-tag-alist nil) + (while (setq e (pop tgs)) + (or (and (stringp (car e)) + (assoc (car e) org-tag-alist)) + (push e org-tag-alist))) + ;; Return a list with tag variables + (list org-file-tags org-tag-alist org-tag-groups-alist))))) +(defvar org-ota nil) (defun org-set-regexps-and-options () "Precompute regular expressions used in the current buffer." (when (derived-mode-p 'org-mode) @@ -4901,13 +4910,15 @@ Support for group tags is controlled by the option (while (or (and ext-setup-or-nil + (not org-ota) (let (ret) (with-temp-buffer (insert ext-setup-or-nil) - (let ((major-mode 'org-mode)) + (let ((major-mode 'org-mode) org-ota) (setq ret (save-match-data (org-set-regexps-and-options-for-tags))))) ;; Append setupfile tags to existing tags + (setq org-ota t) (setq org-file-tags (delq nil (append org-file-tags (nth 0 ret))) org-tag-alist @@ -5146,8 +5157,8 @@ Support for group tags is controlled by the option (mapcar (lambda (w) (substring w 0 -1)) (list org-scheduled-string org-deadline-string org-clock-string org-closed-string))) - (org-compute-latex-and-related-regexp) - (org-set-font-lock-defaults)))) + (setq org-ota nil) + (org-compute-latex-and-related-regexp)))) (defun org-file-contents (file &optional noerror) "Return the contents of FILE, as a string." @@ -5331,6 +5342,7 @@ The following commands are available: (setq buffer-display-table org-display-table)) (org-set-regexps-and-options-for-tags) (org-set-regexps-and-options) + (org-set-font-lock-defaults) (when (and org-tag-faces (not org-tags-special-faces-re)) ;; tag faces set outside customize.... force initialization. (org-set-tag-faces 'org-tag-faces org-tag-faces)) @@ -8196,8 +8208,8 @@ This is a short-hand for marking the subtree and then cutting it." (org-copy-subtree n 'cut)) (defun org-copy-subtree (&optional n cut force-store-markers nosubtrees) - "Cut the current subtree into the clipboard. -With prefix arg N, cut this many sequential subtrees. + "Copy the current subtree it in the clipboard. +With prefix arg N, copy this many sequential subtrees. This is a short-hand for marking the subtree and then copying it. If CUT is non-nil, actually cut the subtree. If FORCE-STORE-MARKERS is non-nil, store the relative locations @@ -11482,7 +11494,13 @@ and not actually move anything. With a double prefix arg \\[universal-argument] \\[universal-argument], \ go to the location where the last refiling operation has put the subtree. -With a prefix argument of `2', refile to the running clock. + +With a numeric prefix argument of `2', refile to the running clock. + +With a numeric prefix argument of `3', emulate `org-refile-keep' +being set to `t' and copy to the target location, don't move it. +Beware that keeping refiled entries may result in duplicated ID +properties. RFLOC can be a refile location obtained in a different way. @@ -11504,8 +11522,8 @@ prefix argument (`C-u C-u C-u C-c C-w')." (regionp (org-region-active-p)) (region-start (and regionp (region-beginning))) (region-end (and regionp (region-end))) - (region-length (and regionp (- region-end region-start))) (filename (buffer-file-name (buffer-base-buffer cbuf))) + (org-refile-keep (if (equal goto 3) t org-refile-keep)) pos it nbuf file re level reversed) (setq last-command nil) (when regionp @@ -11515,7 +11533,9 @@ prefix argument (`C-u C-u C-u C-c C-w')." (unless (or (org-kill-is-subtree-p (buffer-substring region-start region-end)) (prog1 org-refile-active-region-within-subtree - (org-toggle-heading))) + (let ((s (point-at-eol))) + (org-toggle-heading) + (setq region-end (+ (- (point-at-eol) s) region-end))))) (user-error "The region is not a (sequence of) subtree(s)"))) (if (equal goto '(16)) (org-refile-goto-last-stored) @@ -11562,7 +11582,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (setq nbuf (or (find-buffer-visiting file) (find-file-noselect file))) - (if goto + (if (and goto (not (equal goto 3))) (progn (org-pop-to-buffer-same-window nbuf) (goto-char pos) @@ -11597,8 +11617,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (if (not (bolp)) (newline)) (org-paste-subtree level) (when org-log-refile - (org-add-log-setup 'refile nil nil 'findpos - org-log-refile) + (org-add-log-setup 'refile nil nil 'findpos org-log-refile) (unless (eq org-log-refile 'note) (save-excursion (org-add-log-note)))) (and org-auto-align-tags @@ -11616,8 +11635,10 @@ prefix argument (`C-u C-u C-u C-c C-w')." (run-hooks 'org-after-refile-insert-hook)))) (unless org-refile-keep (if regionp - (delete-region (point) (+ (point) region-length)) - (org-cut-subtree))) + (delete-region (point) (+ (point) (- region-end region-start))) + (delete-region + (and (org-back-to-heading t) (point)) + (min (buffer-size) (org-end-of-subtree t t) (point))))) (when (featurep 'org-inlinetask) (org-inlinetask-remove-END-maybe)) (setq org-markers-to-move nil) @@ -11931,22 +11952,21 @@ This function can be used in a hook." ;;;; Completion +(declare-function org-export-backend-name "org-export" (cl-x)) +(declare-function org-export-backend-options "org-export" (cl-x)) (defun org-get-export-keywords () "Return a list of all currently understood export keywords. Export keywords include options, block names, attributes and keywords relative to each registered export back-end." - (delq nil - (let (keywords) - (mapc - (lambda (back-end) - (let ((props (cdr back-end))) - ;; Back-end name (for keywords, like #+LATEX:) - (push (upcase (symbol-name (car back-end))) keywords) - ;; Back-end options. - (mapc (lambda (option) (push (cadr option) keywords)) - (plist-get (cdr back-end) :options-alist)))) - (org-bound-and-true-p org-export-registered-backends)) - keywords))) + (let (keywords) + (dolist (backend + (org-bound-and-true-p org-export--registered-backends) + (delq nil keywords)) + ;; Back-end name (for keywords, like #+LATEX:) + (push (upcase (symbol-name (org-export-backend-name backend))) keywords) + (dolist (option-entry (org-export-backend-options backend)) + ;; Back-end options. + (push (nth 1 option-entry) keywords))))) (defconst org-options-keywords '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:" @@ -11956,30 +11976,21 @@ keywords relative to each registered export back-end." "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:")) (defcustom org-structure-template-alist - '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" - "\n\n") - ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" - "\n?\n") - ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" - "\n?\n") - ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" - "\n?\n") - ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" - "\n?\n") - ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" - "
\n?\n
") + '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "\n\n") + ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "\n?\n") + ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "\n?\n") + ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "\n?\n") + ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "\n?\n") + ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "
\n?\n
") ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" "\n?\n") - ("L" "#+LaTeX: " - "?") + ("L" "#+LaTeX: " "?") ("h" "#+BEGIN_HTML\n?\n#+END_HTML" "\n?\n") - ("H" "#+HTML: " - "?") - ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII") - ("A" "#+ASCII: ") - ("i" "#+INDEX: ?" - "#+INDEX: ?") + ("H" "#+HTML: " "?") + ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII" "") + ("A" "#+ASCII: " "") + ("i" "#+INDEX: ?" "#+INDEX: ?") ("I" "#+INCLUDE: %file ?" "")) "Structure completion elements. @@ -11994,9 +12005,10 @@ the default when the /org-mtags.el/ module has been loaded. See also the variable `org-mtags-prefer-muse-templates'." :group 'org-completion :type '(repeat - (string :tag "Key") - (string :tag "Template") - (string :tag "Muse Template"))) + (list + (string :tag "Key") + (string :tag "Template") + (string :tag "Muse Template")))) (defun org-try-structure-completion () "Try to complete a structure template before point. @@ -13812,7 +13824,6 @@ headlines matching this string." (abbreviate-file-name (or (buffer-file-name (buffer-base-buffer)) (buffer-name (buffer-base-buffer))))))) - (case-fold-search nil) (org-map-continue-from nil) lspos tags tags-list (tags-alist (list (cons 0 org-file-tags))) @@ -13825,7 +13836,8 @@ headlines matching this string." (when (eq action 'sparse-tree) (org-overview) (org-remove-occur-highlights)) - (while (re-search-forward re nil t) + (while (let (case-fold-search) + (re-search-forward re nil t)) (setq org-map-continue-from nil) (catch :skip (setq todo (if (match-end 1) (org-match-string-no-properties 2)) @@ -14178,9 +14190,10 @@ When DOWNCASE is non-nil, expand downcased TAGS." (modify-syntax-entry ?@ "w" stable) (modify-syntax-entry ?_ "w" stable) (while (and tml - (string-match - (concat "\\(?1:[+-]?\\)\\(?2:\\<" - (regexp-opt tml) "\\>\\)") rtnmatch)) + (with-syntax-table stable + (string-match + (concat "\\(?1:[+-]?\\)\\(?2:\\<" + (regexp-opt tml) "\\>\\)") rtnmatch))) (let* ((dir (match-string 1 rtnmatch)) (tag (match-string 2 rtnmatch)) (tag (if downcased (downcase tag) tag))) @@ -18495,14 +18508,17 @@ share a good deal of logic." "Invalid value of `org-latex-create-formula-image-program'"))) string tofile options buffer)) +(declare-function org-export-get-backend "ox" (name)) (declare-function org-export--get-global-options "ox" (&optional backend)) (declare-function org-export--get-inbuffer-options "ox" (&optional backend)) (declare-function org-latex-guess-inputenc "ox-latex" (header)) (declare-function org-latex-guess-babel-language "ox-latex" (header info)) (defun org-create-formula--latex-header () "Return LaTeX header appropriate for previewing a LaTeX snippet." - (let ((info (org-combine-plists (org-export--get-global-options 'latex) - (org-export--get-inbuffer-options 'latex)))) + (let ((info (org-combine-plists (org-export--get-global-options + (org-export-get-backend 'latex)) + (org-export--get-inbuffer-options + (org-export-get-backend 'latex))))) (org-latex-guess-babel-language (org-latex-guess-inputenc (org-splice-latex-header @@ -18593,7 +18609,7 @@ share a good deal of logic." (font-height (face-font 'default)) (face-attribute 'default :height nil))) (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) + (dpi (number-to-string (* scale (floor (if buffer fnh 120.))))) (fg (or (plist-get options (if buffer :foreground :html-foreground)) "black")) (bg (or (plist-get options (if buffer :background :html-background)) @@ -19049,6 +19065,8 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) (org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies) (org-defkey org-mode-map [remap open-line] 'org-open-line) +(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-element) +(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-element) (org-defkey org-mode-map "\C-m" 'org-return) (org-defkey org-mode-map "\C-j" 'org-return-indent) (org-defkey org-mode-map "\C-c?" 'org-table-field-info) @@ -22001,12 +22019,9 @@ hierarchy of headlines by UP levels before marking the subtree." (beginning-of-line 0)) (cond ;; There was a list item above. - ((save-excursion - (and (ignore-errors (goto-char (org-in-item-p))) - (goto-char - (org-list-get-top-point (org-list-struct))))) - (looking-at org-list-full-item-re) - (setq column (length (match-string 0)))) + ((ignore-errors (goto-char (org-in-item-p))) + (goto-char (org-list-get-top-point (org-list-struct))) + (setq column (org-get-indentation))) ;; There was an heading above. ((looking-at "\\*+[ \t]+") (if (not org-adapt-indentation) @@ -22299,20 +22314,41 @@ a footnote definition, try to fill the first paragraph within." (goto-char (org-element-property :end element)) (re-search-backward "^[ \t]*#\\+end_comment" nil t) (line-beginning-position)))) - (when (and (>= (point) beg) (< (point) end)) + (if (or (< (point) beg) (> (point) end)) t (fill-region-as-paragraph - (save-excursion - (end-of-line) - (re-search-backward "^[ \t]*$" beg 'move) - (line-beginning-position)) - (save-excursion - (beginning-of-line) - (re-search-forward "^[ \t]*$" end 'move) - (line-beginning-position)) - justify))) - t) + (save-excursion (end-of-line) + (re-search-backward "^[ \t]*$" beg 'move) + (line-beginning-position)) + (save-excursion (beginning-of-line) + (re-search-forward "^[ \t]*$" end 'move) + (line-beginning-position)) + justify)))) ;; Fill comments. - (comment (fill-comment-paragraph justify)) + (comment + (let ((begin (org-element-property :post-affiliated element)) + (end (org-element-property :end element))) + (when (and (>= (point) begin) (<= (point) end)) + (let ((begin (save-excursion + (end-of-line) + (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) + (progn (forward-line) (point)) + begin))) + (end (save-excursion + (end-of-line) + (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) + (1- (line-beginning-position)) + (skip-chars-backward " \r\t\n") + (line-end-position))))) + ;; Do not fill comments when at a blank line or at + ;; affiliated keywords. + (let ((fill-prefix (save-excursion + (beginning-of-line) + (looking-at "[ \t]*#") + (concat (match-string 0) " ")))) + (when (> end begin) + (save-excursion + (fill-region-as-paragraph begin end justify)))))) + t)) ;; Ignore every other element. (otherwise t)))))) @@ -23194,9 +23230,10 @@ Move to the next element at the same level, when possible." (let* ((elem (org-element-at-point)) (end (org-element-property :end elem)) (parent (org-element-property :parent elem))) - (if (and parent (= (org-element-property :contents-end parent) end)) - (goto-char (org-element-property :end parent)) - (goto-char end)))))) + (cond ((and parent (= (org-element-property :contents-end parent) end)) + (goto-char (org-element-property :end parent))) + ((integer-or-marker-p end) (goto-char end)) + (t (message "No element at point"))))))) (defun org-backward-element () "Move backward by one element. @@ -23222,6 +23259,7 @@ Move to the previous element at the same level, when possible." (cond ;; Move to beginning of current element if point isn't ;; there already. + ((null beg) (message "No element at point")) ((/= (point) beg) (goto-char beg)) (prev-elem (goto-char (org-element-property :begin prev-elem))) ((org-before-first-heading-p) (goto-char (point-min))) @@ -23573,6 +23611,8 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (setq current-prefix-arg nil) (org-agenda-maybe-redo))) +(defvar speedbar-file-key-map) +(declare-function speedbar-add-supported-extension "speedbar" (extension)) (eval-after-load "speedbar" '(progn (speedbar-add-supported-extension ".org") @@ -23646,6 +23686,7 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (org-show-context 'bookmark-jump))) ;; Make session.el ignore our circular variable +(defvar session-globals-exclude) (eval-after-load "session" '(add-to-list 'session-globals-exclude 'org-mark-ring)) diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 188406153..59d015237 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -665,11 +665,13 @@ caption keyword." element info nil 'org-ascii--has-caption-p)) (title-fmt (org-ascii--translate (case (org-element-type element) - (table "Table %d: %s") - (src-block "Listing %d: %s")) + (table "Table %d:") + (src-block "Listing %d:")) info))) (org-ascii--fill-string - (format title-fmt reference (org-export-data caption info)) + (concat (format title-fmt reference) + " " + (org-export-data caption info)) (org-ascii--current-text-width element info) info))))) (defun org-ascii--build-toc (info &optional n keyword) diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el index 3c564b040..5ca44af44 100644 --- a/lisp/ox-beamer.el +++ b/lisp/ox-beamer.el @@ -121,9 +121,9 @@ (add-to-list 'org-latex-classes '("beamer" "\\documentclass[presentation]{beamer} - \[DEFAULT-PACKAGES] - \[PACKAGES] - \[EXTRA]" +\[DEFAULT-PACKAGES] +\[PACKAGES] +\[EXTRA]" ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))) @@ -194,12 +194,13 @@ open The opening template for the environment, with the following escapes %A the default action/overlay specification %o the options argument of the template %h the headline text - %H if there is headline text, that text in {} braces - %U if there is headline text, that text in [] brackets + %r the raw headline text (i.e. without any processing) + %H if there is headline text, that raw text in {} braces + %U if there is headline text, that raw text in [] brackets close The closing string of the environment." :group 'org-export-beamer :version "24.4" - :package-version '(Org . "8.0") + :package-version '(Org . "8.1") :type '(repeat (list (string :tag "Environment") @@ -543,6 +544,7 @@ used as a communication channel." (append org-beamer-environments-special org-beamer-environments-extra org-beamer-environments-default)))) + (raw-title (org-element-property :raw-value headline)) (title (org-export-data (org-element-property :title headline) info)) (options (let ((options (org-element-property :BEAMER_OPT headline))) (if (not options) "" @@ -608,8 +610,11 @@ used as a communication channel." (cons "A" ""))))) (list (cons "o" options) (cons "h" title) - (cons "H" (if (equal title "") "" (format "{%s}" title))) - (cons "U" (if (equal title "") "" (format "[%s]" title)))))) + (cons "r" raw-title) + (cons "H" (if (equal raw-title "") "" + (format "{%s}" raw-title))) + (cons "U" (if (equal raw-title "") "" + (format "[%s]" raw-title)))))) "\n")) contents ;; Block's closing string. @@ -856,28 +861,30 @@ holding export options." (and (plist-get info :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) ;; 2. Document class and packages. - (let ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options))) - (org-element-normalize-string - (let* ((header (nth 1 (assoc class org-latex-classes))) - (document-class-string - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))))) - (if (not document-class-string) - (user-error "Unknown LaTeX class `%s'" class) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-splice-latex-header - document-class-string - org-latex-default-packages-alist - org-latex-packages-alist nil - (concat (plist-get info :latex-header) - (plist-get info :latex-header-extra) - (plist-get info :beamer-header-extra)))) - info))))) + (let* ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class org-latex-classes))) + (document-class-string + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1))))) + (if (not document-class-string) + (user-error "Unknown LaTeX class `%s'" class) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-element-normalize-string + (org-splice-latex-header + document-class-string + org-latex-default-packages-alist + org-latex-packages-alist nil + (concat (org-element-normalize-string + (plist-get info :latex-header)) + (org-element-normalize-string + (plist-get info :latex-header-extra)) + (plist-get info :beamer-header-extra))))) + info))) ;; 3. Insert themes. (let ((format-theme (function diff --git a/lisp/ox-html.el b/lisp/ox-html.el index a996b4042..9fc53f1cf 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -117,6 +117,7 @@ (:html-doctype "HTML_DOCTYPE" nil org-html-doctype) (:html-container "HTML_CONTAINER" nil org-html-container-element) (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy) + (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url) (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) (:html-link-up "HTML_LINK_UP" nil org-html-link-up) (:html-mathjax "HTML_MATHJAX" nil "" space) @@ -713,16 +714,14 @@ When nil, the links still point to the plain `.org' file." ;;;; Links :: Inline images -(defcustom org-html-inline-images 'maybe +(defcustom org-html-inline-images t "Non-nil means inline images into exported HTML pages. This is done using an tag. When nil, an anchor with href is used to -link to the image. If this option is `maybe', then images in links with -an empty description will be inlined, while images with a description will -be linked only." +link to the image." :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) + :version "24.4" + :package-version '(Org . "8.1") + :type 'boolean) (defcustom org-html-inline-image-rules '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") @@ -1186,6 +1185,13 @@ example." :group 'org-export-html :type '(string :tag "File or URL")) +(defcustom org-html-link-use-abs-url nil + "Should we prepend relative links with HTML_LINK_HOME?" + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.1") + :type 'boolean) + (defcustom org-html-home/up-format "
UP @@ -1326,39 +1332,43 @@ attributes with a nil value will be omitted from the result." "\"" """ (org-html-encode-plain-text item)))) (setcar output (format "%s=\"%s\"" key value)))))))) -(defun org-html-format-inline-image (src info &optional - caption label attr standalone-p) - "Format an inline image from SRC. -CAPTION, LABEL and ATTR are optional arguments providing the -caption, the label and the attribute of the image. -When STANDALONE-P is t, wrap the into a
...
." - (let* ((id (if (not label) "" - (format " id=\"%s\"" (org-export-solidify-link-text label)))) - (attr (concat attr - (format " src=\"%s\"" src) - (cond - ((string-match "\\%s%s\n" - "\n%s%s\n
") - id (format "\n

%s

" img) - (if (and caption (not (string= caption ""))) - (format (if html5-fancy - "\n
%s
" - "\n

%s

") caption) "")))) - (t (org-html-close-tag "img" (concat attr id) info))))) +(defun org-html--wrap-image (contents info &optional caption label) + "Wrap CONTENTS string within an appropriate environment for images. +INFO is a plist used as a communication channel. When optional +arguments CAPTION and LABEL are given, use them for caption and +\"id\" attribute." + (let ((html5-fancy (and (org-html-html5-p info) + (plist-get info :html-html5-fancy)))) + (format (if html5-fancy "\n%s%s\n" + "\n%s%s\n") + ;; ID. + (if (not (org-string-nw-p label)) "" + (format " id=\"%s\"" (org-export-solidify-link-text label))) + ;; Contents. + (format "\n

%s

" contents) + ;; Caption. + (if (not (org-string-nw-p caption)) "" + (format (if html5-fancy "\n
%s
" + "\n

%s

") + caption))))) + +(defun org-html--format-image (source attributes info) + "Return \"img\" tag with given SOURCE and ATTRIBUTES. +SOURCE is a string specifying the location of the image. +ATTRIBUTES is a plist, as returned by +`org-export-read-attribute'. INFO is a plist used as +a communication channel." + (org-html-close-tag + "img" + (org-html--make-attribute-string + (org-combine-plists + (list :src source + :alt (if (string-match-p "^ltxpng/" source) + (org-html-encode-plain-text + (org-find-text-property-in-string 'org-latex-src source)) + (file-name-nondirectory source))) + attributes)) + info)) (defun org-html--textarea-block (element) "Transcode ELEMENT into a textarea block. @@ -1370,6 +1380,13 @@ ELEMENT is either a src block or an example block." (or (plist-get attr :height) (org-count-lines code)) code))) +(defun org-html--has-caption-p (element &optional info) + "Non-nil when ELEMENT has a caption affiliated keyword. +INFO is a plist used as a communication channel. This function +is meant to be used as a predicate for `org-export-get-ordinal' or +a value to `org-html-standalone-image-predicate'." + (org-element-property :caption element)) + ;;;; Table (defun org-html-htmlize-region-for-paste (beg end) @@ -1911,9 +1928,13 @@ contents as a string, or nil if it is empty." (mapcar (lambda (headline) (cons (org-html--format-toc-headline headline info) (org-export-get-relative-level headline info))) - (org-export-collect-headlines info depth)))) + (org-export-collect-headlines info depth))) + (outer-tag (if (and (org-html-html5-p info) + (plist-get info :html-html5-fancy)) + "nav" + "div"))) (when toc-entries - (concat "
\n" + (concat (format "<%s id=\"table-of-contents\">\n" outer-tag) (format "%s\n" org-html-toplevel-hlevel (org-html--translate "Table of Contents" info) @@ -1921,7 +1942,7 @@ contents as a string, or nil if it is empty." "
" (org-html--toc-text toc-entries) "
\n" - "
\n")))) + (format "\n" outer-tag))))) (defun org-html--toc-text (toc-entries) "Return innards of a table of contents, as a string. @@ -1966,16 +1987,17 @@ INFO is a plist used as a communication channel." headline-number "-")))) ;; Body. (concat section-number - (org-export-data-with-translations + (org-export-data-with-backend (org-export-get-alt-title headline info) - ;; Ignore any footnote-reference, link, - ;; radio-target and target in table of contents. - (append - '((footnote-reference . ignore) - (link . (lambda (link desc i) desc)) - (radio-target . (lambda (radio desc i) desc)) - (target . ignore)) - (org-export-backend-translate-table 'html)) + ;; Create an anonymous back-end that will ignore + ;; any footnote-reference, link, radio-target and + ;; target in table of contents. + (org-export-create-backend + :parent 'html + :transcoders '((footnote-reference . ignore) + (link . (lambda (object c i) c)) + (radio-target . (lambda (object c i) c)) + (target . ignore))) info) (and tags "   ") (org-html--tags tags))))) @@ -1992,7 +2014,8 @@ of listings as a string, or nil if it is empty." org-html-toplevel-hlevel) "
\n
    \n" (let ((count 0) - (initial-fmt (org-html--translate "Listing %d:" info))) + (initial-fmt (format "%s" + (org-html--translate "Listing %d:" info)))) (mapconcat (lambda (entry) (let ((label (org-element-property :name entry)) @@ -2026,7 +2049,8 @@ of tables as a string, or nil if it is empty." org-html-toplevel-hlevel) "
    \n
      \n" (let ((count 0) - (initial-fmt (org-html--translate "Table %d:" info))) + (initial-fmt (format "%s" + (org-html--translate "Table %d:" info)))) (mapconcat (lambda (entry) (let ((label (org-element-property :name entry)) @@ -2213,15 +2237,13 @@ holding contextual information." (headline-label (or (org-element-property :CUSTOM_ID headline) (concat "sec-" (mapconcat 'number-to-string headline-number "-")))) - (format-function (cond - ((functionp format-function) format-function) - ((functionp org-html-format-headline-function) - (function* - (lambda (todo todo-type priority text tags - &allow-other-keys) - (funcall org-html-format-headline-function - todo todo-type priority text tags)))) - (t 'org-html-format-headline)))) + (format-function + (cond ((functionp format-function) format-function) + ((functionp org-html-format-headline-function) + (lambda (todo todo-type priority text tags &rest ignore) + (funcall org-html-format-headline-function + todo todo-type priority text tags))) + (t 'org-html-format-headline)))) (apply format-function todo todo-type priority text tags :headline-label headline-label :level level @@ -2471,21 +2493,19 @@ CONTENTS is nil. INFO is a plist holding contextual information." (let ((processing-type (plist-get info :with-latex)) (latex-frag (org-remove-indentation (org-element-property :value latex-environment))) - (caption (org-export-data - (org-export-get-caption latex-environment) info)) - (attr nil) ; FIXME - (label (org-element-property :name latex-environment))) - (cond - ((memq processing-type '(t mathjax)) - (org-html-format-latex latex-frag 'mathjax)) - ((eq processing-type 'dvipng) - (let* ((formula-link (org-html-format-latex - latex-frag processing-type))) - (when (and formula-link - (string-match "file:\\([^]]*\\)" formula-link)) - (org-html-format-inline-image - (match-string 1 formula-link) info caption label attr t)))) - (t latex-frag)))) + (attributes (org-export-read-attribute :attr_html latex-environment))) + (case processing-type + ((t mathjax) + (org-html-format-latex latex-frag 'mathjax)) + ((dvipng imagemagick) + (let ((formula-link (org-html-format-latex latex-frag processing-type))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + ;; Do not provide a caption or a name to be consistent with + ;; `mathjax' handling. + (org-html--wrap-image + (org-html--format-image + (match-string 1 formula-link) attributes info) info)))) + (t latex-frag)))) ;;;; Latex Fragment @@ -2497,13 +2517,10 @@ CONTENTS is nil. INFO is a plist holding contextual information." (case processing-type ((t mathjax) (org-html-format-latex latex-frag 'mathjax)) - (dvipng - (let* ((formula-link (org-html-format-latex - latex-frag processing-type))) - (when (and formula-link - (string-match "file:\\([^]]*\\)" formula-link)) - (org-html-format-inline-image - (match-string 1 formula-link) info)))) + ((dvipng imagemagick) + (let ((formula-link (org-html-format-latex latex-frag processing-type))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + (org-html--format-image (match-string 1 formula-link) nil info)))) (t latex-frag)))) ;;;; Line Break @@ -2515,75 +2532,65 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Link -(defun org-html-link--inline-image (link desc info) - "Return HTML code for an inline image. - -LINK is the link pointing to the inline image. INFO is a plist -used as a communication channel. - -Inline images can have these attributes: - -#+ATTR_HTML: :width 100px :height 100px :alt \"Alt description\"." - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - (path (cond ((member type '("http" "https")) - (concat type ":" raw-path)) - ((file-name-absolute-p raw-path) - (expand-file-name raw-path)) - (t raw-path))) - (parent (org-export-get-parent-element link)) - (caption (org-export-data (org-export-get-caption parent) info)) - (label (org-element-property :name parent))) - ;; Return proper string, depending on DISPOSITION. - (org-html-format-inline-image - path info caption label - (org-html--make-attribute-string - (org-export-read-attribute :attr_html parent)) - (org-html-standalone-image-p link info)))) +(defun org-html-inline-image-p (link info) + "Non-nil when LINK is meant to appear as an image. +INFO is a plist used as a communication channel. LINK is an +inline image when it has no description and targets an image +file (see `org-html-inline-image-rules' for more information), or +if its description is a single link targeting an image file." + (if (not (org-element-contents link)) + (org-export-inline-image-p link org-html-inline-image-rules) + (not + (let ((link-count 0)) + (org-element-map (org-element-contents link) + (cons 'plain-text org-element-all-objects) + (lambda (obj) + (case (org-element-type obj) + (plain-text (org-string-nw-p obj)) + (link (if (= link-count 1) t + (incf link-count) + (not (org-export-inline-image-p + obj org-html-inline-image-rules)))) + (otherwise t))) + info t))))) (defvar org-html-standalone-image-predicate) -(defun org-html-standalone-image-p (element info &optional predicate) - "Test if ELEMENT is a standalone image for the purpose HTML export. +(defun org-html-standalone-image-p (element info) + "Test if ELEMENT is a standalone image. + INFO is a plist holding contextual information. -Return non-nil, if ELEMENT is of type paragraph and it's sole -content, save for whitespaces, is a link that qualifies as an +Return non-nil, if ELEMENT is of type paragraph and its sole +content, save for white spaces, is a link that qualifies as an inline image. -Return non-nil, if ELEMENT is of type link and it's containing -paragraph has no other content save for leading and trailing -whitespaces. +Return non-nil, if ELEMENT is of type link and its containing +paragraph has no other content save white spaces. Return nil, otherwise. -Bind `org-html-standalone-image-predicate' to constrain -paragraph further. For example, to check for only captioned -standalone images, do the following. +Bind `org-html-standalone-image-predicate' to constrain paragraph +further. For example, to check for only captioned standalone +images, set it to: - \(setq org-html-standalone-image-predicate - \(lambda \(paragraph\) - \(org-element-property :caption paragraph\)\)\)" + \(lambda (paragraph) (org-element-property :caption paragraph))" (let ((paragraph (case (org-element-type element) (paragraph element) - (link (and (org-export-inline-image-p - element org-html-inline-image-rules) - (org-export-get-parent element))) - (t nil)))) - (when (eq (org-element-type paragraph) 'paragraph) - (when (or (not (and (boundp 'org-html-standalone-image-predicate) - (functionp org-html-standalone-image-predicate))) - (funcall org-html-standalone-image-predicate paragraph)) - (let ((contents (org-element-contents paragraph))) - (loop for x in contents - with inline-image-count = 0 - always (cond - ((eq (org-element-type x) 'plain-text) - (not (org-string-nw-p x))) - ((eq (org-element-type x) 'link) - (when (org-export-inline-image-p - x org-html-inline-image-rules) - (= (incf inline-image-count) 1))) - (t nil)))))))) + (link (org-export-get-parent element))))) + (and (eq (org-element-type paragraph) 'paragraph) + (or (not (and (boundp 'org-html-standalone-image-predicate) + (functionp org-html-standalone-image-predicate))) + (funcall org-html-standalone-image-predicate paragraph)) + (not (let ((link-count 0)) + (org-element-map (org-element-contents paragraph) + (cons 'plain-text org-element-all-objects) + (lambda (obj) (case (org-element-type obj) + (plain-text (org-string-nw-p obj)) + (link + (or (> (incf link-count) 1) + (not (org-html-inline-image-p obj info)))) + (otherwise t))) + info 'first-match 'link)))))) (defun org-html-link (link desc info) "Transcode a LINK object from Org to HTML. @@ -2591,7 +2598,9 @@ standalone images, do the following. DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information. See `org-export-data'." - (let* ((link-org-files-as-html-maybe + (let* ((home (org-trim (plist-get info :html-link-home))) + (use-abs-url (plist-get info :html-link-use-abs-url)) + (link-org-files-as-html-maybe (function (lambda (raw-path info) "Treat links to `file.org' as links to `file.html', if needed. @@ -2617,9 +2626,12 @@ INFO is a plist holding contextual information. See (funcall link-org-files-as-html-maybe raw-path info)) ;; If file path is absolute, prepend it with protocol ;; component - "file://". - (when (file-name-absolute-p raw-path) - (setq raw-path - (concat "file://" (expand-file-name raw-path)))) + (cond ((file-name-absolute-p raw-path) + (setq raw-path + (concat "file://" (expand-file-name + raw-path)))) + ((and home use-abs-url) + (setq raw-path (concat (file-name-as-directory home) raw-path)))) ;; Add search option, if any. A search option can be ;; relative to a custom-id or a headline title. Any other ;; option is ignored. @@ -2639,25 +2651,28 @@ INFO is a plist holding contextual information. See numbers "-")))))) (t raw-path)))) (t raw-path))) - ;; Extract attributes from parent's paragraph. HACK: Only do - ;; this for the first link in parent. This is needed as long - ;; as attributes cannot be set on a per link basis. + ;; Extract attributes from parent's paragraph. HACK: Only do + ;; this for the first link in parent (inner image link for + ;; inline images). This is needed as long as attributes + ;; cannot be set on a per link basis. + (attributes-plist + (let* ((parent (org-export-get-parent-element link)) + (link (let ((container (org-export-get-parent link))) + (if (and (eq (org-element-type container) 'link) + (org-html-inline-image-p link info)) + container + link)))) + (and (eq (org-element-map parent 'link 'identity info t) link) + (org-export-read-attribute :attr_html parent)))) (attributes - (let ((parent (org-export-get-parent-element link))) - (if (not (eq (org-element-map parent 'link 'identity info t) link)) - "" - (let ((att (org-html--make-attribute-string - (org-export-read-attribute :attr_html parent)))) - (cond ((not (org-string-nw-p att)) "") - ((and desc (string-match (regexp-quote att) desc)) "") - (t (concat " " att))))))) + (let ((attr (org-html--make-attribute-string attributes-plist))) + (if (org-string-nw-p attr) (concat " " attr) ""))) protocol) (cond ;; Image file. - ((and (or (eq t org-html-inline-images) - (and org-html-inline-images (not desc))) + ((and org-html-inline-images (org-export-inline-image-p link org-html-inline-image-rules)) - (org-html-link--inline-image link desc info)) + (org-html--format-image path attributes-plist info)) ;; Radio target: Transcode target's contents and use them as ;; link's description. ((string= type "radio") @@ -2688,8 +2703,6 @@ INFO is a plist holding contextual information. See (or desc (org-export-data (org-element-property :raw-link link) info)))) - ;; Fuzzy link points to an invisible target. - (keyword nil) ;; Link points to a headline. (headline (let ((href @@ -2723,21 +2736,24 @@ INFO is a plist holding contextual information. See :title destination) info))))) (format "%s" (org-export-solidify-link-text href) attributes desc))) - ;; Fuzzy link points to a target. Do as above. + ;; Fuzzy link points to a target or an element. (t - (let ((path (org-export-solidify-link-text path)) number) - (unless desc - (setq number (cond - ((org-html-standalone-image-p destination info) - (org-export-get-ordinal - (assoc 'link (org-element-contents destination)) - info 'link 'org-html-standalone-image-p)) - (t (org-export-get-ordinal destination info)))) - (setq desc (when number - (if (atom number) (number-to-string number) - (mapconcat 'number-to-string number "."))))) - (format "%s" - path attributes (or desc "No description for this link"))))))) + (let* ((path (org-export-solidify-link-text path)) + (org-html-standalone-image-predicate 'org-html--has-caption-p) + (number (cond + (desc nil) + ((org-html-standalone-image-p destination info) + (org-export-get-ordinal + (org-element-map destination 'link + 'identity info t) + info 'link 'org-html-standalone-image-p)) + (t (org-export-get-ordinal + destination info nil 'org-html--has-caption-p)))) + (desc (cond (desc) + ((not number) "No description for this link") + ((numberp number) (number-to-string number)) + (t (mapconcat 'number-to-string number "."))))) + (format "%s" path attributes desc)))))) ;; Coderef: replace link with the reference name or the ;; equivalent line number. ((string= type "coderef") @@ -2776,11 +2792,27 @@ the plist used as a communication channel." ((and (eq (org-element-type parent) 'item) (= (org-element-property :begin paragraph) (org-element-property :contents-begin parent))) - ;; leading paragraph in a list item have no tags + ;; Leading paragraph in a list item have no tags. contents) ((org-html-standalone-image-p paragraph info) - ;; standalone image - contents) + ;; Standalone image. + (let ((caption + (let ((raw (org-export-data + (org-export-get-caption paragraph) info)) + (org-html-standalone-image-predicate + 'org-html--has-caption-p)) + (if (not (org-string-nw-p raw)) raw + (concat + "" + (format (org-html--translate "Figure %d:" info) + (org-export-get-ordinal + (org-element-map paragraph 'link + 'identity info t) + info nil 'org-html-standalone-image-p)) + " " raw)))) + (label (org-element-property :name paragraph))) + (org-html--wrap-image contents info caption label))) + ;; Regular paragraph. (t (format "\n%s

      " extra contents))))) ;;;; Plain List @@ -3145,13 +3177,15 @@ contextual information." (t (let* ((label (org-element-property :name table)) (caption (org-export-get-caption table)) + (number (org-export-get-ordinal + table info nil 'org-html--has-caption-p)) (attributes - (if (org-html-html5-p info) "" - (org-html--make-attribute-string - (org-combine-plists - (and label (list :id (org-export-solidify-link-text label))) - (plist-get info :html-table-attributes) - (org-export-read-attribute :attr_html table))))) + (org-html--make-attribute-string + (org-combine-plists + (and label (list :id (org-export-solidify-link-text label))) + (and (not (org-html-html5-p info)) + (plist-get info :html-table-attributes)) + (org-export-read-attribute :attr_html table)))) (alignspec (if (and (boundp 'org-html-format-table-no-css) org-html-format-table-no-css) @@ -3183,7 +3217,10 @@ contextual information." (format (if org-html-table-caption-above "%s" "%s") - (org-export-data caption info))) + (concat + "" + (format (org-html--translate "Table %d:" info) number) + " " (org-export-data caption info)))) (funcall table-column-specs table info) contents))))) diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 09928a416..cc741bf4a 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -143,7 +143,9 @@ ("la" . "latin") ("ms" . "malay") ("nl" . "dutch") - ("no-no" . "nynorsk") + ("nb" . "norsk") + ("nn" . "nynorsk") + ("no" . "norsk") ("pl" . "polish") ("pt" . "portuguese") ("ro" . "romanian") @@ -342,7 +344,6 @@ the toc:nil option, not to those generated with #+TOC keyword." :group 'org-export-latex :type 'boolean) - ;;;; Headline (defcustom org-latex-format-headline-function @@ -618,6 +619,7 @@ in order to mimic default behaviour: (defcustom org-latex-listings nil "Non-nil means export source code using the listings package. + 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 @@ -625,8 +627,8 @@ package. Just add these to `org-latex-packages-alist', for example using customize, or with something like: \(require 'ox-latex) - \(add-to-list 'org-latex-packages-alist '\(\"\" \"listings\")) - \(add-to-list 'org-latex-packages-alist '\(\"\" \"color\")) + \(add-to-list 'org-latex-packages-alist '(\"\" \"listings\")) + \(add-to-list 'org-latex-packages-alist '(\"\" \"color\")) Alternatively, @@ -638,12 +640,18 @@ the minted package to `org-latex-packages-alist', for example using customize, or with \(require 'ox-latex) - \(add-to-list 'org-latex-packages-alist '\(\"\" \"minted\")) + \(add-to-list 'org-latex-packages-alist '(\"\" \"minted\")) In addition, it is necessary to install pygments \(http://pygments.org), and to configure the variable `org-latex-pdf-process' so that the -shell-escape option is -passed to pdflatex." +passed to pdflatex. + +The minted choice has possible repercussions on the preview of +latex fragments (see `org-preview-latex-fragment'). If you run +into previewing problems, please consult + + http://orgmode.org/worg/org-tutorials/org-latex-preview.html" :group 'org-export-latex :type '(choice (const :tag "Use listings" t) @@ -881,8 +889,11 @@ For non-floats, see `org-latex--wrap-label'." (format "\\label{%s}" (org-export-solidify-link-text label)))) (main (org-export-get-caption element)) - (short (org-export-get-caption element t))) + (short (org-export-get-caption element t)) + (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption))) (cond + ((org-string-nw-p caption-from-attr-latex) + (concat caption-from-attr-latex "\n")) ((and (not main) (equal label-str "")) "") ((not main) (concat label-str "\n")) ;; Option caption format with short name. @@ -1066,27 +1077,28 @@ holding export options." (and (plist-get info :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) ;; Document class and packages. - (let ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options))) - (org-element-normalize-string - (let* ((header (nth 1 (assoc class org-latex-classes))) - (document-class-string - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))))) - (if (not document-class-string) - (user-error "Unknown LaTeX class `%s'" class) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-splice-latex-header - document-class-string - org-latex-default-packages-alist - org-latex-packages-alist nil - (concat (plist-get info :latex-header) - (plist-get info :latex-header-extra)))) - info))))) + (let* ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class org-latex-classes))) + (document-class-string + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1))))) + (if (not document-class-string) + (user-error "Unknown LaTeX class `%s'" class) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-element-normalize-string + (org-splice-latex-header + document-class-string + org-latex-default-packages-alist + org-latex-packages-alist nil + (concat (org-element-normalize-string + (plist-get info :latex-header)) + (plist-get info :latex-header-extra))))) + info))) ;; Possibly limit depth for headline numbering. (let ((sec-num (plist-get info :section-numbers))) (when (integerp sec-num) @@ -1655,7 +1667,9 @@ used as a communication channel." (cond ((and (not float) (plist-member attr :float)) nil) ((string= float "wrap") 'wrap) ((string= float "multicolumn") 'multicolumn) - ((or float (org-element-property :caption parent)) + ((or float + (org-element-property :caption parent) + (org-string-nw-p (plist-get attr :caption))) 'figure)))) (placement (let ((place (plist-get attr :placement))) @@ -2333,7 +2347,9 @@ This function assumes TABLE has `org' as its `:type' property and ((and (not float) (plist-member attr :float)) nil) ((string= float "sidewaystable") "sidewaystable") ((string= float "multicolumn") "table*") - ((or float (org-element-property :caption table)) + ((or float + (org-element-property :caption table) + (org-string-nw-p (plist-get attr :caption))) "table"))))) ;; Extract others display options. (fontsize (let ((font (plist-get attr :font))) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index d33c1c352..0b7a653bd 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -288,38 +288,37 @@ according to the default face identified by the `htmlfontify'.") ("category-and-value" "%e %n: %c" "category-and-value" "%e %n") ("value" "%e %n: %c" "value" "%n")) "Specify how labels are applied and referenced. -This is an alist where each element is of the -form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE -LABEL-REF-FMT). -LABEL-ATTACH-FMT controls how labels and captions are attached to -an entity. It may contain following specifiers - %e, %n and %c. -%e is replaced with the CATEGORY-NAME. %n is replaced with +This is an alist where each element is of the form: + + \(STYLE-NAME ATTACH-FMT REF-MODE REF-FMT) + +ATTACH-FMT controls how labels and captions are attached to an +entity. It may contain following specifiers - %e and %c. %e is +replaced with the CATEGORY-NAME. %n is replaced with \" SEQNO \". %c is replaced -with CAPTION. See `org-odt-format-label-definition'. +with CAPTION. -LABEL-REF-MODE and LABEL-REF-FMT controls how label references -are generated. The following XML is generated for a label -reference - \" LABEL-REF-FMT -\". LABEL-REF-FMT may contain following +REF-MODE and REF-FMT controls how label references are generated. +The following XML is generated for a label reference - +\" +REF-FMT \". REF-FMT may contain following specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. -%n is replaced with SEQNO. See -`org-odt-format-label-reference'.") +%n is replaced with SEQNO. + +See also `org-odt-format-label'.") (defvar org-odt-category-map-alist '(("__Table__" "Table" "value" "Table" org-odt--enumerable-p) ("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p) ("__MathFormula__" "Text" "math-formula" "Equation" org-odt--enumerable-formula-p) ("__DvipngImage__" "Equation" "value" "Equation" org-odt--enumerable-latex-image-p) - ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p) - ;; ("__Table__" "Table" "category-and-value") - ;; ("__Figure__" "Figure" "category-and-value") - ;; ("__DvipngImage__" "Equation" "category-and-value") - ) + ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p)) "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE. -This is a list where each entry is of the form \\(CATEGORY-HANDLE -OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE\\). + +This is a list where each entry is of the form: + + \(CATEGORY-HANDLE OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE) CATEGORY_HANDLE identifies the captionable entity in question. @@ -331,15 +330,7 @@ the entity. These counters are declared within LABEL-STYLE is a key into `org-odt-label-styles' and specifies how a given entity should be captioned and referenced. -CATEGORY-NAME is used for qualifying captions on export. You can -modify the CATEGORY-NAME used in the exported document by -modifying `org-export-dictionary'. For example, an embedded -image in an English document is captioned as \"Figure 1: Orgmode -Logo\", by default. If you want the image to be captioned as -\"Illustration 1: Orgmode Logo\" instead, install an entry in -`org-export-dictionary' which translates \"Figure\" to -\"Illustration\" when the language is \"en\" and encoding is -`:utf-8'. +CATEGORY-NAME is used for qualifying captions on export. ENUMERATOR-PREDICATE is used for assigning a sequence number to the entity. See `org-odt--enumerate'.") @@ -375,6 +366,7 @@ visually." ;;;; Document schema +(require 'rng-loc) (defcustom org-odt-schema-dir (let* ((schema-dir (catch 'schema-dir @@ -768,13 +760,14 @@ link's path." :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) -(defcustom org-odt-pixels-per-inch display-pixels-per-inch +(defcustom org-odt-pixels-per-inch 96.0 "Scaling factor for converting images pixels to inches. Use this for sizing of embedded images. See Info node `(org) Images in ODT export' for more information." :type 'float :group 'org-export-odt - :version "24.1") + :version "24.4" + :package-version '(Org . "8.1")) ;;;; Src Block @@ -1045,20 +1038,6 @@ See `org-odt--build-date-styles' for implementation details." (error "Extraction failed")))) members)) -(defun org-odt--suppress-some-translators (info types) - ;; See comments in `org-odt-format-label' and `org-odt-toc'. - (org-combine-plists - info (list - ;; Override translators. - :translate-alist - (nconc (mapcar (lambda (type) (cons type (lambda (data contents info) - contents))) types) - (plist-get info :translate-alist)) - ;; Reset data translation cache. FIXME. - ;; :exported-data nil - ))) - - ;;;; Target (defun org-odt--target (text id) @@ -1174,20 +1153,19 @@ See `org-odt--build-date-styles' for implementation details." (let* ((title (org-export-translate "Table of Contents" :utf-8 info)) (headlines (org-export-collect-headlines info (and (wholenump depth) depth))) - (translations (nconc (mapcar - (lambda (type) - (cons type (lambda (data contents info) - contents))) - (list 'radio-target)) - (plist-get info :translate-alist)))) + (backend (org-export-create-backend + :parent (org-export-backend-name + (plist-get info :back-end)) + :transcoders (mapcar + (lambda (type) (cons type (lambda (d c i) c))) + (list 'radio-target))))) (when headlines (concat (org-odt-begin-toc title depth) (mapconcat (lambda (headline) (let* ((entry (org-odt-format-headline--wrap - headline translations info - 'org-odt-format-toc-headline)) + headline backend info 'org-odt-format-toc-headline)) (level (org-export-get-relative-level headline info)) (style (format "Contents_20_%d" level))) (format "\n%s" @@ -1753,18 +1731,22 @@ CONTENTS is nil. INFO is a plist holding contextual information." (t (let* ((raw (org-export-get-footnote-definition footnote-reference info)) - (translations - (cons (cons 'paragraph - (lambda (p c i) - (org-odt--format-paragraph - p c "Footnote" "OrgFootnoteCenter" - "OrgFootnoteQuotations"))) - (org-export-backend-translate-table 'odt))) - (def (let ((def (org-trim (org-export-data-with-translations - raw translations info)))) - (if (eq (org-element-type raw) 'org-data) def - (format "\n%s" - "Footnote" def))))) + (def + (let ((def (org-trim + (org-export-data-with-backend + raw + (org-export-create-backend + :parent 'odt + :transcoders + '((paragraph . (lambda (p c i) + (org-odt--format-paragraph + p c "Footnote" + "OrgFootnoteCenter" + "OrgFootnoteQuotations"))))) + info)))) + (if (eq (org-element-type raw) 'org-data) def + (format "\n%s" + "Footnote" def))))) (funcall --format-footnote-definition n def)))))))) @@ -1797,13 +1779,12 @@ CONTENTS is nil. INFO is a plist holding contextual information." "%s" "OrgTag" tag)) tags " : ")))))) -(defun org-odt-format-headline--wrap (headline translations info - &optional format-function - &rest extra-keys) - "Transcode a HEADLINE element from Org to ODT. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (setq translations (or translations (plist-get info :translate-alist))) +(defun org-odt-format-headline--wrap (headline backend info + &optional format-function + &rest extra-keys) + "Transcode a HEADLINE element using BACKEND. +INFO is a plist holding contextual information." + (setq backend (or backend (plist-get info :back-end))) (let* ((level (+ (org-export-get-relative-level headline info))) (headline-number (org-export-get-headline-number headline info)) (section-number (and (org-export-numbered-headline-p headline info) @@ -1811,13 +1792,13 @@ holding contextual information." headline-number "."))) (todo (and (plist-get info :with-todo-keywords) (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data-with-translations - todo translations info))))) + (and todo + (org-export-data-with-backend todo backend info))))) (todo-type (and todo (org-element-property :todo-type headline))) (priority (and (plist-get info :with-priority) (org-element-property :priority headline))) - (text (org-export-data-with-translations - (org-element-property :title headline) translations info)) + (text (org-export-data-with-backend + (org-element-property :title headline) backend info)) (tags (and (plist-get info :with-tags) (org-export-get-tags headline info))) (headline-label (concat "sec-" (mapconcat 'number-to-string @@ -1827,7 +1808,7 @@ holding contextual information." ((functionp org-odt-format-headline-function) (function* (lambda (todo todo-type priority text tags - &allow-other-keys) + &allow-other-keys) (funcall org-odt-format-headline-function todo todo-type priority text tags)))) (t 'org-odt-format-headline)))) @@ -1956,7 +1937,7 @@ holding contextual information." (let ((format-function (function* (lambda (todo todo-type priority text tags - &key contents &allow-other-keys) + &key contents &allow-other-keys) (funcall org-odt-format-inlinetask-function todo todo-type priority text tags contents))))) (org-odt-format-headline--wrap @@ -2122,6 +2103,16 @@ CONTENTS is nil. INFO is a plist holding contextual information." tag)) (defun org-odt-format-label (element info op) + "Return a label for ELEMENT. + +ELEMENT is a `link', `table', `src-block' or `paragraph' type +element. INFO is a plist used as a communication channel. OP is +either `definition' or `reference', depending on the purpose of +the generated string. + +Return value is a string if OP is set to `reference' or a cons +cell like CAPTION . SHORT-CAPTION) where CAPTION and +SHORT-CAPTION are strings." (assert (memq (org-element-type element) '(link table src-block paragraph))) (let* ((caption-from (case (org-element-type element) @@ -2161,15 +2152,14 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;; will do. (short-caption (let ((short-caption (or short-caption caption)) - (translations (nconc (mapcar - (lambda (type) - (cons type (lambda (data contents info) - contents))) - org-element-all-objects) - (plist-get info :translate-alist)))) + (backend (org-export-create-backend + :parent (org-export-backend-name + (plist-get info :back-end)) + :transcoders + (mapcar (lambda (type) (cons type (lambda (o c i) c))) + org-element-all-objects)))) (when short-caption - (org-export-data-with-translations short-caption - translations info))))) + (org-export-data-with-backend short-caption backend info))))) (when (or label caption) (let* ((default-category (case (org-element-type element) @@ -2199,8 +2189,8 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;; Case 1: Handle Label definition. (definition ;; Assign an internal label, if user has not provided one - (setq label (or label (format "%s-%s" default-category seqno))) - (setq label (org-export-solidify-link-text label)) + (setq label (org-export-solidify-link-text + (or label (format "%s-%s" default-category seqno)))) (cons (concat ;; Sneak in a bookmark. The bookmark is used when the @@ -2209,8 +2199,11 @@ CONTENTS is nil. INFO is a plist holding contextual information." (format "\n" label) ;; Label definition: Typically formatted as below: ;; CATEGORY SEQ-NO: LONG CAPTION + ;; with translation for correct punctuation. (format-spec - (cadr (assoc-string label-style org-odt-label-styles t)) + (org-export-translate + (cadr (assoc-string label-style org-odt-label-styles t)) + :utf-8 info) `((?e . ,category) (?n . ,(format "%s" @@ -2786,63 +2779,58 @@ INFO is a plist holding contextual information. See ;; Links pointing to a 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)))) - (or - ;; Case 1: Fuzzy link points nowhere. - (when (null (org-element-type destination)) + (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) + ;; Case 1: Fuzzy link points nowhere. + ('nil (format "%s" - "Emphasis" (or desc (org-export-data - (org-element-property - :raw-link link) info)))) - ;; Case 2: Fuzzy link points to an invisible target. Strip it. - (when (eq (org-element-type destination) 'keyword) "") - ;; Case 3: LINK points to a headline. - (when (eq (org-element-type destination) 'headline) - ;; Case 3.1: LINK has a custom description that is - ;; different from headline's title. Create a hyperlink. - (when (and desc - (let ((link-desc (org-element-contents link))) - (not (string= (org-element-interpret-data link-desc) - (org-element-property :raw-value - destination))))) - (let* ((headline-no (org-export-get-headline-number - destination info)) - (label (format "sec-%s" (mapconcat 'number-to-string - headline-no "-")))) - (format "%s" - label desc)))) - ;; Case 4: LINK points to an Inline image, Math formula or a Table. - (let ((label-reference (ignore-errors (org-odt-format-label - destination info 'reference)))) - (when label-reference - (cond - ;; Case 4.1: LINK has no description. Create a - ;; cross-reference showing entity's sequence number. - ((not desc) label-reference) - ;; Case 4.2: LINK has description. Insert a hyperlink - ;; with user-provided description. - (t (let* ((caption-from (case (org-element-type destination) - (link (org-export-get-parent-element - destination)) - (t destination))) - ;; Get label and caption. - (label (org-element-property :name caption-from))) - (format "%s" - (org-export-solidify-link-text label) desc)))))) - ;; Case 5: Fuzzy link points to a TARGET. - (when (eq (org-element-type destination) 'target) - ;; Case 5.1: LINK has description. Create a hyperlink. - (when desc + "Emphasis" + (or desc + (org-export-data (org-element-property :raw-link link) + info)))) + ;; Case 2: Fuzzy link points to a headline. + (headline + ;; If there's a description, create a hyperlink. + ;; Otherwise, try to provide a meaningful description. + (if (not desc) (org-odt-link--infer-description destination info) + (let* ((headline-no + (org-export-get-headline-number destination info)) + (label + (format "sec-%s" + (mapconcat 'number-to-string headline-no "-")))) + (format + "%s" + label desc)))) + ;; Case 3: Fuzzy link points to a target. + (target + ;; If there's a description, create a hyperlink. + ;; Otherwise, try to provide a meaningful description. + (if (not desc) (org-odt-link--infer-description destination info) (let ((label (org-element-property :value destination))) (format "%s" - (org-export-solidify-link-text label) desc)))) - ;; LINK has no description. It points to either a HEADLINE or - ;; an ELEMENT with a #+NAME: LABEL attached to it. LINK to - ;; DESTINATION, but make a best effort to provide - ;; a *meaningful* description. - (org-odt-link--infer-description destination info)))) + (org-export-solidify-link-text label) + desc)))) + ;; Case 4: Fuzzy link points to some element (e.g., an + ;; inline image, a math formula or a table). + (otherwise + (let ((label-reference + (ignore-errors (org-odt-format-label + destination info 'reference)))) + (cond ((not label-reference) + (org-odt-link--infer-description destination info)) + ;; LINK has no description. Create + ;; a cross-reference showing entity's sequence + ;; number. + ((not desc) label-reference) + ;; LINK has description. Insert a hyperlink with + ;; user-provided description. + (t + (let ((label (org-element-property :name destination))) + (format "%s" + (org-export-solidify-link-text label) + desc))))))))) ;; Coderef: replace link with the reference name or the ;; equivalent line number. ((string= type "coderef") @@ -2967,7 +2955,8 @@ contextual information." (setq output (org-odt--encode-plain-text output t)) ;; Handle smart quotes. Be sure to provide original string since ;; OUTPUT may have been modified. - (setq output (org-export-activate-smart-quotes output :utf-8 info text)) + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :utf-8 info text))) ;; Convert special strings. (when (plist-get info :with-special-strings) (mapc @@ -3783,9 +3772,10 @@ contextual information." (setq processing-type 'mathml) (message "LaTeX to MathML converter not available.") (setq processing-type 'verbatim))) - (dvipng + ((dvipng imagemagick) (unless (and (org-check-external-command "latex" "" t) - (org-check-external-command "dvipng" "" t)) + (org-check-external-command + (if (eq processing-type 'dvipng) "dvipng" "convert") "" t)) (message "LaTeX to PNG converter not available.") (setq processing-type 'verbatim))) (otherwise @@ -3798,7 +3788,7 @@ contextual information." (message "Formatting LaTeX using %s" processing-type) ;; Convert `latex-fragment's and `latex-environment's. - (when (memq processing-type '(mathml dvipng)) + (when (memq processing-type '(mathml dvipng imagemagick)) (org-element-map tree '(latex-fragment latex-environment) (lambda (latex-*) (incf count) @@ -3807,13 +3797,13 @@ contextual information." (cache-dir (file-name-directory input-file)) (cache-subdir (concat (case processing-type - (dvipng "ltxpng/") + ((dvipng imagemagick) "ltxpng/") (mathml "ltxmathml/")) (file-name-sans-extension (file-name-nondirectory input-file)))) (display-msg (case processing-type - (dvipng (format "Creating LaTeX Image %d..." count)) + ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count)) (mathml (format "Creating MathML snippet %d..." count)))) ;; Get an Org-style link to PNG image or the MathML ;; file. diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index cf428d1a0..d5f4dfec6 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -449,10 +449,16 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR." (not (string-match match fnd))) (pushnew f org-publish-temp-files))))) - (if org-sitemap-requested - (sort (directory-files base-dir t (unless recurse match)) - 'org-publish-compare-directory-files) - (directory-files base-dir t (unless recurse match))))) + (let ((all-files (if (not recurse) (directory-files base-dir t match) + ;; If RECURSE is non-nil, we want all files + ;; matching MATCH and sub-directories. + (org-remove-if-not + (lambda (file) + (or (file-directory-p file) + (and match (string-match match file)))) + (directory-files base-dir t))))) + (if (not org-sitemap-requested) all-files + (sort all-files 'org-publish-compare-directory-files))))) (defun org-publish-get-base-files (project &optional exclude-regexp) "Return a list of all files in PROJECT. @@ -811,30 +817,32 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (defun org-publish-find-date (file) "Find the date of FILE in project. -If FILE provides a DATE keyword use it else use the file system's -modification time. Return time in `current-time' format." - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (file-buf (or visiting (find-file-noselect file nil))) - (date (plist-get - (with-current-buffer file-buf - (org-mode) - (org-export-get-environment)) - :date))) - (unless visiting (kill-buffer file-buf)) - ;; DATE is either a timestamp object or a secondary string. If it - ;; is a timestamp or if the secondary string contains a timestamp, - ;; convert it to internal format. Otherwise, use FILE - ;; modification time. - (cond ((eq (org-element-type date) 'timestamp) - (org-time-string-to-time (org-element-interpret-data date))) - ((let ((ts (and (consp date) (assq 'timestamp date)))) - (and ts - (let ((value (org-element-interpret-data ts))) - (and (org-string-nw-p value) - (org-time-string-to-time value)))))) - ((file-exists-p file) (nth 5 (file-attributes file))) - (t (error "No such file: \"%s\"" file))))) +This function assumes FILE is either a directory or an Org file. +If FILE is an Org file and provides a DATE keyword use it. In +any other case use the file system's modification time. Return +time in `current-time' format." + (if (file-directory-p file) (nth 5 (file-attributes file)) + (let* ((visiting (find-buffer-visiting file)) + (file-buf (or visiting (find-file-noselect file nil))) + (date (plist-get + (with-current-buffer file-buf + (let ((org-inhibit-startup t)) (org-mode)) + (org-export-get-environment)) + :date))) + (unless visiting (kill-buffer file-buf)) + ;; DATE is either a timestamp object or a secondary string. If it + ;; is a timestamp or if the secondary string contains a timestamp, + ;; convert it to internal format. Otherwise, use FILE + ;; modification time. + (cond ((eq (org-element-type date) 'timestamp) + (org-time-string-to-time (org-element-interpret-data date))) + ((let ((ts (and (consp date) (assq 'timestamp date)))) + (and ts + (let ((value (org-element-interpret-data ts))) + (and (org-string-nw-p value) + (org-time-string-to-time value)))))) + ((file-exists-p file) (nth 5 (file-attributes file))) + (t (error "No such file: \"%s\"" file)))))) diff --git a/lisp/ox.el b/lisp/ox.el index e49de22c6..b733d3ebc 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -47,15 +47,10 @@ ;; The core function is `org-export-as'. It returns the transcoded ;; buffer as a string. ;; -;; An export back-end is defined with `org-export-define-backend', -;; which defines one mandatory information: his translation table. -;; Its value is an alist whose keys are elements and objects types and -;; values translator functions. See function's docstring for more -;; information about translators. -;; -;; Optionally, `org-export-define-backend' can also support specific -;; buffer keywords, OPTION keyword's items and filters. Also refer to -;; function documentation for more information. +;; An export back-end is defined with `org-export-define-backend'. +;; This function can also support specific buffer keywords, OPTION +;; keyword's items and filters. Refer to function's documentation for +;; more information. ;; ;; If the new back-end shares most properties with another one, ;; `org-export-define-derived-backend' can be used to simplify the @@ -280,14 +275,8 @@ containing the back-end used, as a symbol, and either a process or the time at which it finished. It is used to build the menu from `org-export-stack'.") -(defvar org-export-registered-backends nil +(defvar org-export--registered-backends nil "List of backends currently available in the exporter. - -A backend is stored as a list where CAR is its name, as a symbol, -and CDR is a plist with the following properties: -`:filters-alist', `:menu-entry', `:options-alist' and -`:translate-alist'. - This variable is set with `org-export-define-backend' and `org-export-define-derived-backend' functions.") @@ -501,8 +490,9 @@ e.g. \"H:2\"." (defcustom org-export-default-language "en" "The default language for export and clocktable translations, as a string. This may have an association in -`org-clock-clocktable-language-setup'. This option can also be -set with the LANGUAGE keyword." +`org-clock-clocktable-language-setup', +`org-export-smart-quotes-alist' and `org-export-dictionary'. +This option can also be set with the LANGUAGE keyword." :group 'org-export-general :type '(string :tag "Language")) @@ -829,20 +819,6 @@ process faster and the export more portable." :package-version '(Org . "8.0") :type '(file :must-match t)) -(defcustom org-export-invisible-backends nil - "List of back-ends that shouldn't appear in the dispatcher. - -Any back-end belonging to this list or derived from a back-end -belonging to it will not appear in the dispatcher menu. - -Indeed, Org may require some export back-ends without notice. If -these modules are never to be used interactively, adding them -here will avoid cluttering the dispatcher menu." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type '(repeat (symbol :tag "Back-End"))) - (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 @@ -862,25 +838,147 @@ mode." ;;; Defining Back-ends ;; -;; `org-export-define-backend' is the standard way to define an export -;; back-end. It allows to specify translators, filters, buffer -;; options and a menu entry. If the new back-end shares translators -;; with another back-end, `org-export-define-derived-backend' may be -;; used instead. +;; An export back-end is a structure with `org-export-backend' type +;; and `name', `parent', `transcoders', `options', `filters', `blocks' +;; and `menu' slots. ;; -;; Internally, a back-end is stored as a list, of which CAR is the -;; name of the back-end, as a symbol, and CDR a plist. Accessors to -;; properties of a given back-end are: `org-export-backend-filters', -;; `org-export-backend-menu', `org-export-backend-options' and -;; `org-export-backend-translate-table'. +;; At the lowest level, a back-end is created with +;; `org-export-create-backend' function. +;; +;; A named back-end can be registered with +;; `org-export-register-backend' function. A registered back-end can +;; later be referred to by its name, with `org-export-get-backend' +;; function. Also, such a back-end can become the parent of a derived +;; back-end from which slot values will be inherited by default. +;; `org-export-derived-backend-p' can check if a given back-end is +;; derived from a list of back-end names. +;; +;; `org-export-get-all-transcoders', `org-export-get-all-options' and +;; `org-export-get-all-filters' return the full alist of transcoders, +;; options and filters, including those inherited from ancestors. +;; +;; At a higher level, `org-export-define-backend' is the standard way +;; to define an export back-end. If the new back-end is similar to +;; a registered back-end, `org-export-define-derived-backend' may be +;; used instead. ;; ;; Eventually `org-export-barf-if-invalid-backend' returns an error ;; when a given back-end hasn't been registered yet. -(defun org-export-define-backend (backend translators &rest body) +(defstruct (org-export-backend (:constructor org-export-create-backend) + (:copier nil)) + name parent transcoders options filters blocks menu) + +(defun org-export-get-backend (name) + "Return export back-end named after NAME. +NAME is a symbol. Return nil if no such back-end is found." + (catch 'found + (dolist (b org-export--registered-backends) + (when (eq (org-export-backend-name b) name) + (throw 'found b))))) + +(defun org-export-register-backend (backend) + "Register BACKEND as a known export back-end. +BACKEND is a structure with `org-export-backend' type." + ;; Refuse to register an unnamed back-end. + (unless (org-export-backend-name backend) + (error "Cannot register a unnamed export back-end")) + ;; Refuse to register a back-end with an unknown parent. + (let ((parent (org-export-backend-parent backend))) + (when (and parent (not (org-export-get-backend parent))) + (error "Cannot use unknown \"%s\" back-end as a parent" parent))) + ;; Register dedicated export blocks in the parser. + (dolist (name (org-export-backend-blocks backend)) + (add-to-list 'org-element-block-name-alist + (cons name 'org-element-export-block-parser))) + ;; If a back-end with the same name as BACKEND is already + ;; registered, replace it with BACKEND. Otherwise, simply add + ;; BACKEND to the list of registered back-ends. + (let ((old (org-export-get-backend (org-export-backend-name backend)))) + (if old (setcar (memq old org-export--registered-backends) backend) + (push backend org-export--registered-backends)))) + +(defun org-export-barf-if-invalid-backend (backend) + "Signal an error if BACKEND isn't defined." + (unless (org-export-backend-p backend) + (error "Unknown \"%s\" back-end: Aborting export" backend))) + +(defun org-export-derived-backend-p (backend &rest backends) + "Non-nil if BACKEND is derived from one of BACKENDS. +BACKEND is an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. BACKENDS is constituted of symbols." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (catch 'exit + (while (org-export-backend-parent backend) + (when (memq (org-export-backend-name backend) backends) + (throw 'exit t)) + (setq backend + (org-export-get-backend (org-export-backend-parent backend)))) + (memq (org-export-backend-name backend) backends)))) + +(defun org-export-get-all-transcoders (backend) + "Return full translation table for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are element or object types, as symbols, and values are +transcoders. + +Unlike to `org-export-backend-transcoders', this function +also returns transcoders inherited from parent back-ends, +if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((transcoders (org-export-backend-transcoders backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq transcoders + (append transcoders (org-export-backend-transcoders backend)))) + transcoders))) + +(defun org-export-get-all-options (backend) + "Return export options for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. See `org-export-options-alist' +for the shape of the return value. + +Unlike to `org-export-backend-options', this function also +returns options inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((options (org-export-backend-options backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq options (append options (org-export-backend-options backend)))) + options))) + +(defun org-export-get-all-filters (backend) + "Return complete list of filters for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are symbols and values lists of functions. + +Unlike to `org-export-backend-filters', this function also +returns filters inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((filters (org-export-backend-filters backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq filters (append filters (org-export-backend-filters backend)))) + filters))) + +(defun org-export-define-backend (backend transcoders &rest body) "Define a new back-end BACKEND. -TRANSLATORS is an alist between object or element types and +TRANSCODERS is an alist between object or element types and functions handling them. These functions should return a string without any trailing @@ -996,32 +1094,23 @@ keywords are understood: `org-export-options-alist' for more information about structure of the values." (declare (indent 1)) - (let (export-block filters menu-entry options contents) + (let (blocks filters menu-entry options contents) (while (keywordp (car body)) (case (pop body) (:export-block (let ((names (pop body))) - (setq export-block - (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) + (setq blocks (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) (:filters-alist (setq filters (pop body))) (:menu-entry (setq menu-entry (pop body))) (:options-alist (setq options (pop body))) (t (pop body)))) - (setq contents (append (list :translate-alist translators) - (and filters (list :filters-alist filters)) - (and options (list :options-alist options)) - (and menu-entry (list :menu-entry menu-entry)))) - ;; Register back-end. - (let ((registeredp (assq backend org-export-registered-backends))) - (if registeredp (setcdr registeredp contents) - (push (cons backend contents) org-export-registered-backends))) - ;; Tell parser to not parse EXPORT-BLOCK blocks. - (when export-block - (mapc - (lambda (name) - (add-to-list 'org-element-block-name-alist - `(,name . org-element-export-block-parser))) - export-block)))) + (org-export-register-backend + (org-export-create-backend :name backend + :transcoders transcoders + :options options + :filters filters + :blocks blocks + :menu menu-entry)))) (defun org-export-define-derived-backend (child parent &rest body) "Create a new back-end as a variant of an existing one. @@ -1076,75 +1165,25 @@ The back-end could then be called with, for example: \(org-export-to-buffer 'my-latex \"*Test my-latex*\")" (declare (indent 2)) - (let (export-block filters menu-entry options translators contents) + (let (blocks filters menu-entry options transcoders contents) (while (keywordp (car body)) (case (pop body) (:export-block (let ((names (pop body))) - (setq export-block - (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) + (setq blocks (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) (:filters-alist (setq filters (pop body))) (:menu-entry (setq menu-entry (pop body))) (:options-alist (setq options (pop body))) - (:translate-alist (setq translators (pop body))) + (:translate-alist (setq transcoders (pop body))) (t (pop body)))) - (setq contents (append - (list :parent parent) - (let ((p-table (org-export-backend-translate-table parent))) - (list :translate-alist (append translators p-table))) - (let ((p-filters (org-export-backend-filters parent))) - (list :filters-alist (append filters p-filters))) - (let ((p-options (org-export-backend-options parent))) - (list :options-alist (append options p-options))) - (and menu-entry (list :menu-entry menu-entry)))) - (org-export-barf-if-invalid-backend parent) - ;; Register back-end. - (let ((registeredp (assq child org-export-registered-backends))) - (if registeredp (setcdr registeredp contents) - (push (cons child contents) org-export-registered-backends))) - ;; Tell parser to not parse EXPORT-BLOCK blocks. - (when export-block - (mapc - (lambda (name) - (add-to-list 'org-element-block-name-alist - `(,name . org-element-export-block-parser))) - export-block)))) - -(defun org-export-backend-parent (backend) - "Return back-end from which BACKEND is derived, or nil." - (plist-get (cdr (assq backend org-export-registered-backends)) :parent)) - -(defun org-export-backend-filters (backend) - "Return filters for BACKEND." - (plist-get (cdr (assq backend org-export-registered-backends)) - :filters-alist)) - -(defun org-export-backend-menu (backend) - "Return menu entry for BACKEND." - (plist-get (cdr (assq backend org-export-registered-backends)) - :menu-entry)) - -(defun org-export-backend-options (backend) - "Return export options for BACKEND." - (plist-get (cdr (assq backend org-export-registered-backends)) - :options-alist)) - -(defun org-export-backend-translate-table (backend) - "Return translate table for BACKEND." - (plist-get (cdr (assq backend org-export-registered-backends)) - :translate-alist)) - -(defun org-export-barf-if-invalid-backend (backend) - "Signal an error if BACKEND isn't defined." - (unless (org-export-backend-translate-table backend) - (error "Unknown \"%s\" back-end: Aborting export" backend))) - -(defun org-export-derived-backend-p (backend &rest backends) - "Non-nil if BACKEND is derived from one of BACKENDS." - (let ((parent backend)) - (while (and (not (memq parent backends)) - (setq parent (org-export-backend-parent parent)))) - parent)) + (org-export-register-backend + (org-export-create-backend :name child + :parent parent + :transcoders transcoders + :options options + :filters filters + :blocks blocks + :menu menu-entry)))) @@ -1447,14 +1486,15 @@ The back-end could then be called with, for example: ;; `org-export--get-subtree-options' and ;; `org-export--get-inbuffer-options' ;; -;; Also, `org-export--install-letbind-maybe' takes care of the part -;; relative to "#+BIND:" keywords. +;; Also, `org-export--list-bound-variables' collects bound variables +;; along with their value in order to set them as buffer local +;; variables later in the process. (defun org-export-get-environment (&optional backend subtreep ext-plist) "Collect export options from the current buffer. -Optional argument BACKEND is a symbol specifying which back-end -specific options to read, if any. +Optional argument BACKEND is an export back-end, as returned by +`org-export-create-backend'. When optional argument SUBTREEP is non-nil, assume the export is done against the current sub-tree. @@ -1480,8 +1520,7 @@ inferior to file-local settings." (list :back-end backend - :translate-alist - (org-export-backend-translate-table backend) + :translate-alist (org-export-get-all-transcoders backend) :footnote-definition-alist ;; Footnotes definitions must be collected in the original ;; buffer, as there's no insurance that they will still be in @@ -1517,11 +1556,12 @@ inferior to file-local settings." (defun org-export--parse-option-keyword (options &optional backend) "Parse an OPTIONS line and return values as a plist. -Optional argument BACKEND is a symbol specifying which back-end +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies which back-end specific items to read, if any." (let* ((all ;; Priority is given to back-end specific options. - (append (and backend (org-export-backend-options backend)) + (append (and backend (org-export-get-all-options backend)) org-export-options-alist)) plist) (dolist (option all) @@ -1541,7 +1581,8 @@ specific items to read, if any." (defun org-export--get-subtree-options (&optional backend) "Get export options in subtree at point. -Optional argument BACKEND is a symbol specifying back-end used +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies back-end used for export. Return options as a plist." ;; For each buffer keyword, create a headline property setting the ;; same property in communication channel. The name for the property @@ -1593,7 +1634,7 @@ for export. Return options as a plist." (t value))))))))) ;; Look for both general keywords and back-end specific ;; options, with priority given to the latter. - (append (and backend (org-export-backend-options backend)) + (append (and backend (org-export-get-all-options backend)) org-export-options-alist))) ;; Return value. plist))) @@ -1601,7 +1642,8 @@ for export. Return options as a plist." (defun org-export--get-inbuffer-options (&optional backend) "Return current buffer export options, as a plist. -Optional argument BACKEND, when non-nil, is a symbol specifying +Optional argument BACKEND, when non-nil, is an export back-end, +as returned by, e.g., `org-export-create-backend'. It specifies which back-end specific options should also be read in the process. @@ -1611,19 +1653,18 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (case-fold-search t) (options (append ;; Priority is given to back-end specific options. - (and backend (org-export-backend-options backend)) + (and backend (org-export-get-all-options backend)) org-export-options-alist)) (regexp (format "^[ \t]*#\\+%s:" (regexp-opt (nconc (delq nil (mapcar 'cadr options)) org-export-special-keywords)))) - (find-opt + (find-properties (lambda (keyword) - ;; Return property name associated to KEYWORD. - (catch 'exit - (mapc (lambda (option) - (when (equal (nth 1 option) keyword) - (throw 'exit (car option)))) - options)))) + ;; Return all properties associated to KEYWORD. + (let (properties) + (dolist (option options properties) + (when (equal (nth 1 option) keyword) + (pushnew (car option) properties)))))) (get-options (lambda (&optional files plist) ;; Recursively read keywords in buffer. FILES is a list @@ -1663,47 +1704,45 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (plist-get plist :filetags))))))) (t ;; Options in `org-export-options-alist'. - (let* ((prop (funcall find-opt key)) - (behaviour (nth 4 (assq prop options)))) - (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))))))))))))) + (dolist (property (funcall find-properties key)) + (let ((behaviour (nth 4 (assq property options)))) + (setq plist + (plist-put + plist property + ;; Handle value depending on specified + ;; BEHAVIOUR. + (case behaviour + (space + (if (not (plist-get plist property)) + (org-trim val) + (concat (plist-get plist property) + " " + (org-trim val)))) + (newline + (org-trim + (concat (plist-get plist property) + "\n" + (org-trim val)))) + (split `(,@(plist-get plist property) + ,@(org-split-string val))) + ('t val) + (otherwise + (if (not (plist-member plist property)) val + (plist-get plist property)))))))))))))) ;; Return final value. plist)))) ;; Read options in the current buffer. (setq plist (funcall get-options buffer-file-name nil)) - ;; Parse keywords specified in `org-element-document-properties'. - (mapc (lambda (keyword) - ;; Find the property associated to the keyword. - (let* ((prop (funcall find-opt keyword)) - (value (and prop (plist-get plist prop)))) - (when (stringp value) - (setq plist - (plist-put plist prop - (org-element-parse-secondary-string - value (org-element-restriction 'keyword))))))) - org-element-document-properties) - ;; Return value. - plist)) + ;; Parse keywords specified in `org-element-document-properties' + ;; and return PLIST. + (dolist (keyword org-element-document-properties plist) + (dolist (property (funcall find-properties keyword)) + (let ((value (plist-get plist property))) + (when (stringp value) + (setq plist + (plist-put plist property + (org-element-parse-secondary-string + value (org-element-restriction 'keyword)))))))))) (defun org-export--get-buffer-attributes () "Return properties related to buffer attributes, as a plist." @@ -1724,12 +1763,13 @@ name." (defun org-export--get-global-options (&optional backend) "Return global export options as a plist. -Optional argument BACKEND, if non-nil, is a symbol specifying +Optional argument BACKEND, if non-nil, is an export back-end, as +returned by, e.g., `org-export-create-backend'. It specifies which back-end specific export options should also be read in the process." (let (plist ;; Priority is given to back-end specific options. - (all (append (and backend (org-export-backend-options backend)) + (all (append (and backend (org-export-get-all-options backend)) org-export-options-alist))) (dolist (cell all plist) (let ((prop (car cell))) @@ -2057,11 +2097,10 @@ a tree with a select tag." ;; back-end output. It takes care of filtering out elements or ;; objects according to export options and organizing the output blank ;; lines and white space are preserved. The function memoizes its -;; results, so it is cheap to call it within translators. +;; results, so it is cheap to call it within transcoders. ;; ;; It is possible to modify locally the back-end used by ;; `org-export-data' or even use a temporary back-end by using -;; `org-export-data-with-translations' and ;; `org-export-data-with-backend'. ;; ;; Internally, three functions handle the filtering of objects and @@ -2189,24 +2228,6 @@ Return transcoded string." results))) (plist-get info :exported-data)))))) -(defun org-export-data-with-translations (data translations info) - "Convert DATA into another format using a given translation table. -DATA is an element, an object, a secondary string or a string. -TRANSLATIONS is an alist between element or object types and -a functions handling them. See `org-export-define-backend' for -more information. INFO is a plist used as a communication -channel." - (org-export-data - data - ;; Set-up a new communication channel with TRANSLATIONS as the - ;; translate table and a new hash table for memoization. - (org-combine-plists - info - (list :translate-alist translations - ;; Size of the hash table is reduced since this function - ;; will probably be used on short trees. - :exported-data (make-hash-table :test 'eq :size 401))))) - (defun org-export-data-with-backend (data backend info) "Convert DATA into BACKEND format. @@ -2216,9 +2237,18 @@ channel. Unlike to `org-export-with-backend', this function will recursively convert DATA using BACKEND translation table." - (org-export-barf-if-invalid-backend backend) - (org-export-data-with-translations - data (org-export-backend-translate-table backend) info)) + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-data + data + ;; Set-up a new communication channel with translations defined in + ;; BACKEND as the translate table and a new hash table for + ;; memoization. + (org-combine-plists + info + (list :translate-alist (org-export-get-all-transcoders backend) + ;; Size of the hash table is reduced since this function + ;; will probably be used on short trees. + :exported-data (make-hash-table :test 'eq :size 401))))) (defun org-export--interpret-p (blob info) "Non-nil if element or object BLOB should be interpreted during export. @@ -2712,18 +2742,19 @@ channel, as a plist. It must return a string or nil.") "Call every function in FILTERS. Functions are called with arguments VALUE, current export -back-end and INFO. A function returning a nil value will be -skipped. If it returns the empty string, the process ends and +back-end's name and INFO. A function returning a nil value will +be skipped. If it returns the empty string, the process ends and VALUE is ignored. Call is done in a LIFO fashion, to be sure that developer specified filters, if any, are called first." (catch 'exit - (dolist (filter filters value) - (let ((result (funcall filter value (plist-get info :back-end) info))) - (cond ((not result) value) - ((equal value "") (throw 'exit nil)) - (t (setq value result))))))) + (let ((backend-name (plist-get info :back-end))) + (dolist (filter filters value) + (let ((result (funcall filter value backend-name info))) + (cond ((not result) value) + ((equal value "") (throw 'exit nil)) + (t (setq value result)))))))) (defun org-export-install-filters (info) "Install filters properties in communication channel. @@ -2754,7 +2785,7 @@ Return the updated communication channel." plist key (if (atom value) (cons value (plist-get plist key)) (append value (plist-get plist key)))))))) - (org-export-backend-filters (plist-get info :back-end))) + (org-export-get-all-filters (plist-get info :back-end))) ;; Return new communication channel. (org-combine-plists info plist))) @@ -2890,6 +2921,10 @@ The function assumes BUFFER's major mode is `org-mode'." (backend &optional subtreep visible-only body-only ext-plist) "Transcode current Org buffer into BACKEND code. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + If narrowing is active in the current buffer, only transcode its narrowed part. @@ -2910,6 +2945,7 @@ with external parameters overriding Org default settings, but still inferior to file-local settings. Return code as a string." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) (org-export-barf-if-invalid-backend backend) (save-excursion (save-restriction @@ -2942,8 +2978,9 @@ Return code as a string." ;; created, where include keywords, macros are expanded and ;; code blocks are evaluated. (org-export-with-buffer-copy - ;; Run first hook with current back-end as argument. - (run-hook-with-args 'org-export-before-processing-hook backend) + ;; Run first hook with current back-end's name as argument. + (run-hook-with-args 'org-export-before-processing-hook + (org-export-backend-name backend)) (org-export-expand-include-keyword) ;; Update macro templates since #+INCLUDE keywords might have ;; added some new ones. @@ -2953,10 +2990,11 @@ Return code as a string." ;; Update radio targets since keyword inclusion might have ;; added some more. (org-update-radio-target-regexp) - ;; Run last hook with current back-end as argument. + ;; Run last hook with current back-end's name as argument. (goto-char (point-min)) (save-excursion - (run-hook-with-args 'org-export-before-parsing-hook backend)) + (run-hook-with-args 'org-export-before-parsing-hook + (org-export-backend-name backend))) ;; Update communication channel with environment. Also ;; install user's and developer's filters. (setq info @@ -2979,9 +3017,10 @@ Return code as a string." ;; Call options filters and update export options. We do not ;; use `org-export-filter-apply-functions' here since the ;; arity of such filters is different. - (dolist (filter (plist-get info :filter-options)) - (let ((result (funcall filter info backend))) - (when result (setq info result)))) + (let ((backend-name (org-export-backend-name backend))) + (dolist (filter (plist-get info :filter-options)) + (let ((result (funcall filter info backend-name))) + (when result (setq info result))))) ;; Parse buffer and call parse-tree filter on it. (setq tree (org-export-filter-apply-functions @@ -3017,7 +3056,9 @@ Return code as a string." (backend buffer &optional subtreep visible-only body-only ext-plist) "Call `org-export-as' with output to a specified buffer. -BACKEND is the back-end used for transcoding, as a symbol. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. BUFFER is the output buffer. If it already exists, it will be erased first, otherwise, it will be created. @@ -3045,8 +3086,10 @@ to kill ring. Return buffer." (backend file &optional subtreep visible-only body-only ext-plist) "Call `org-export-as' with output to a specified file. -BACKEND is the back-end used for transcoding, as a symbol. FILE -is the name of the output file, as a string. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. FILE is the name of the output file, as +a string. Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and EXT-PLIST are similar to those used in `org-export-as', which @@ -3073,6 +3116,10 @@ to kill ring. Return output file's name." (defun org-export-string-as (string backend &optional body-only ext-plist) "Transcode STRING into BACKEND code. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + When optional argument BODY-ONLY is non-nil, only return body code, without preamble nor postamble. @@ -3088,7 +3135,10 @@ Return code as a string." ;;;###autoload (defun org-export-replace-region-by (backend) - "Replace the active region by its export to BACKEND." + "Replace the active region by its export to BACKEND. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end." (if (not (org-region-active-p)) (user-error "No active region to replace") (let* ((beg (region-beginning)) @@ -3102,10 +3152,10 @@ Return code as a string." (defun org-export-insert-default-template (&optional backend subtreep) "Insert all export keywords with default values at beginning of line. -BACKEND is a symbol representing the export back-end for which -specific export options should be added to the template, or -`default' for default template. When it is nil, the user will be -prompted for a category. +BACKEND is a symbol referring to the name of a registered export +back-end, for which specific export options should be added to +the template, or `default' for default template. When it is nil, +the user will be prompted for a category. If SUBTREEP is non-nil, export configuration will be set up locally for the subtree through node properties." @@ -3114,17 +3164,22 @@ locally for the subtree through node properties." (when (and subtreep (org-before-first-heading-p)) (user-error "No subtree to set export options for")) (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point)))) - (backend (or backend - (intern - (org-completing-read - "Options category: " - (cons "default" - (mapcar (lambda (b) (symbol-name (car b))) - org-export-registered-backends)))))) + (backend + (or backend + (intern + (org-completing-read + "Options category: " + (cons "default" + (mapcar (lambda (b) + (symbol-name (org-export-backend-name b))) + org-export--registered-backends)))))) options keywords) ;; Populate OPTIONS and KEYWORDS. - (dolist (entry (if (eq backend 'default) org-export-options-alist - (org-export-backend-options backend))) + (dolist (entry (cond ((eq backend 'default) org-export-options-alist) + ((org-export-backend-p backend) + (org-export-get-all-options backend)) + (t (org-export-get-all-options + (org-export-get-backend backend))))) (let ((keyword (nth 1 entry)) (option (nth 2 entry))) (cond @@ -3501,16 +3556,20 @@ Caption lines are separated by a white space." ;; back-end, it may be used as a fall-back function once all specific ;; cases have been treated. -(defun org-export-with-backend (back-end data &optional contents info) - "Call a transcoder from BACK-END on DATA. -CONTENTS, when non-nil, is the transcoded contents of DATA -element, as a string. INFO, when non-nil, is the communication -channel used for export, as a plist.." - (org-export-barf-if-invalid-backend back-end) +(defun org-export-with-backend (backend data &optional contents info) + "Call a transcoder from BACKEND on DATA. +BACKEND is an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. DATA is an Org element, object, secondary +string or string. CONTENTS, when non-nil, is the transcoded +contents of DATA element, as a string. INFO, when non-nil, is +the communication channel used for export, as a plist." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-barf-if-invalid-backend backend) (let ((type (org-element-type data))) (if (memq type '(nil org-data)) (error "No foreign transcoder available") (let ((transcoder - (cdr (assq type (org-export-backend-translate-table back-end))))) + (cdr (assq type (org-export-get-all-transcoders backend))))) (if (functionp transcoder) (funcall transcoder data contents info) (error "No foreign transcoder available")))))) @@ -4892,7 +4951,20 @@ Return a list of src-block elements with a caption." ;; `org-export-smart-quotes-regexps'. (defconst org-export-smart-quotes-alist - '(("de" + '(("da" + ;; one may use: »...«, "...", ›...‹, or '...'. + ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ + ;; LaTeX quotes require Babel! + (opening-double-quote :utf-8 "»" :html "»" :latex ">>" + :texinfo "@guillemetright{}") + (closing-double-quote :utf-8 "«" :html "«" :latex "<<" + :texinfo "@guillemetleft{}") + (opening-single-quote :utf-8 "›" :html "›" :latex "\\frq{}" + :texinfo "@guilsinglright{}") + (closing-single-quote :utf-8 "‹" :html "‹" :latex "\\flq{}" + :texinfo "@guilsingleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("de" (opening-double-quote :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") (closing-double-quote :utf-8 "“" :html "“" :latex "\"'" @@ -4925,7 +4997,42 @@ Return a list of src-block elements with a caption." :texinfo "@guillemetleft{}@tie{}") (closing-single-quote :utf-8 " »" :html " »" :latex "\\fg{}" :texinfo "@tie{}@guillemetright{}") - (apostrophe :utf-8 "’" :html "’"))) + (apostrophe :utf-8 "’" :html "’")) + ("no" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nb" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nn" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("sv" + ;; based on https://sv.wikipedia.org/wiki/Citattecken + (opening-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (closing-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (opening-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ) "Smart quotes translations. Alist whose CAR is a language string and CDR is an alist with @@ -5208,16 +5315,17 @@ them." ;;;; Translation ;; -;; `org-export-translate' translates a string according to language -;; specified by LANGUAGE keyword or `org-export-language-setup' -;; variable and a specified charset. `org-export-dictionary' contains +;; `org-export-translate' translates a string according to the language +;; specified by the LANGUAGE keyword. `org-export-dictionary' contains ;; the dictionary used for the translation. (defconst org-export-dictionary - '(("Author" + '(("%e %n: %c" + ("fr" :default "%e %n : %c" :html "%e %n : %c")) + ("Author" ("ca" :default "Autor") ("cs" :default "Autor") - ("da" :default "Ophavsmand") + ("da" :default "Forfatter") ("de" :default "Autor") ("eo" :html "Aŭtoro") ("es" :default "Autor") @@ -5260,15 +5368,43 @@ them." ("zh-CN" :html "日期" :utf-8 "日期") ("zh-TW" :html "日期" :utf-8 "日期")) ("Equation" - ("fr" :ascii "Equation" :default "Équation")) - ("Figure") + ("da" :default "Ligning") + ("de" :default "Gleichung") + ("es" :html "Ecuación" :default "Ecuación") + ("fr" :ascii "Equation" :default "Équation") + ("no" :default "Ligning") + ("nb" :default "Ligning") + ("nn" :default "Likning") + ("sv" :default "Ekvation") + ("zh-CN" :html "方程" :utf-8 "方程")) + ("Figure" + ("da" :default "Figur") + ("de" :default "Abbildung") + ("es" :default "Figura") + ("ja" :html "図" :utf-8 "図") + ("no" :default "Illustrasjon") + ("nb" :default "Illustrasjon") + ("nn" :default "Illustrasjon") + ("sv" :default "Illustration") + ("zh-CN" :html "图" :utf-8 "图")) + ("Figure %d:" + ("da" :default "Figur %d") + ("de" :default "Abbildung %d:") + ("es" :default "Figura %d:") + ("fr" :default "Figure %d :" :html "Figure %d :") + ("ja" :html "図%d: " :utf-8 "図%d: ") + ("no" :default "Illustrasjon %d") + ("nb" :default "Illustrasjon %d") + ("nn" :default "Illustrasjon %d") + ("sv" :default "Illustration %d") + ("zh-CN" :html "图%d " :utf-8 "图%d ")) ("Footnotes" ("ca" :html "Peus de pàgina") ("cs" :default "Pozn\xe1mky pod carou") ("da" :default "Fodnoter") - ("de" :html "Fußnoten") + ("de" :html "Fußnoten" :default "Fußnoten") ("eo" :default "Piednotoj") - ("es" :html "Pies de página") + ("es" :html "Nota al pie de página" :default "Nota al pie de página") ("fi" :default "Alaviitteet") ("fr" :default "Notes de bas de page") ("hu" :html "Lábjegyzet") @@ -5287,26 +5423,54 @@ them." ("zh-CN" :html "脚注" :utf-8 "脚注") ("zh-TW" :html "腳註" :utf-8 "腳註")) ("List of Listings" - ("fr" :default "Liste des programmes")) + ("da" :default "Programmer") + ("de" :default "Programmauflistungsverzeichnis") + ("es" :default "Indice de Listados de programas") + ("fr" :default "Liste des programmes") + ("no" :default "Dataprogrammer") + ("nb" :default "Dataprogrammer") + ("zh-CN" :html "代码目录" :utf-8 "代码目录")) ("List of Tables" - ("fr" :default "Liste des tableaux")) + ("da" :default "Tabeller") + ("de" :default "Tabellenverzeichnis") + ("es" :default "Indice de tablas") + ("fr" :default "Liste des tableaux") + ("no" :default "Tabeller") + ("nb" :default "Tabeller") + ("nn" :default "Tabeller") + ("sv" :default "Tabeller") + ("zh-CN" :html "表格目录" :utf-8 "表格目录")) ("Listing %d:" - ("fr" - :ascii "Programme %d :" :default "Programme nº %d :" - :latin1 "Programme %d :")) - ("Listing %d: %s" - ("fr" - :ascii "Programme %d : %s" :default "Programme nº %d : %s" - :latin1 "Programme %d : %s")) + ("da" :default "Program %d") + ("de" :default "Programmlisting %d") + ("es" :default "Listado de programa %d") + ("fr" :default "Programme %d :" :html "Programme %d :") + ("no" :default "Dataprogram") + ("nb" :default "Dataprogram") + ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) ("See section %s" - ("fr" :default "cf. section %s")) + ("da" :default "jævnfør afsnit %s") + ("de" :default "siehe Abschnitt %s") + ("es" :default "vea seccion %s") + ("fr" :default "cf. section %s") + ("zh-CN" :html "参见第%d节" :utf-8 "参见第%s节")) + ("Table" + ("de" :default "Tabelle") + ("es" :default "Tabla") + ("fr" :default "Tableau") + ("ja" :html "表" :utf-8 "表") + ("zh-CN" :html "表" :utf-8 "表")) ("Table %d:" - ("fr" - :ascii "Tableau %d :" :default "Tableau nº %d :" :latin1 "Tableau %d :")) - ("Table %d: %s" - ("fr" - :ascii "Tableau %d : %s" :default "Tableau nº %d : %s" - :latin1 "Tableau %d : %s")) + ("da" :default "Tabel %d") + ("de" :default "Tabelle %d") + ("es" :default "Tabla %d") + ("fr" :default "Tableau %d :") + ("ja" :html "表%d:" :utf-8 "表%d:") + ("no" :default "Tabell %d") + ("nb" :default "Tabell %d") + ("nn" :default "Tabell %d") + ("sv" :default "Tabell %d") + ("zh-CN" :html "表%d " :utf-8 "表%d ")) ("Table of Contents" ("ca" :html "Índex") ("cs" :default "Obsah") @@ -5332,7 +5496,11 @@ them." ("zh-CN" :html "目录" :utf-8 "目录") ("zh-TW" :html "目錄" :utf-8 "目錄")) ("Unknown reference" - ("fr" :ascii "Destination inconnue" :default "Référence inconnue"))) + ("da" :default "ukendt reference") + ("de" :default "Unbekannter Verweis") + ("es" :default "referencia desconocida") + ("fr" :ascii "Destination inconnue" :default "Référence inconnue") + ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) "Dictionary for export engine. Alist whose CAR is the string to translate and CDR is an alist @@ -5738,43 +5906,31 @@ back to standard interface." (lambda (value) ;; Fontify VALUE string. (org-propertize value 'face 'font-lock-variable-name-face))) - ;; Prepare menu entries by extracting them from - ;; `org-export-registered-backends', and sorting them by - ;; access key and by ordinal, if any. - (backends - (sort - (sort - (delq nil - (mapcar - (lambda (b) - (let ((name (car b))) - (catch 'ignored - ;; Ignore any back-end belonging to - ;; `org-export-invisible-backends' or derived - ;; from one of them. - (dolist (ignored org-export-invisible-backends) - (when (org-export-derived-backend-p name ignored) - (throw 'ignored nil))) - (org-export-backend-menu name)))) - org-export-registered-backends)) - (lambda (a b) - (let ((key-a (nth 1 a)) - (key-b (nth 1 b))) - (cond ((and (numberp key-a) (numberp key-b)) - (< key-a key-b)) - ((numberp key-b) t))))) - (lambda (a b) (< (car a) (car b))))) + ;; Prepare menu entries by extracting them from registered + ;; back-ends and sorting them by access key and by ordinal, + ;; if any. + (entries + (sort (sort (delq nil + (mapcar 'org-export-backend-menu + org-export--registered-backends)) + (lambda (a b) + (let ((key-a (nth 1 a)) + (key-b (nth 1 b))) + (cond ((and (numberp key-a) (numberp key-b)) + (< key-a key-b)) + ((numberp key-b) t))))) + 'car-less-than-car)) ;; Compute a list of allowed keys based on the first key ;; pressed, if any. Some keys ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always ;; available. (allowed-keys (nconc (list 2 22 19 6 1) - (if (not first-key) (org-uniquify (mapcar 'car backends)) + (if (not first-key) (org-uniquify (mapcar 'car entries)) (let (sub-menu) - (dolist (backend backends (sort (mapcar 'car sub-menu) '<)) - (when (eq (car backend) first-key) - (setq sub-menu (append (nth 2 backend) sub-menu)))))) + (dolist (entry entries (sort (mapcar 'car sub-menu) '<)) + (when (eq (car entry) first-key) + (setq sub-menu (append (nth 2 entry) sub-menu)))))) (cond ((eq first-key ?P) (list ?f ?p ?x ?a)) ((not first-key) (list ?P))) (list ?& ?#) @@ -5833,7 +5989,7 @@ back to standard interface." (nth 1 sub-entry))) sub-menu "") (when (zerop (mod index 2)) "\n")))))))) - backends "")) + entries "")) ;; Publishing menu is hard-coded. (format "\n[%s] Publish [%s] Current file [%s] Current project @@ -5868,7 +6024,7 @@ back to standard interface." ;; UI, display an intrusive help buffer. (if expertp (org-export--dispatch-action - expert-prompt allowed-keys backends options first-key expertp) + expert-prompt allowed-keys entries options first-key expertp) ;; At first call, create frame layout in order to display menu. (unless (get-buffer "*Org Export Dispatcher*") (delete-other-windows) @@ -5891,15 +6047,15 @@ back to standard interface." (set-window-start nil pos))) (org-fit-window-to-buffer) (org-export--dispatch-action - standard-prompt allowed-keys backends options first-key expertp)))) + standard-prompt allowed-keys entries options first-key expertp)))) (defun org-export--dispatch-action - (prompt allowed-keys backends options first-key expertp) + (prompt allowed-keys entries options first-key expertp) "Read a character from command input and act accordingly. PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is a list of characters available at a given step in the process. -BACKENDS is a list of menu entries. OPTIONS, FIRST-KEY and +ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and EXPERTP are the same as defined in `org-export--dispatch-ui', which see. @@ -5956,9 +6112,9 @@ options as CDR." first-key expertp)) ;; Action selected: Send key and options back to ;; `org-export-dispatch'. - ((or first-key (functionp (nth 2 (assq key backends)))) + ((or first-key (functionp (nth 2 (assq key entries)))) (cons (cond - ((not first-key) (nth 2 (assq key backends))) + ((not first-key) (nth 2 (assq key entries))) ;; Publishing actions are hard-coded. Send a special ;; signal to `org-export-dispatch'. ((eq first-key ?P) @@ -5971,10 +6127,10 @@ options as CDR." ;; path. Indeed, derived backends can share the same ;; FIRST-KEY. (t (catch 'found - (mapc (lambda (backend) - (let ((match (assq key (nth 2 backend)))) + (mapc (lambda (entry) + (let ((match (assq key (nth 2 entry)))) (when match (throw 'found (nth 2 match))))) - (member (assq first-key backends) backends))))) + (member (assq first-key entries) entries))))) options)) ;; Otherwise, enter sub-menu. (t (org-export--dispatch-ui options key expertp))))) diff --git a/testing/examples/babel.org b/testing/examples/babel.org index 15f97175a..b1f170242 100644 --- a/testing/examples/babel.org +++ b/testing/examples/babel.org @@ -359,3 +359,94 @@ Here is a call line with more than just the results exported. <> echo "1$i" #+END_SRC + +* use case of reading entry properties + :PROPERTIES: + :ID: cc5fbc20-bca5-437a-a7b8-2b4d7a03f820 + :END: + +Use case checked and documented with this test: During their +evaluation the source blocks read values from properties from the +entry where the call has been made unless the value is overridden with +the optional argument of the caller. + +** section + :PROPERTIES: + :a: 1 + :c: 3 + :END: + +Note: Just export of a property can be done with a macro: {{{property(a)}}}. + +#+NAME: src_block_location_shell sect call +#+CALL: src_block_location_shell() + +#+NAME: src_block_location_elisp sect call +#+CALL: src_block_location_elisp() + +- sect inline call_src_block_location_shell() +- sect inline call_src_block_location_elisp() + +*** subsection + :PROPERTIES: + :b: 2 + :c: 4 + :END: + +#+NAME: src_block_location_shell sub0 call +#+CALL: src_block_location_shell() + +#+NAME: src_block_location_elisp sub0 call +#+CALL: src_block_location_elisp() + +- sub0 inline call_src_block_location_shell() +- sub0 inline call_src_block_location_elisp() + +#+NAME: src_block_location_shell sub1 call +#+CALL: src_block_location_shell(c=5, e=6) + +#+NAME: src_block_location_elisp sub1 call +#+CALL: src_block_location_elisp(c=5, e=6) + +- sub1 inline call_src_block_location_shell(c=5, e=6) +- sub1 inline call_src_block_location_elisp(c=5, e=6) + +**** function definition + +#+NAME: src_block_location_shell +#+HEADER: :var a=(or (org-entry-get org-babel-current-src-block-location "a" t) "0") +#+HEADER: :var b=(or (org-entry-get org-babel-current-src-block-location "b" t) "0") +#+HEADER: :var c=(or (org-entry-get org-babel-current-src-block-location "c" t) "0") +#+HEADER: :var d=(or (org-entry-get org-babel-current-src-block-location "d" t) "0") +#+HEADER: :var e=(or (org-entry-get org-babel-current-src-block-location "e" t) "0") +#+BEGIN_SRC sh :shebang #!/bin/sh :exports results :results verbatim + printf "shell a:$a, b:$b, c:$c, d:$d, e:$e" +#+END_SRC + +#+RESULTS: src_block_location_shell + +#+NAME: src_block_location_elisp +#+HEADER: :var a='nil +#+HEADER: :var b='nil +#+HEADER: :var c='nil +#+HEADER: :var d='nil +#+HEADER: :var e='nil +#+BEGIN_SRC emacs-lisp :exports results + (setq + a (or a (string-to-number + (or (org-entry-get org-babel-current-src-block-location "a" t) + "0"))) + b (or b (string-to-number + (or (org-entry-get org-babel-current-src-block-location "b" t) + "0"))) + c (or c (string-to-number + (or (org-entry-get org-babel-current-src-block-location "c" t) + "0"))) + d (or d (string-to-number + (or (org-entry-get org-babel-current-src-block-location "e" t) + "0"))) + e (or e (string-to-number + (or (org-entry-get org-babel-current-src-block-location "d" t) + "0")))) + (format "elisp a:%d, b:%d, c:%d, d:%d, e:%d" a b c d e) +#+END_SRC diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el index abfe2309b..d2541d3fc 100644 --- a/testing/lisp/test-ob-exp.el +++ b/testing/lisp/test-ob-exp.el @@ -216,6 +216,48 @@ Here is one at the end of a line. =2= (should-not (string-match (regexp-quote "<>") result)) (should-not (string-match (regexp-quote "i=\"10\"") result))))) +(ert-deftest ob-exp/use-case-of-reading-entry-properties () + (org-test-at-id "cc5fbc20-bca5-437a-a7b8-2b4d7a03f820" + (org-narrow-to-subtree) + (let* ((case-fold-search nil) + (result (org-test-with-expanded-babel-code (buffer-string))) + (sect "a:1, b:0, c:3, d:0, e:0") + (sub0 "a:1, b:2, c:4, d:0, e:0") + (sub1 "a:1, b:2, c:5, d:0, e:6") + (func sub0)) + ;; entry "section" + (should (string-match (concat "_shell sect call\n: shell " sect "\n") + result)) + (should (string-match (concat "_elisp sect call\n: elisp " sect "\n") + result)) + (should (string-match (concat "\n- sect inline =shell " sect "=\n") + result)) + (should (string-match (concat "\n- sect inline =elisp " sect "=\n") + result)) + ;; entry "subsection", call without arguments + (should (string-match (concat "_shell sub0 call\n: shell " sub0 "\n") + result)) + (should (string-match (concat "_elisp sub0 call\n: elisp " sub0 "\n") + result)) + (should (string-match (concat "\n- sub0 inline =shell " sub0 "=\n") + result)) + (should (string-match (concat "\n- sub0 inline =elisp " sub0 "=\n") + result)) + ;; entry "subsection", call with arguments + (should (string-match (concat "_shell sub1 call\n: shell " sub1 "\n") + result)) + (should (string-match (concat "_elisp sub1 call\n: elisp " sub1 "\n") + result)) + (should (string-match (concat "\n- sub1 inline =shell " sub1 "=\n") + result)) + (should (string-match (concat "\n- sub1 inline =elisp " sub1 "=\n") + result)) + ;; entry "function definition" + (should (string-match (concat "_location_shell\n: shell " func "\n") + result)) + (should (string-match (concat "_location_elisp\n: elisp " func "\n") + result))))) + (ert-deftest ob-exp/export-from-a-temp-buffer () :expected-result :failed (org-test-with-temp-text diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 6a8403ef9..11925899e 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -1144,6 +1144,29 @@ echo \"$data\" (org-babel-execute-src-block) (buffer-string))))) +(ert-deftest test-ob/location-of-header-arg-eval () + "Test location of header argument evaluation." + (org-test-with-temp-text " +#+name: top-block +#+begin_src emacs-lisp :var pt=(point) + pt +#+end_src + +#+name: bottom-block +#+begin_src emacs-lisp :var pt=top-block() + pt +#+end_src +" + ;; the value of the second block should be greater than the first + (should + (< (progn (re-search-forward org-babel-src-block-regexp nil t) + (goto-char (match-beginning 0)) + (prog1 (save-match-data (org-babel-execute-src-block)) + (goto-char (match-end 0)))) + (progn (re-search-forward org-babel-src-block-regexp nil t) + (goto-char (match-beginning 0)) + (org-babel-execute-src-block)))))) + (provide 'test-ob) ;;; test-ob ends here diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 8133c0bdd..2129cdede 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -1511,7 +1511,12 @@ Outside list" ;; Move to ending of outer list. (progn (goto-char (car endings)) (looking-at "Outside list")) ;; Move to ending of inner list. - (progn (goto-char (nth 1 endings)) (looking-at "^$")))))))) + (progn (goto-char (nth 1 endings)) (looking-at "^$"))))))) + ;; Correctly compute end of list if it doesn't end at a line + ;; beginning. + (should + (org-test-with-temp-text "- list\n \n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Planning @@ -2139,30 +2144,38 @@ Outside list" (ert-deftest test-org-element/plain-list-interpreter () "Test plain-list and item interpreters." (let ((org-list-two-spaces-after-bullet-regexp nil)) - ;; 1. Unordered list. + ;; Unordered list. (should (equal (org-test-parse-and-interpret "- item 1") "- item 1\n")) - ;; 2. Description list. + ;; Description list. (should (equal (org-test-parse-and-interpret "- tag :: desc") "- tag :: desc\n")) - ;; 3. Ordered list. + ;; Ordered list. (should (equal (let ((org-plain-list-ordered-item-terminator t)) (org-test-parse-and-interpret "1. Item")) "1. Item\n")) - ;; 4. Ordered list with counter. + (should + (equal (let ((org-plain-list-ordered-item-terminator ?\))) + (org-test-parse-and-interpret "1) Item")) + "1) Item\n")) + ;; Ordered list with counter. (should (equal (let ((org-plain-list-ordered-item-terminator t)) (org-test-parse-and-interpret "1. [@5] Item")) "5. [@5] Item\n")) - ;; 5. List with check-boxes. + ;; List with check-boxes. (should (equal (org-test-parse-and-interpret "- [-] Item 1\n - [X] Item 2\n - [ ] Item 3") "- [-] Item 1\n - [X] Item 2\n - [ ] Item 3\n")) - ;; 6. Item not starting with a paragraph. + ;; Item not starting with a paragraph. (should (equal (org-test-parse-and-interpret "-\n | a | b |") - "- \n | a | b |\n")))) + "- \n | a | b |\n")) + ;; Special case: correctly handle "*" bullets. + (should (org-test-parse-and-interpret " * item")) + ;; Special case: correctly handle empty items. + (should (org-test-parse-and-interpret "-")))) (ert-deftest test-org-element/quote-block-interpreter () "Test quote block interpreter." @@ -2848,7 +2861,12 @@ Paragraph \\alpha." "- outer\n #+begin_center\n - inner\n #+end_center" (search-forward "inner") (beginning-of-line) - (org-element-type (org-element-at-point)))))) + (org-element-type (org-element-at-point))))) + ;; Do not error at eob on an empty line. + (should + (org-test-with-temp-text "* H\n" + (forward-line) + (or (org-element-at-point) t)))) (ert-deftest test-org-element/context () "Test `org-element-context' specifications." diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 6aa0de72b..504defad0 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -69,7 +69,8 @@ (goto-char (point-max)) (call-interactively 'comment-dwim) (buffer-string))))) - ;; Region selected without comments: comment all non-blank lines. + ;; Region selected without comments: comment all lines if + ;; `comment-empty-lines' is non-nil, only non-blank lines otherwise. (should (equal "# Comment 1\n\n# Comment 2" (org-test-with-temp-text "Comment 1\n\nComment 2" @@ -77,7 +78,18 @@ (transient-mark-mode 1) (push-mark (point) t t) (goto-char (point-max)) - (call-interactively 'comment-dwim) + (let ((comment-empty-lines nil)) + (call-interactively 'comment-dwim)) + (buffer-string))))) + (should + (equal "# Comment 1\n# \n# Comment 2" + (org-test-with-temp-text "Comment 1\n\nComment 2" + (progn + (transient-mark-mode 1) + (push-mark (point) t t) + (goto-char (point-max)) + (let ((comment-empty-lines t)) + (call-interactively 'comment-dwim)) (buffer-string))))) ;; In front of a keyword without region, insert a new comment. (should @@ -199,6 +211,20 @@ (let ((fill-column 20)) (org-fill-paragraph) (buffer-string))))) + ;; Do not mix consecutive comments when filling one of them. + (should + (equal "# A B\n\n# C" + (org-test-with-temp-text "# A\n# B\n\n# C" + (let ((fill-column 20)) + (org-fill-paragraph) + (buffer-string))))) + ;; Use commented empty lines as separators when filling comments. + (should + (equal "# A B\n#\n# C" + (org-test-with-temp-text "# A\n# B\n#\n# C" + (let ((fill-column 20)) + (org-fill-paragraph) + (buffer-string))))) ;; Do nothing at affiliated keywords. (org-test-with-temp-text "#+NAME: para\nSome\ntext." (let ((fill-column 20)) diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index cbae08a82..abe980c62 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -24,30 +24,22 @@ (unless (featurep 'ox) (signal 'missing-test-dependency "org-export")) -(defmacro org-test-with-backend (backend &rest body) - "Execute body with an export back-end defined. - -BACKEND is the name of the back-end. BODY is the body to -execute. The defined back-end simply returns parsed data as Org -syntax." - (declare (debug (form body)) (indent 1)) - `(let ((org-export-registered-backends - ',(list - (list backend - :translate-alist - (let (transcode-table) - (dolist (type (append org-element-all-elements - org-element-all-objects) - transcode-table) - (push - (cons type - (lambda (obj contents info) - (funcall - (intern (format "org-element-%s-interpreter" - type)) - obj contents))) - transcode-table))))))) - (progn ,@body))) +(defun org-test-default-backend () + "Return a default export back-end. +This back-end simply returns parsed data as Org syntax." + (org-export-create-backend + :transcoders (let (transcode-table) + (dolist (type (append org-element-all-elements + org-element-all-objects) + transcode-table) + (push + (cons type + (lambda (obj contents info) + (funcall + (intern (format "org-element-%s-interpreter" + type)) + obj contents))) + transcode-table))))) (defmacro org-test-with-parsed-data (data &rest body) "Execute body with parsed data available. @@ -108,12 +100,12 @@ already filled in `info'." (should (equal "Yes\n" (org-test-with-temp-text "#+BIND: test-ox-var value" - (let ((org-export-allow-bind-keywords t) - org-export-registered-backends) - (org-export-define-backend 'check + (let ((org-export-allow-bind-keywords t)) + (org-export-as + (org-export-create-backend + :transcoders '((section . (lambda (s c i) - (if (eq test-ox-var 'value) "Yes" "No"))))) - (org-export-as 'check)))))) + (if (eq test-ox-var 'value) "Yes" "No"))))))))))) (ert-deftest test-org-export/parse-option-keyword () "Test reading all standard #+OPTIONS: items." @@ -191,7 +183,15 @@ already filled in `info'." org-test-dir) (org-export--get-inbuffer-options)) '(:description "l1\nl2\nl3":language "fr" :select-tags ("a" "b" "c") - :title ("a b c"))))) + :title ("a b c")))) + ;; More than one property can refer to the same buffer keyword. + (should + (equal '(:k2 "value" :k1 "value") + (let ((backend (org-export-create-backend + :options '((:k1 "KEYWORD") + (:k2 "KEYWORD"))))) + (org-test-with-temp-text "#+KEYWORD: value" + (org-export--get-inbuffer-options backend)))))) (ert-deftest test-org-export/get-subtree-options () "Test setting options from headline's properties." @@ -276,14 +276,14 @@ Paragraph" 'equal (org-test-with-temp-text-in-file "Test" (org-mode) - (let (org-export-registered-backends) - (org-export-define-backend 'test - '((template . (lambda (text info) - (org-element-interpret-data - (plist-get info :title) info))))) - (list (org-export-as 'test) - (file-name-nondirectory - (file-name-sans-extension (buffer-file-name)))))))) + (list (org-export-as + (org-export-create-backend + :transcoders + '((template . (lambda (text info) + (org-element-interpret-data + (plist-get info :title) info)))))) + (file-name-nondirectory + (file-name-sans-extension (buffer-file-name))))))) ;; If no title is specified, and no file is associated to the ;; buffer, use buffer's name. (should @@ -291,36 +291,37 @@ Paragraph" 'equal (org-test-with-temp-text "Test" (org-mode) - (let (org-export-registered-backends) - (org-export-define-backend 'test - '((template . (lambda (text info) - (org-element-interpret-data - (plist-get info :title) info))))) - (list (org-export-as 'test) (buffer-name)))))) + (list (org-export-as + (org-export-create-backend + :transcoders + '((template . (lambda (text info) + (org-element-interpret-data + (plist-get info :title) info)))))) + (buffer-name))))) ;; If a title is specified, use it. (should (equal "Title" (org-test-with-temp-text-in-file "#+TITLE: Title\nTest" (org-mode) - (let (org-export-registered-backends) - (org-export-define-backend 'test - '((template . (lambda (text info) - (org-element-interpret-data - (plist-get info :title) info))))) - (org-export-as 'test))))) + (org-export-as + (org-export-create-backend + :transcoders + '((template . (lambda (text info) + (org-element-interpret-data + (plist-get info :title) info))))))))) ;; If an empty title is specified, do not set it. (should (equal "" (org-test-with-temp-text-in-file "#+TITLE:\nTest" (org-mode) - (let (org-export-registered-backends) - (org-export-define-backend 'test - '((template . (lambda (text info) - (org-element-interpret-data - (plist-get info :title) info))))) - (org-export-as 'test)))))) + (org-export-as + (org-export-create-backend + :transcoders + '((template . (lambda (text info) + (org-element-interpret-data + (plist-get info :title) info)))))))))) (ert-deftest test-org-export/handle-options () "Test if export options have an impact on output." @@ -328,142 +329,148 @@ Paragraph" (should (equal "" (org-test-with-temp-text "* Head1 :noexp:" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:exclude-tags ("noexp"))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:exclude-tags ("noexp")))))) ;; Test include tags for headlines and inlinetasks. (should (equal "* H2\n** Sub :exp:\n*** Sub Sub\n" (org-test-with-temp-text "* H1\n* H2\n** Sub :exp:\n*** Sub Sub\n* H3" (let ((org-tags-column 0)) - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:select-tags ("exp")))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:select-tags ("exp"))))))) ;; Test mixing include tags and exclude tags. - (org-test-with-temp-text " + (should + (string-match + "\\* Head1[ \t]+:export:\n\\*\\* Sub-Head2\n" + (org-test-with-temp-text " * Head1 :export: ** Sub-Head1 :noexport: ** Sub-Head2 * Head2 :noexport: ** Sub-Head1 :export:" - (org-test-with-backend test - (should - (string-match - "\\* Head1[ \t]+:export:\n\\*\\* Sub-Head2\n" - (org-export-as - 'test nil nil nil - '(:select-tags ("export") :exclude-tags ("noexport"))))))) + (org-export-as (org-test-default-backend) nil nil nil + '(:select-tags ("export") :exclude-tags ("noexport")))))) ;; Ignore tasks. (should (equal "" (let ((org-todo-keywords '((sequence "TODO" "DONE")))) (org-test-with-temp-text "* TODO Head1" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:with-tasks nil))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-tasks nil)))))) (should (equal "* TODO Head1\n" (let ((org-todo-keywords '((sequence "TODO" "DONE")))) (org-test-with-temp-text "* TODO Head1" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:with-tasks t))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-tasks t)))))) ;; Archived tree. - (org-test-with-temp-text "* Head1 :archive:" - (let ((org-archive-tag "archive")) - (org-test-with-backend test - (should - (equal (org-export-as 'test nil nil nil '(:with-archived-trees nil)) - ""))))) - (org-test-with-temp-text "* Head1 :archive:\nbody\n** Sub-head 2" - (let ((org-archive-tag "archive")) - (org-test-with-backend test - (should - (string-match - "\\* Head1[ \t]+:archive:" - (org-export-as 'test nil nil nil - '(:with-archived-trees headline))))))) - (org-test-with-temp-text "* Head1 :archive:" - (let ((org-archive-tag "archive")) - (org-test-with-backend test - (should - (string-match - "\\`\\* Head1[ \t]+:archive:\n\\'" - (org-export-as 'test nil nil nil '(:with-archived-trees t))))))) + (should + (equal "" + (org-test-with-temp-text "* Head1 :archive:" + (let ((org-archive-tag "archive")) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-archived-trees nil)))))) + (should + (string-match + "\\* Head1[ \t]+:archive:" + (org-test-with-temp-text "* Head1 :archive:\nbody\n** Sub-head 2" + (let ((org-archive-tag "archive")) + (org-export-as (org-test-default-backend) nil nil nil + '(:with-archived-trees headline)))))) + (should + (string-match + "\\`\\* Head1[ \t]+:archive:\n\\'" + (org-test-with-temp-text "* Head1 :archive:" + (let ((org-archive-tag "archive")) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-archived-trees t)))))) ;; Clocks. - (let ((org-clock-string "CLOCK:")) - (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" - (org-test-with-backend test - (should - (equal (org-export-as 'test nil nil nil '(:with-clocks t)) - "CLOCK: [2012-04-29 sun. 10:45]\n")) - (should - (equal (org-export-as 'test nil nil nil '(:with-clocks nil)) ""))))) + (should + (equal "CLOCK: [2012-04-29 sun. 10:45]\n" + (let ((org-clock-string "CLOCK:")) + (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-clocks t)))))) + (should + (equal "" + (let ((org-clock-string "CLOCK:")) + (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-clocks nil)))))) ;; Drawers. - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":TEST:\ncontents\n:END:" - (org-test-with-backend test - (should (equal (org-export-as 'test nil nil nil '(:with-drawers nil)) - "")) - (should (equal (org-export-as 'test nil nil nil '(:with-drawers t)) - ":TEST:\ncontents\n:END:\n"))))) - (let ((org-drawers '("FOO" "BAR"))) - (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" - (org-test-with-backend test - (should - (equal (org-export-as 'test nil nil nil '(:with-drawers ("FOO"))) - ":FOO:\nkeep\n:END:\n"))))) - (let ((org-drawers '("FOO" "BAR"))) - (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" - (org-test-with-backend test - (should - (equal (org-export-as 'test nil nil nil '(:with-drawers (not "BAR"))) - ":FOO:\nkeep\n:END:\n"))))) + (should + (equal "" + (let ((org-drawers '("TEST"))) + (org-test-with-temp-text ":TEST:\ncontents\n:END:" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-drawers nil)))))) + (should + (equal ":TEST:\ncontents\n:END:\n" + (let ((org-drawers '("TEST"))) + (org-test-with-temp-text ":TEST:\ncontents\n:END:" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-drawers t)))))) + (should + (equal ":FOO:\nkeep\n:END:\n" + (let ((org-drawers '("FOO" "BAR"))) + (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-drawers ("FOO"))))))) + (should + (equal ":FOO:\nkeep\n:END:\n" + (let ((org-drawers '("FOO" "BAR"))) + (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-drawers (not "BAR"))))))) ;; Footnotes. (should (equal "Footnote?" (let ((org-footnote-section nil)) (org-test-with-temp-text "Footnote?[fn:1]\n\n[fn:1] Def" - (org-test-with-backend test - (org-trim - (org-export-as 'test nil nil nil '(:with-footnotes nil)))))))) + (org-trim (org-export-as (org-test-default-backend) + nil nil nil '(:with-footnotes nil))))))) (should (equal "Footnote?[fn:1]\n\n[fn:1] Def" (let ((org-footnote-section nil)) (org-test-with-temp-text "Footnote?[fn:1]\n\n[fn:1] Def" - (org-test-with-backend test - (org-trim - (org-export-as 'test nil nil nil '(:with-footnotes t)))))))) + (org-trim (org-export-as (org-test-default-backend) + nil nil nil '(:with-footnotes t))))))) ;; Inlinetasks. (when (featurep 'org-inlinetask) (should (equal + "" (let ((org-inlinetask-min-level 15)) (org-test-with-temp-text "*************** Task" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:with-inlinetasks nil))))) - "")) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-inlinetasks nil)))))) (should (equal + "" (let ((org-inlinetask-min-level 15)) (org-test-with-temp-text "*************** Task\nContents\n*************** END" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:with-inlinetasks nil))))) - ""))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-inlinetasks nil))))))) ;; Plannings. - (let ((org-closed-string "CLOSED:")) - (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]" - (org-test-with-backend test - (should - (equal (org-export-as 'test nil nil nil '(:with-planning t)) - "CLOSED: [2012-04-29 sun. 10:45]\n")) - (should - (equal (org-export-as 'test nil nil nil '(:with-planning nil)) - ""))))) + (should + (equal "CLOSED: [2012-04-29 sun. 10:45]\n" + (let ((org-closed-string "CLOSED:")) + (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-planning t)))))) + (should + (equal "" + (let ((org-closed-string "CLOSED:")) + (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-planning nil)))))) ;; Statistics cookies. (should (equal "" (org-test-with-temp-text "[0/0]" - (org-test-with-backend test - (org-export-as - 'test nil nil nil '(:with-statistics-cookies nil))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-statistics-cookies nil)))))) (ert-deftest test-org-export/with-timestamps () "Test `org-export-with-timestamps' specifications." @@ -472,15 +479,15 @@ Paragraph" (equal "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>\n" (org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:with-timestamps t)))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-timestamps t))))) ;; nil value. (should (equal "" (org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:with-timestamps nil)))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-timestamps nil))))) ;; `active' value. (should (equal @@ -489,9 +496,8 @@ Paragraph" "<2012-03-29 Thu>[2012-03-29 Thu] Paragraph <2012-03-29 Thu>[2012-03-29 Thu]" - (org-test-with-backend test - (org-trim - (org-export-as 'test nil nil nil '(:with-timestamps active))))))) + (org-trim (org-export-as (org-test-default-backend) + nil nil nil '(:with-timestamps active)))))) ;; `inactive' value. (should (equal @@ -500,16 +506,16 @@ Paragraph <2012-03-29 Thu>[2012-03-29 Thu]" "<2012-03-29 Thu>[2012-03-29 Thu] Paragraph <2012-03-29 Thu>[2012-03-29 Thu]" - (org-test-with-backend test - (org-trim - (org-export-as 'test nil nil nil '(:with-timestamps inactive)))))))) + (org-trim (org-export-as (org-test-default-backend) + nil nil nil '(:with-timestamps inactive))))))) (ert-deftest test-org-export/comment-tree () "Test if export process ignores commented trees." - (let ((org-comment-string "COMMENT")) - (org-test-with-temp-text "* COMMENT Head1" - (org-test-with-backend test - (should (equal (org-export-as 'test) "")))))) + (should + (equal "" + (let ((org-comment-string "COMMENT")) + (org-test-with-temp-text "* COMMENT Head1" + (org-export-as (org-test-default-backend))))))) (ert-deftest test-org-export/export-scope () "Test all export scopes." @@ -518,22 +524,23 @@ Paragraph <2012-03-29 Thu>[2012-03-29 Thu]" ** Head2 text *** Head3" - (org-test-with-backend test - ;; Subtree. - (forward-line 3) - (should (equal (org-export-as 'test 'subtree) "text\n*** Head3\n")) - ;; Visible. - (goto-char (point-min)) - (forward-line) - (org-cycle) - (should (equal (org-export-as 'test nil 'visible) "* Head1\n")) - ;; Region. - (goto-char (point-min)) - (forward-line 3) - (transient-mark-mode 1) - (push-mark (point) t t) - (goto-char (point-at-eol)) - (should (equal (org-export-as 'test) "text\n")))) + ;; Subtree. + (forward-line 3) + (should (equal (org-export-as (org-test-default-backend) 'subtree) + "text\n*** Head3\n")) + ;; Visible. + (goto-char (point-min)) + (forward-line) + (org-cycle) + (should (equal (org-export-as (org-test-default-backend) nil 'visible) + "* Head1\n")) + ;; Region. + (goto-char (point-min)) + (forward-line 3) + (transient-mark-mode 1) + (push-mark (point) t t) + (goto-char (point-at-eol)) + (should (equal (org-export-as (org-test-default-backend)) "text\n"))) ;; Subtree with a code block calling another block outside. (should (equal ": 3\n" @@ -547,19 +554,18 @@ text #+BEGIN_SRC emacs-lisp \(+ 1 2) #+END_SRC" - (org-test-with-backend test - (forward-line 1) - (org-export-as 'test 'subtree))))) + (forward-line 1) + (org-export-as (org-test-default-backend) 'subtree)))) ;; Body only. - (org-test-with-temp-text "Text" - (org-test-with-backend test - (plist-put - (cdr (assq 'test org-export-registered-backends)) - :translate-alist - (cons (cons 'template (lambda (body info) (format "BEGIN\n%sEND" body))) - (org-export-backend-translate-table 'test))) - (should (equal (org-export-as 'test nil nil 'body-only) "Text\n")) - (should (equal (org-export-as 'test) "BEGIN\nText\nEND"))))) + (let ((backend (org-test-default-backend))) + (setf (org-export-backend-transcoders backend) + (cons '(template . (lambda (body i) + (format "BEGIN\n%sEND" body))) + (org-export-backend-transcoders backend))) + (org-test-with-temp-text "Text" + (should (equal (org-export-as backend nil nil 'body-only) + "Text\n")) + (should (equal (org-export-as backend) "BEGIN\nText\nEND"))))) (ert-deftest test-org-export/output-file-name () "Test `org-export-output-file-name' specifications." @@ -667,7 +673,7 @@ body\n"))) (should (equal "#+MACRO: macro1 value\nvalue\n" (org-test-with-temp-text "#+MACRO: macro1 value\n{{{macro1}}}" - (org-test-with-backend test (org-export-as 'test))))) + (org-export-as (org-test-default-backend))))) ;; Expand specific macros. (should (equal "me 2012-03-29 me@here Title\n" @@ -678,7 +684,7 @@ body\n"))) #+AUTHOR: me #+EMAIL: me@here {{{author}}} {{{date}}} {{{email}}} {{{title}}}" - (let ((output (org-test-with-backend test (org-export-as 'test)))) + (let ((output (org-export-as (org-test-default-backend)))) (substring output (string-match ".*\n\\'" output)))))) ;; Expand specific macros when property contained a regular macro ;; already. @@ -688,7 +694,7 @@ body\n"))) #+MACRO: macro1 value #+TITLE: {{{macro1}}} {{{title}}}" - (let ((output (org-test-with-backend test (org-export-as 'test)))) + (let ((output (org-export-as (org-test-default-backend)))) (substring output (string-match ".*\n\\'" output)))))) ;; Expand macros with templates in included files. (should @@ -696,57 +702,65 @@ body\n"))) (org-test-with-temp-text (format "#+INCLUDE: \"%s/examples/macro-templates.org\" {{{included-macro}}}" org-test-dir) - (let ((output (org-test-with-backend test (org-export-as 'test)))) + (let ((output (org-export-as (org-test-default-backend)))) (substring output (string-match ".*\n\\'" output))))))) (ert-deftest test-org-export/user-ignore-list () "Test if `:ignore-list' accepts user input." - (org-test-with-backend test - (flet ((skip-note-head - (data backend info) - ;; Ignore headlines with the word "note" in their title. - (org-element-map data 'headline - (lambda (headline) - (when (string-match "\\" - (org-element-property :raw-value headline)) - (org-export-ignore-element headline info))) - info) - data)) - ;; Install function in parse tree filters. - (let ((org-export-filter-parse-tree-functions '(skip-note-head))) - (org-test-with-temp-text "* Head1\n* Head2 (note)\n" - (should (equal (org-export-as 'test) "* Head1\n"))))))) + (let ((backend (org-test-default-backend))) + (setf (org-export-backend-transcoders backend) + (cons '(template . (lambda (body i) + (format "BEGIN\n%sEND" body))) + (org-export-backend-transcoders backend))) + (org-test-with-temp-text "Text" + (should (equal (org-export-as backend nil nil 'body-only) + "Text\n")) + (should (equal (org-export-as backend) "BEGIN\nText\nEND")))) + (should + (equal + "* Head1\n" + (let ((org-export-filter-parse-tree-functions + '((lambda (data backend info) + ;; Ignore headlines with the word "note" in their title. + (org-element-map data 'headline + (lambda (headline) + (when (string-match "\\" + (org-element-property :raw-value + headline)) + (org-export-ignore-element headline info))) + info) + data)))) + (org-test-with-temp-text "* Head1\n* Head2 (note)\n" + (org-export-as (org-test-default-backend))))))) (ert-deftest test-org-export/before-processing-hook () "Test `org-export-before-processing-hook'." (should (equal "#+MACRO: mac val\nTest\n" - (org-test-with-backend test - (org-test-with-temp-text "#+MACRO: mac val\n{{{mac}}} Test" - (let ((org-export-before-processing-hook - '((lambda (backend) - (while (re-search-forward "{{{" nil t) - (let ((object (org-element-context))) - (when (eq (org-element-type object) 'macro) - (delete-region - (org-element-property :begin object) - (org-element-property :end object))))))))) - (org-export-as 'test))))))) + (org-test-with-temp-text "#+MACRO: mac val\n{{{mac}}} Test" + (let ((org-export-before-processing-hook + '((lambda (backend) + (while (re-search-forward "{{{" nil t) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'macro) + (delete-region + (org-element-property :begin object) + (org-element-property :end object))))))))) + (org-export-as (org-test-default-backend))))))) (ert-deftest test-org-export/before-parsing-hook () "Test `org-export-before-parsing-hook'." (should (equal "Body 1\nBody 2\n" - (org-test-with-backend test - (org-test-with-temp-text "* Headline 1\nBody 1\n* Headline 2\nBody 2" - (let ((org-export-before-parsing-hook - '((lambda (backend) - (goto-char (point-min)) - (while (re-search-forward org-outline-regexp-bol nil t) - (delete-region - (point-at-bol) (progn (forward-line) (point)))))))) - (org-export-as 'test))))))) + (org-test-with-temp-text "* Headline 1\nBody 1\n* Headline 2\nBody 2" + (let ((org-export-before-parsing-hook + '((lambda (backend) + (goto-char (point-min)) + (while (re-search-forward org-outline-regexp-bol nil t) + (delete-region + (point-at-bol) (progn (forward-line) (point)))))))) + (org-export-as (org-test-default-backend))))))) @@ -833,37 +847,37 @@ body\n"))) ;; Translate table. (should (equal '((headline . my-headline-test)) - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . my-headline-test))) - (org-export-backend-translate-table 'test)))) + (org-export-get-all-transcoders 'test)))) ;; Filters. (should (equal '((:filter-headline . my-filter)) - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . my-headline-test)) :filters-alist '((:filter-headline . my-filter))) - (org-export-backend-filters 'test)))) + (org-export-backend-filters (org-export-get-backend 'test))))) ;; Options. (should (equal '((:prop value)) - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . my-headline-test)) :options-alist '((:prop value))) - (org-export-backend-options 'test)))) + (org-export-backend-options (org-export-get-backend 'test))))) ;; Menu. (should (equal '(?k "Test Export" test) - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . my-headline-test)) :menu-entry '(?k "Test Export" test)) - (org-export-backend-menu 'test)))) + (org-export-backend-menu (org-export-get-backend 'test))))) ;; Export Blocks. (should (equal '(("TEST" . org-element-export-block-parser)) - (let (org-export-registered-backends org-element-block-name-alist) + (let (org-export--registered-backends org-element-block-name-alist) (org-export-define-backend 'test '((headline . my-headline-test)) :export-block '("test")) @@ -873,115 +887,218 @@ body\n"))) "Test `org-export-define-derived-backend' specifications." ;; Error when parent back-end is not defined. (should-error - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-derived-backend 'test 'parent))) ;; Append translation table to parent's. (should (equal '((:headline . test) (:headline . parent)) - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'parent '((:headline . parent))) (org-export-define-derived-backend 'test 'parent :translate-alist '((:headline . test))) - (org-export-backend-translate-table 'test)))) + (org-export-get-all-transcoders 'test)))) ;; Options defined in the new back have priority over those defined ;; in parent. (should (eq 'test - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'parent '((:headline . parent)) :options-alist '((:a nil nil 'parent))) (org-export-define-derived-backend 'test 'parent :options-alist '((:a nil nil 'test))) - (plist-get (org-export--get-global-options 'test) :a))))) + (plist-get (org-export--get-global-options + (org-export-get-backend 'test)) + :a))))) (ert-deftest test-org-export/derived-backend-p () "Test `org-export-derived-backend-p' specifications." ;; Non-nil with direct match. (should - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . test))) (org-export-derived-backend-p 'test 'test))) (should - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . test))) (org-export-define-derived-backend 'test2 'test) (org-export-derived-backend-p 'test2 'test2))) ;; Non-nil with a direct parent. (should - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . test))) (org-export-define-derived-backend 'test2 'test) (org-export-derived-backend-p 'test2 'test))) ;; Non-nil with an indirect parent. (should - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . test))) (org-export-define-derived-backend 'test2 'test) (org-export-define-derived-backend 'test3 'test2) (org-export-derived-backend-p 'test3 'test))) ;; Nil otherwise. (should-not - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . test))) (org-export-define-backend 'test2 '((headline . test2))) (org-export-derived-backend-p 'test2 'test))) (should-not - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((headline . test))) (org-export-define-backend 'test2 '((headline . test2))) (org-export-define-derived-backend 'test3 'test2) (org-export-derived-backend-p 'test3 'test)))) +(ert-deftest test-org-export/get-all-transcoders () + "Test `org-export-get-all-transcoders' specifications." + ;; Return nil when back-end cannot be found. + (should-not (org-export-get-all-transcoders nil)) + ;; Same as `org-export-transcoders' if no parent. + (should + (equal '((headline . ignore)) + (org-export-get-all-transcoders + (org-export-create-backend + :transcoders '((headline . ignore)))))) + ;; But inherit from all ancestors whenever possible. + (should + (equal '((section . ignore) (headline . ignore)) + (let (org-export--registered-backends) + (org-export-define-backend 'b1 '((headline . ignore))) + (org-export-get-all-transcoders + (org-export-create-backend + :parent 'b1 :transcoders '((section . ignore))))))) + (should + (equal '((paragraph . ignore) (section . ignore) (headline . ignore)) + (let (org-export--registered-backends) + (org-export-define-backend 'b1 '((headline . ignore))) + (org-export-define-derived-backend 'b2 'b1 + :translate-alist '((section . ignore))) + (org-export-get-all-transcoders + (org-export-create-backend + :parent 'b2 :transcoders '((paragraph . ignore))))))) + ;; Back-end transcoders overrule inherited ones. + (should + (eq 'b + (let (org-export--registered-backends) + (org-export-define-backend 'b1 '((headline . a))) + (cdr (assq 'headline + (org-export-get-all-transcoders + (org-export-create-backend + :parent 'b1 :transcoders '((headline . b)))))))))) + +(ert-deftest test-org-export/get-all-options () + "Test `org-export-get-all-options' specifications." + ;; Return nil when back-end cannot be found. + (should-not (org-export-get-all-options nil)) + ;; Same as `org-export-options' if no parent. + (should + (equal '((headline . ignore)) + (org-export-get-all-options + (org-export-create-backend + :options '((headline . ignore)))))) + ;; But inherit from all ancestors whenever possible. + (should + (equal '((:key2 value2) (:key1 value1)) + (let (org-export--registered-backends) + (org-export-define-backend 'b1 nil :options-alist '((:key1 value1))) + (org-export-get-all-options + (org-export-create-backend + :parent 'b1 :options '((:key2 value2))))))) + (should + (equal '((:key3 value3) (:key2 value2) (:key1 value1)) + (let (org-export--registered-backends) + (org-export-define-backend 'b1 nil :options-alist '((:key1 value1))) + (org-export-define-derived-backend 'b2 'b1 + :options-alist '((:key2 value2))) + (org-export-get-all-options + (org-export-create-backend + :parent 'b2 :options '((:key3 value3))))))) + ;; Back-end options overrule inherited ones. + (should + (eq 'b + (let (org-export--registered-backends) + (org-export-define-backend 'b1 nil :options-alist '((:key1 . a))) + (cdr (assq :key1 + (org-export-get-all-options + (org-export-create-backend + :parent 'b1 :options '((:key1 . b)))))))))) + +(ert-deftest test-org-export/get-all-filters () + "Test `org-export-get-all-filters' specifications." + ;; Return nil when back-end cannot be found. + (should-not (org-export-get-all-filters nil)) + ;; Same as `org-export-filters' if no parent. + (should + (equal '((:filter-headline . ignore)) + (org-export-get-all-filters + (org-export-create-backend + :filters '((:filter-headline . ignore)))))) + ;; But inherit from all ancestors whenever possible. + (should + (equal '((:filter-section . ignore) (:filter-headline . ignore)) + (let (org-export--registered-backends) + (org-export-define-backend 'b1 + nil :filters-alist '((:filter-headline . ignore))) + (org-export-get-all-filters + (org-export-create-backend + :parent 'b1 :filters '((:filter-section . ignore))))))) + (should + (equal '((:filter-paragraph . ignore) + (:filter-section . ignore) + (:filter-headline . ignore)) + (let (org-export--registered-backends) + (org-export-define-backend 'b1 + nil :filters-alist '((:filter-headline . ignore))) + (org-export-define-derived-backend 'b2 'b1 + :filters-alist '((:filter-section . ignore))) + (org-export-get-all-filters + (org-export-create-backend + :parent 'b2 :filters '((:filter-paragraph . ignore))))))) + ;; Back-end filters overrule inherited ones. + (should + (eq 'b + (let (org-export--registered-backends) + (org-export-define-backend 'b1 '((:filter-headline . a))) + (cdr (assq :filter-headline + (org-export-get-all-filters + (org-export-create-backend + :parent 'b1 :filters '((:filter-headline . b)))))))))) + (ert-deftest test-org-export/with-backend () "Test `org-export-with-backend' definition." ;; Error when calling an undefined back-end - (should-error - (let (org-export-registered-backends) - (org-export-with-backend 'test "Test"))) + (should-error (org-export-with-backend nil "Test")) ;; Error when called back-end doesn't have an appropriate ;; transcoder. (should-error - (let (org-export-registered-backends) - (org-export-define-backend 'test ((headline . ignore))) - (org-export-with-backend 'test "Test"))) + (org-export-with-backend + (org-export-create-backend :transcoders '((headline . ignore))) + "Test")) ;; Otherwise, export using correct transcoder (should (equal "Success" - (let (org-export-registered-backends) + (let (org-export--registered-backends) (org-export-define-backend 'test '((plain-text . (lambda (text contents info) "Failure")))) (org-export-define-backend 'test2 '((plain-text . (lambda (text contents info) "Success")))) (org-export-with-backend 'test2 "Test"))))) -(ert-deftest test-org-export/data-with-translations () - "Test `org-export-data-with-translations' specifications." - (should - (equal - "Success!" - (org-export-data-with-translations - '(bold nil "Test") - '((plain-text . (lambda (text info) "Success")) - (bold . (lambda (bold contents info) (concat contents "!")))) - '(:with-emphasize t))))) - (ert-deftest test-org-export/data-with-backend () "Test `org-export-data-with-backend' specifications." ;; Error when calling an undefined back-end. - (should-error - (let (org-export-registered-backends) - (org-export-data-with-backend 'test "Test" nil))) + (should-error (org-export-data-with-backend nil "nil" nil)) ;; Otherwise, export data recursively, using correct back-end. (should (equal "Success!" - (let (org-export-registered-backends) - (org-export-define-backend 'test - '((plain-text . (lambda (text info) "Success")) - (bold . (lambda (bold contents info) (concat contents "!"))))) - (org-export-data-with-backend - '(bold nil "Test") 'test '(:with-emphasize t)))))) + (org-export-data-with-backend + '(bold nil "Test") + (org-export-create-backend + :transcoders + '((plain-text . (lambda (text info) "Success")) + (bold . (lambda (bold contents info) (concat contents "!"))))) + '(:with-emphasize t))))) @@ -989,28 +1106,30 @@ body\n"))) (ert-deftest test-org-export/export-snippet () "Test export snippets transcoding." + ;; Standard test. (org-test-with-temp-text "@@test:A@@@@t:B@@" - (org-test-with-backend test - (plist-put - (cdr (assq 'test org-export-registered-backends)) - :translate-alist - (cons (cons 'export-snippet - (lambda (snippet contents info) - (when (eq (org-export-snippet-backend snippet) 'test) - (org-element-property :value snippet)))) - (org-export-backend-translate-table 'test))) + (let ((backend (org-test-default-backend))) + (setf (org-export-backend-name backend) 'test) + (setf (org-export-backend-transcoders backend) + (cons (cons 'export-snippet + (lambda (snippet contents info) + (when (eq (org-export-snippet-backend snippet) 'test) + (org-element-property :value snippet)))) + (org-export-backend-transcoders backend))) (let ((org-export-snippet-translation-alist nil)) - (should (equal (org-export-as 'test) "A\n"))) + (should (equal (org-export-as backend) "A\n"))) (let ((org-export-snippet-translation-alist '(("t" . "test")))) - (should (equal (org-export-as 'test) "AB\n"))))) + (should (equal (org-export-as backend) "AB\n"))))) ;; Ignored export snippets do not remove any blank. (should (equal "begin end\n" (org-test-with-parsed-data "begin @@test:A@@ end" - (org-export-data-with-translations + (org-export-data-with-backend tree - '((paragraph . (lambda (paragraph contents info) contents)) - (section . (lambda (section contents info) contents))) + (org-export-create-backend + :transcoders + '((paragraph . (lambda (paragraph contents info) contents)) + (section . (lambda (section contents info) contents)))) info))))) @@ -1036,11 +1155,11 @@ body\n"))) (car (org-element-contents def)))))))) info)))) ;; 2. Test nested footnotes order. - (org-test-with-parsed-data - "Text[fn:1:A[fn:2]] [fn:3].\n\n[fn:2] B [fn:3] [fn::D].\n\n[fn:3] C." - (should - (equal - '((1 . "fn:1") (2 . "fn:2") (3 . "fn:3") (4)) + (should + (equal + '((1 . "fn:1") (2 . "fn:2") (3 . "fn:3") (4)) + (org-test-with-parsed-data + "Text[fn:1:A[fn:2]] [fn:3].\n\n[fn:2] B [fn:3] [fn::D].\n\n[fn:3] C." (org-element-map tree 'footnote-reference (lambda (ref) (when (org-export-footnote-first-reference-p ref info) @@ -1060,29 +1179,30 @@ body\n"))) (should (= (length (org-export-collect-footnote-definitions tree info)) 2)))) ;; 4. Test footnotes definitions collection. - (org-test-with-parsed-data "Text[fn:1:A[fn:2]] [fn:3]. + (should + (= 4 + (org-test-with-parsed-data "Text[fn:1:A[fn:2]] [fn:3]. \[fn:2] B [fn:3] [fn::D]. \[fn:3] C." - (should (= (length (org-export-collect-footnote-definitions tree info)) - 4))) + (length (org-export-collect-footnote-definitions tree info))))) ;; 5. Test export of footnotes defined outside parsing scope. - (org-test-with-temp-text "[fn:1] Out of scope + (should + (equal + "ParagraphOut of scope\n" + (org-test-with-temp-text "[fn:1] Out of scope * Title Paragraph[fn:1]" - (org-test-with-backend test - (plist-put - (cdr (assq 'test org-export-registered-backends)) - :translate-alist - (cons (cons 'footnote-reference - (lambda (fn contents info) - (org-element-interpret-data - (org-export-get-footnote-definition fn info)))) - (org-export-backend-translate-table 'test))) - (forward-line) - (should (equal "ParagraphOut of scope\n" - (org-export-as 'test 'subtree))))) + (let ((backend (org-test-default-backend))) + (setf (org-export-backend-transcoders backend) + (cons (cons 'footnote-reference + (lambda (fn contents info) + (org-element-interpret-data + (org-export-get-footnote-definition fn info)))) + (org-export-backend-transcoders backend))) + (forward-line) + (org-export-as backend 'subtree))))) ;; 6. Footnotes without a definition should be provided a fallback ;; definition. (should @@ -1378,8 +1498,8 @@ Paragraph[fn:1]" "" (let ((org-inlinetask-min-level 3)) (org-test-with-temp-text "*** Inlinetask :noexp:\nContents\n*** end" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:exclude-tags ("noexp")))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:exclude-tags ("noexp"))))))) ;; Inlinetask with an include tag. (should (equal @@ -1387,16 +1507,16 @@ Paragraph[fn:1]" (let ((org-inlinetask-min-level 3) (org-tags-column 0)) (org-test-with-temp-text "* H1\n* H2\n*** Inline :exp:" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:select-tags ("exp")))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:select-tags ("exp"))))))) ;; Ignore inlinetask with a TODO keyword and tasks excluded. (should (equal "" (let ((org-todo-keywords '((sequence "TODO" "DONE"))) (org-inlinetask-min-level 3)) (org-test-with-temp-text "*** TODO Inline" - (org-test-with-backend test - (org-export-as 'test nil nil nil '(:with-tasks nil))))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-tasks nil)))))))) @@ -2492,41 +2612,40 @@ Another text. (ref:text) "Test `inner-template' translator specifications." (should (equal "Success!" - (let (org-export-registered-backends) - (org-export-define-backend 'test + (org-test-with-temp-text "* Headline" + (org-export-as + (org-export-create-backend + :transcoders '((inner-template . (lambda (contents info) "Success!")) - (headline . (lambda (h c i) "Headline")))) - (org-test-with-temp-text "* Headline" - (org-export-as 'test))))) + (headline . (lambda (h c i) "Headline")))))))) ;; Inner template is applied even in a "body-only" export. (should (equal "Success!" - (let (org-export-registered-backends) - (org-export-define-backend 'test - '((inner-template . (lambda (contents info) "Success!")) - (headline . (lambda (h c i) "Headline")))) - (org-test-with-temp-text "* Headline" - (org-export-as 'test nil nil 'body-only)))))) + (org-test-with-temp-text "* Headline" + (org-export-as + (org-export-create-backend + :transcoders '((inner-template . (lambda (c i) "Success!")) + (headline . (lambda (h c i) "Headline")))) + nil nil 'body-only))))) (ert-deftest test-org-export/template () "Test `template' translator specifications." (should (equal "Success!" - (let (org-export-registered-backends) - (org-export-define-backend 'test - '((template . (lambda (contents info) "Success!")) - (headline . (lambda (h c i) "Headline")))) - (org-test-with-temp-text "* Headline" - (org-export-as 'test))))) + (org-test-with-temp-text "* Headline" + (org-export-as + (org-export-create-backend + :transcoders '((template . (lambda (contents info) "Success!")) + (headline . (lambda (h c i) "Headline")))))))) ;; Template is not applied in a "body-only" export. (should-not (equal "Success!" - (let (org-export-registered-backends) - (org-export-define-backend 'test - '((template . (lambda (contents info) "Success!")) - (headline . (lambda (h c i) "Headline")))) - (org-test-with-temp-text "* Headline" - (org-export-as 'test nil nil 'body-only)))))) + (org-test-with-temp-text "* Headline" + (org-export-as + (org-export-create-backend + :transcoders '((template . (lambda (contents info) "Success!")) + (headline . (lambda (h c i) "Headline")))) + nil nil 'body-only)))))